From 371bb9a9863c3ad90e9185a8ac7958203e60b410 Mon Sep 17 00:00:00 2001 From: snmsts Date: Wed, 20 Sep 2023 00:30:48 +0900 Subject: [PATCH] implement ros script --- lib/script/init/main.lisp | 61 +++++++++ lib/script/init/roswell2.script.init.asd | 8 ++ lib/script/main.lisp | 154 +++++++++++++++++++++++ lib/script/ros-loader.lisp | 15 +++ lib/script/roswell2.cmd.script.asd | 7 ++ 5 files changed, 245 insertions(+) create mode 100644 lib/script/init/main.lisp create mode 100644 lib/script/init/roswell2.script.init.asd create mode 100644 lib/script/main.lisp create mode 100644 lib/script/ros-loader.lisp create mode 100644 lib/script/roswell2.cmd.script.asd diff --git a/lib/script/init/main.lisp b/lib/script/init/main.lisp new file mode 100644 index 0000000..48068c4 --- /dev/null +++ b/lib/script/init/main.lisp @@ -0,0 +1,61 @@ +(uiop:define-package :roswell2.script.init/main + (:use :cl + :roswell-bin/util) + + (:nicknames :roswell2.script.init)) +(in-package :roswell2.script.init/main) + +(defvar *command-class* 'roswell2/clingon.extensions::command-without-version) + +(defun sub-commands ()) + +(defun options ()) + +(defun handler (cmd) + (let* ((args (clingon:command-arguments cmd)) + (name (first args)) + (name (namestring (make-pathname :defaults name :type nil))) + params) + (map () (lambda (i) + (setf name (remove i name))) + "./\\") + (setf params (loop for (i j) on (cdr args) by #'cddr + collect (intern i :keyword) + collect j)) + (let* ((date (get-universal-time)) + (path (make-pathname :defaults name :type "ros"))) + (handler-case + (unless + (prog1 + (with-open-file (out path + :direction :output + :if-exists nil + :if-does-not-exist :create) + (when out + (format out "~@{~A~%~}" + "#!/bin/sh" + "#|-*- mode:lisp -*-|#" + "#|" + "exec ros -Q -- $0 \"$@\"" "|#" + "(progn ;;init forms" + " (ros:ensure-asdf)" + (let ((lib (getf params :|lib|))) + (format nil " #+quicklisp(ql:quickload '(~A) :silent t)" + (or lib ""))) + " )" + "" + (format nil "(defpackage :ros.script.~A.~A" name date) + " (:use :cl))" + (format nil "(in-package :ros.script.~A.~A)" name date) + "" + "(defun main (&rest argv)" + " (declare (ignorable argv)))" + ";;; vim: set ft=lisp lisp:") + (format t "~&Successfully generated: ~A~%" path) + t)) + (sb-posix:chmod path #o700)) + (format *error-output* "~&File already exists: ~A~%" path) + (uiop:quit 1)) + (error (e) + (format *error-output* "~&~A~%" e) + (uiop:quit 1)))))) diff --git a/lib/script/init/roswell2.script.init.asd b/lib/script/init/roswell2.script.init.asd new file mode 100644 index 0000000..1a1cd56 --- /dev/null +++ b/lib/script/init/roswell2.script.init.asd @@ -0,0 +1,8 @@ +(defsystem "roswell2.script.init" + :long-name "init" + :class :package-inferred-system + :author "SANO Masatoshi" + :description "Create a roswell script." + :license "MIT" + :depends-on (:roswell2.script.init/main)) + diff --git a/lib/script/main.lisp b/lib/script/main.lisp new file mode 100644 index 0000000..66f3133 --- /dev/null +++ b/lib/script/main.lisp @@ -0,0 +1,154 @@ +(uiop:define-package :roswell2.cmd.script/main + (:use :cl + :roswell-bin/config + :roswell-bin/util + :roswell-bin/uname + :roswell2/main + :roswell2.cmd.run + :roswell2.cmd.install/main) + (:nicknames :roswell2.cmd.script) + (:import-from :clingon) + (:import-from :sb-md5)) + +(in-package :roswell2.cmd.script/main) + +(defvar *command-class* 'roswell2/clingon.extensions::command-without-version) + +(defun sub-commands () + (sub-command-filter "roswell2.script.")) + +(defun options () + `(,@(loop with package = (find-package :roswell2.cmd.run) + for i in (funcall (find-symbol (string '#:options) package)) + unless (or (member (clingon.options:option-key i) + '(:quit :image :lisp :repl :dump :native :quicklisp-path :quicklisp)) + (member i clingon.command:*default-options*)) + collect i) + ,(clingon:make-option + :boolean/true + :description "use quicklisp" + :short-name #\Q + :long-name "quicklisp" + :category "Quicklisp" + :key :quicklisp) + ,(clingon:make-option + :string + :description "Take image name it will be ignored" + :parameter "IMAGE" + :short-name #\m + :long-name "image" + :category "dummy options" + :key :image) + ,(clingon:make-option + :counter-filter + :short-name #\v + :long-name "verbose" + :hidden nil + :filter (lambda (x option) + (declare (ignore option)) + (message :counter-filter "verbose level: ~A" x) + (setf *verbose* x)) + :description "be quite noisy" + :key :verbose))) + +(defun parse-script (file) + (let (md5sum package seq pos pos2) + (with-open-file (in file) + (read-line in);; read shebang + (setf pos (file-position in)) + (message :script-handler "ignore shebang pos:~S" pos) + (with-standard-io-syntax + (let ((*read-suppress* t)) + (read in))) + (setf pos2 (file-position in)) + (message :script-handler "pos2:~S" pos2) + (setf seq (make-string (- pos2 pos))) + (file-position in pos) + (read-sequence seq in) + (message :script-handler "seq:~S" seq) + (setf md5sum (format nil "~(~{~2,'0X~}~)" + (coerce (sb-md5:md5sum-string seq) 'list))) + (setf package (second (read in))) + (values package md5sum seq)))) + +(defun handler (cmd) + "Handler for just evaluate options" + (let* ((config (load-config :where :global)) + (args (clingon:command-arguments cmd)) + (impl (or (clingon:getopt cmd :lisp) "sbcl")) + (version (or (clingon:getopt cmd :version) + (and impl (config `(,impl "version") config :if-does-not-exist nil)))) + (param (make-impl-param + (intern (string-upcase impl) :keyword) + cmd + :name impl + :version version + :image nil + :quicklisp nil))) + (unless version + (impl-set-version-param param)) + (let ((script (uiop:file-exists-p (first args))) + (impl-path (impl-path param)) + md5 package) + (message :script-handler "args-for script handler ~S" args) + (message :script-handler "cmd for script handler ~S" cmd) + (message :script-handler "param for script handler ~S" param) + (message :script-handler "fileexist: ~S" script) + (let* ((path (merge-pathnames "roswell.sexp" impl-path)) + form image ql) + (unless (uiop:file-exists-p path) + (message :script-handler "~S seems not exist... try install: ~S" path param) + (install param))) + (unless script + (format *error-output* "invalid script file~%") + (uiop:quit 1)) + (unless args + (clingon:run cmd '("--help"))) + (multiple-value-setq (package md5) (parse-script script)) + (message :script-handler "script parsed package ~S md5 ~S" package md5) + (setf image + (make-pathname :name (format nil "~A-~A" (pathname-name script) md5) + :type "core" + :defaults (translate-pathname + script + "/**/*.*" (merge-pathnames "core/**/*.*" impl-path))) + ql (make-pathname + :name nil + :type nil + :defaults (translate-pathname + script + "/**/*.*" (merge-pathnames "quicklisp/**/*.*" impl-path)))) + (message :script-handler "image-path: ~S" image) + (message :script-handler "ql-path: ~S" ql) + (message :script-handler "forms: ~S" *forms*) + (unless (uiop:file-exists-p image) + (let (*forms* + (dump-param (make-impl-param + (impl-param-kind param) + cmd + :name (impl-param-name param) + :version (impl-param-version param) + :image nil + :quicklisp (namestring ql)))) + (push (list :eval (format nil "(with-open-file (in ~S) (read-line in) (eval (read in)))" script)) *forms*) + (push (list :dump image) *forms*) + (run (impl-param-run dump-param) dump-param config cmd :exec 'run-program))) + (let (*forms* + (run-param (make-impl-param + (impl-param-kind param) + cmd + :name (impl-param-name param) + :version (impl-param-version param) + :image (namestring image) + :quicklisp (namestring ql)))) + (push (list :eval (format nil "(progn #-roswell2.cmd.script (cl:load ~S))" + (truename (merge-pathnames + "ros-loader.lisp" + (asdf:system-source-directory + (asdf:find-system :roswell2.cmd.script)))))) *forms*) + (push (list :eval "(roswell2.cmd.script/ros-loader:ignore-shebang)") *forms*) + (push (list :load script) *forms*) + (push (list :eval (format nil "(apply (let ((*package* (find-package ~S))) (read-from-string \"main\")) '~S)" package (cdr args))) *forms*) + (setf *forms* (nreverse *forms*)) + (run (impl-param-run run-param) run-param config cmd)))) + (uiop:quit)) diff --git a/lib/script/ros-loader.lisp b/lib/script/ros-loader.lisp new file mode 100644 index 0000000..b1d708f --- /dev/null +++ b/lib/script/ros-loader.lisp @@ -0,0 +1,15 @@ +(defpackage :roswell2.cmd.script/ros-loader + (:use :cl) + (:export :ignore-shebang)) +(in-package :roswell2.cmd.script/ros-loader) + +(defun shebang-reader (stream sub-character infix-parameter) + (declare (ignore sub-character infix-parameter)) + (loop for x = (read-char stream nil nil) + until (or (not x) (eq x #\newline))) + (values)) + +(defun ignore-shebang () + (set-dispatch-macro-character #\# #\! #'shebang-reader)) + +(push :roswell2.cmd.script *features*) diff --git a/lib/script/roswell2.cmd.script.asd b/lib/script/roswell2.cmd.script.asd new file mode 100644 index 0000000..71e633a --- /dev/null +++ b/lib/script/roswell2.cmd.script.asd @@ -0,0 +1,7 @@ +(defsystem "roswell2.cmd.script" + :long-name "script" + :class :package-inferred-system + :author "SANO Masatoshi" + :description "maintain ros scripts" + :license "MIT" + :depends-on (:roswell2.cmd.script/main))