local/share/common-lisp/source/ambrevar/shell: Add run and sh.

.local/share/common-lisp/source/ambrevar/all.lisp

@@ -1,6 +1,6 @@
 (uiop:define-package #:ambrevar/all
   (:nicknames #:ambrevar)
-  (:use :common-lisp)
+  (:use #:common-lisp)
   ;; Packages we want available at all times:
   (:import-from #:alexandria)
   (:import-from #:bordeaux-threads)

.local/share/common-lisp/source/ambrevar/shell.lisp

@@ -1,7 +1,8 @@
 (uiop:define-package #:ambrevar/shell
   (:documentation "Shell-like utilities.")
   (:nicknames #:$)
-  (:use :common-lisp)
+  (:use #:common-lisp)
+  (:use #:trivia)
   (:import-from #:serapeum #:export-always))
 (in-package #:ambrevar/shell)
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -60,3 +61,68 @@ Without PREDICATES, list all files."
   "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)))
+    ;; TODO: Use :stream directly in launch-program and get stream from
+    ;; process-info to avoid repeating the launch-program call.
+    (match output
+      (:stream
+       (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 can be :STREAM or T (for `*standard-output*')."
+  (%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))