ambrevar/shell: Replace `run' and friends with `cmd' library.
Pierre Neidhardt
parent
bc361c9b6b
commit
1dc72254f4
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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'?
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue