From 1dc72254f4cf6acfd5d83c3dd94ab835ca9bce96 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Wed, 13 Jan 2021 14:58:34 +0100 Subject: [PATCH] ambrevar/shell: Replace `run' and friends with `cmd' library. --- .../common-lisp/source/ambrevar/all.lisp | 1 + .../common-lisp/source/ambrevar/guix.lisp | 6 +- .../common-lisp/source/ambrevar/shell.lisp | 110 ++++++++---------- 3 files changed, 51 insertions(+), 66 deletions(-) diff --git a/.local/share/common-lisp/source/ambrevar/all.lisp b/.local/share/common-lisp/source/ambrevar/all.lisp index 6e88e316..acc4e6cc 100644 --- a/.local/share/common-lisp/source/ambrevar/all.lisp +++ b/.local/share/common-lisp/source/ambrevar/all.lisp @@ -12,6 +12,7 @@ (:import-from #:cl-prevalence) (:import-from #:clesh) (:import-from #:closer-mop) + (:import-from #:cmd) (:import-from #:dexador) (:import-from #:fset) (:import-from #:hu.dwim.defclass-star) diff --git a/.local/share/common-lisp/source/ambrevar/guix.lisp b/.local/share/common-lisp/source/ambrevar/guix.lisp index f2cbc251..c7bba5e9 100644 --- a/.local/share/common-lisp/source/ambrevar/guix.lisp +++ b/.local/share/common-lisp/source/ambrevar/guix.lisp @@ -59,14 +59,14 @@ (parse-integer (first (first ($:tokenize - ($:run* "du" "-sb" path)))))))) + (cmd:$cmd "du" "-sb" path)))))))) (mapcar #'size->human (sera:take limit (sort (mapcar #'pair-item-with-disk-usage (if dead? - (alex:flatten ($:tokenize ($:run* "guix" "gc" "--list-dead"))) + (alex:flatten ($:tokenize (cmd:$cmd "guix" "gc" "--list-dead"))) ($:directory-listing "/gnu/store" :sort? t))) #'> :key #'second))))) @@ -74,7 +74,7 @@ (declaim (ftype (function ((cons (or string pathname)))) delete-store-items)) (defun delete-store-items (items) "Garbage-collect items." - (apply #'$:run* "guix" "gc" "--delete" items)) + (apply #'cmd:$cmd "guix" "gc" "--delete" items)) (export-always 'guix-run) (defun guix-run (package &optional (executable package) &rest args) ; TODO: Rename to `run'? diff --git a/.local/share/common-lisp/source/ambrevar/shell.lisp b/.local/share/common-lisp/source/ambrevar/shell.lisp index e83476ae..dae4b39c 100644 --- a/.local/share/common-lisp/source/ambrevar/shell.lisp +++ b/.local/share/common-lisp/source/ambrevar/shell.lisp @@ -18,7 +18,7 @@ "Return the environment variables as an alist." (mapcar (lambda (line) (str:split "=" line :limit 2)) - (str:split (string #\newline) (run* "env")))) + (str:split (string #\newline) (cmd:$cmd "env")))) (defun assert-program (program &rest more-programs) ; TODO: Is this useful for a REPL? (sera:and-let* ((missing-programs @@ -200,66 +200,50 @@ Return the first non-deleted directory." (defvar *process-list* '() "List of processes started from `run'.") -(export-always 'terminate-dangling-processes) -(defun terminate-dangling-processes () - (mapc #'terminate-process-with-group *process-list*) - ;; TODO: Maybe don't flush the list in case some processes failed to be terminated. - ;; Use -KILL to fix this? - (setf *process-list* nil)) +;; (export-always 'terminate-dangling-processes) +;; (defun terminate-dangling-processes () +;; (mapc #'terminate-process-with-group *process-list*) +;; ;; TODO: Maybe don't flush the list in case some processes failed to be terminated. +;; ;; Use -KILL to fix this? +;; (setf *process-list* nil)) -(defun %run (command &key (output :stream) (error-output *error-output*)) - (assert-program "pkill") ; For `terminate-process-with-group'. - (flet ((cleanup (process-info) - (push process-info *process-list*) - (uiop:wait-process process-info))) - (setf command (if (listp command) - (mapcar #'princ-to-string (alex:flatten command)) - command)) - ;; TODO: Use :stream directly in launch-program and get stream from - ;; process-info to avoid repeating the launch-program call. - (match output - (:stream - (nth-value - 0 - (uiop:stripln - (with-output-to-string (out) - (let ((process-info (uiop:launch-program command - :output out - :error-output error-output))) - (cleanup process-info)))))) +(export-always '*shell*) +(defvar *shell* "sh" + "Default shell to use in `sh' and friends. +Also see `*shell-command-flags*'.") - (out - (let ((process-info (uiop:launch-program command - :output (match out - (t *standard-output*) - (o o)) - :error-output error-output))) - (cleanup process-info)))))) +(export-always '*shell-command-flag*) +(defvar *shell-command-flag* "-c" + "Flag to pass a command string to the `*shell*'.") -(export-always 'run) -(defun run (command &rest args) - "Run arguments in a safe manner. -If on interrupt process gets forked to the background, call -`terminate-dangling-processes'. -Output is sent to `*standard-output*'. -Arguments are automatically converted to strings with `format'. -Lists are automatically flattened." - (%run (cons command args) :output t)) - -(export-always 'run*) -(defun run* (command &rest args) - "Same as `run' but return output as a string." - (%run (cons command args))) +(defun format-shell-command (shell-command) + (format nil "~a ~a '~a'" + *shell* *shell-command-flag* shell-command)) (export-always 'sh) (defun sh (shell-command) - "Like `run' but for shell commands." - (%run shell-command :output t)) + "Wrapper around `cmd:cmd' to execute SHELL-COMMAND in `*shell*'." + (cmd:cmd (format-shell-command shell-command))) -(export-always 'sh*) -(defun sh* (shell-command) - "Like `sh' but return output as a string." - (%run shell-command)) +(export-always 'sh&) +(defun sh& (shell-command) + "Wrapper around `cmd:cmd&' to execute SHELL-COMMAND in `*shell*'." + (cmd:cmd& (format-shell-command shell-command))) + +(export-always '$sh) +(defun $sh (shell-command) + "Wrapper around `cmd:$cmd' to execute SHELL-COMMAND in `*shell*'." + (cmd:$cmd (format-shell-command shell-command))) + +(defun cmd& (cmd) ; TODO: Support (cmd &rest args) lambda list. + "Like `cmd:cmd&' but run and monitor in a shell. +When Lisp is exited, the command is automatically terminated. +List of background process is maintained in `*process-list*'." + (let* ((cmd (format nil + "bash -c 'set -o monitor; { ~a ; kill $$ ; } & read dummy; kill %1'" cmd)) + (handle (cmd:cmd& cmd :input :stream))) + (push handle *process-list*) + handle)) (export-always 'disk-usage) (defun disk-usage (files) @@ -279,7 +263,7 @@ As a second value, return a list of (FILE SIZE) pairs, biggest file first." (defun tokenize (string) "Return list of STRING lines, where each line is a list of each word." (mapcar (lambda (line) - (delete "" (ppcre:split "\\s+" line) :test #'string=)) + (sera:tokens line)) (str:split (string #\newline) string))) (export-always 'port-process) @@ -288,12 +272,12 @@ As a second value, return a list of (FILE SIZE) pairs, biggest file first." Return process name as second value." (sera:and-let* ((ss-line (first (tokenize - (run* "ss" - "--no-header" - "--listening" - "--tcp" - "--processes" - (format nil "( dport = :~a or sport = :~a )" port port))))) + (cmd:$cmd "ss" + "--no-header" + "--listening" + "--tcp" + "--processes" + (format nil "( dport = :~a or sport = :~a )" port port))))) (process-desc (first (last ss-line))) (process-desc-no-prefix (second (str:split ":" process-desc))) (process-props (first @@ -310,7 +294,7 @@ Return process name as second value." (export-always 'checksum) (defun checksum (file) ; TODO: Use pure CL version. "Return checksum of FILE." - (first (first (tokenize (run* "sha1sum" file))))) + (first (first (tokenize (cmd:$cmd "sha1sum" file))))) (export-always 'relative-path) (defun relative-path (path &optional (parent-directory *default-pathname-defaults*)) @@ -348,7 +332,7 @@ different Btrfs subvolumes." (defun interfaces (&optional interface) "Return IP of current INTERFACE. INTERFACE is a string in the form of `wlp2s0'." - (let* ((raw-list (tokenize (run* "ip" "address" interface)))) + (let* ((raw-list (tokenize (cmd:$cmd "ip" "address" interface)))) (sera:collecting (sera:do-splits ((l r) (raw-list (lambda (line) (ppcre:scan "[0-9]+:" (first line)))))