(uiop:define-package #:ambrevar/shell (:documentation "Shell-like utilities.") (:nicknames #:$) (:use #:common-lisp) (:use #:trivia) (:import-from #:serapeum #:export-always)) (in-package #:ambrevar/shell) (eval-when (:compile-toplevel :load-toplevel :execute) (trivial-package-local-nicknames:add-package-local-nickname :alex :alexandria) (trivial-package-local-nicknames:add-package-local-nickname :sera :serapeum)) (defun assert-program (program &rest more-programs) ; TODO: Is this useful for a REPL? (sera:and-let* ((missing-programs (delete-if #'sera:resolve-executable (cons program more-programs)))) (error "Missing programs: ~{~a~,^, ~}" missing-programs))) (export-always 'file-extension) (defun file-extension (file) "Return the file extension. If none, return the empty string unlike `pathname-type'." (or (pathname-type file) "")) (export-always 'file-basename) (defun file-basename (file) "Return the file basename (including the extension)." (apply #'str:concat (pathname-name file) (sera:and-let* ((ext (file-extension file))) `("." ,ext)))) (export-always 'match-extensions) (defun match-extensions (extension &rest more-extensions) "Return a predicate for files that match on of the provided extensions. Useful for `finder'." (lambda (file) (some (lambda (ext) (string= ext (pathname-type file))) (cons extension more-extensions)))) (export-always 'finder) (defun finder (root &rest predicates) "List files in directory that satisfy all PREDICATES. Without PREDICATES, list all files." (let ((result '())) (uiop:collect-sub*directories (uiop:ensure-directory-pathname root) (constantly t) (constantly t) (lambda (subdirectory) (setf result (nconc result (let ((subfiles (uiop:directory-files subdirectory))) (if predicates (delete-if (lambda (file) (notany (lambda (pred) (funcall pred file)) predicates)) subfiles) subfiles)))))) result)) (export-always 'make-directory) (defun make-directory (path) "Including parents." (uiop:ensure-all-directories-exist (list (uiop:ensure-directory-pathname path))) path) (defun terminate-process-with-group (process-info) ;; TODO: Is it possible to kill a group without pkill, maybe with osicat? (when (uiop:process-alive-p process-info) (uiop:run-program (list "pkill" "-TERM" "-g" ;TODO: -KILL instead? (format nil "~a" (osicat-posix:getpgid (uiop:process-info-pid process-info))))) (uiop:terminate-process process-info))) (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)) (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)))))) (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 '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))) (export-always 'sh) (defun sh (shell-command) "Like `run' but for shell commands." (%run shell-command :output t)) (export-always 'sh*) (defun sh* (shell-command) "Like `sh' but return output as a string." (%run shell-command)) (export-always 'disk-usage) (defun disk-usage (files) "Return disk usage of FILES in octets. As a second value, return a list of (FILE SIZE) pairs, biggest file first." (let ((pairs (mapcar (lambda (f) (list f (or (trivial-file-size:file-size-in-octets f) 0))) files))) (values (reduce #'+ (mapcar #'second pairs)) (sort pairs #'> :key #'second))))