ambrevar: Patch cmd to kill child processes cleanly.

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

@@ -42,4 +42,5 @@
    #:ambrevar/debug
    #:ambrevar/guix
    #:ambrevar/shell
-   #:ambrevar/syspack))
+   #:ambrevar/syspack
+   #:ambrevar/patches/cmd))

.local/share/common-lisp/source/ambrevar/patches/cmd.lisp

@@ -0,0 +1,48 @@
+(uiop:define-package ambrevar/patches/cmd
+  (:use #:common-lisp))
+
+(in-package cmd)
+
+;; See https://github.com/ruricolist/cmd/issues/5.
+(defun await (proc &key ignore-error-status tokens)
+  "Wait for PROC to finish."
+  (nest
+   (let ((out (uiop:process-info-output proc))
+         (err (uiop:process-info-error-output proc))))
+   (handler-bind ((serious-condition
+                    ;; Flush output on error.
+                    (lambda (e) (declare (ignore e))
+                      (finish-output out)
+                      (finish-output err)))))
+   (let ((abnormal? t)))
+   (unwind-protect
+        (multiple-value-prog1
+            (let ((status (uiop:wait-process proc)))
+              (cond ((zerop status)
+                     status)
+                    (ignore-error-status
+                     status)
+                    (t
+                     (cerror "IGNORE-ERROR-STATUS"
+                             'uiop:subprocess-error
+                             :command tokens
+                             :code status
+                             :process proc)
+                     status)))
+          (setf abnormal? nil))
+     (when abnormal?
+       ;; PATCH:
+       (labels ((child-pids (pid)
+                  (let ((pids
+                          (mapcar #'parse-integer
+                                  (ignore-errors
+                                   (tokens
+                                    (uiop:run-program `("pgrep" "-P" ,(write-to-string pid))
+                                                      :output '(:string :stripped t)))))))
+                    (append (mappend #'child-pids pids)
+                            pids))))
+         (mapc (lambda (pid)
+                 ;; TODO: Use Osicat?
+                 (uiop:run-program `("kill" "-TERM" ,(write-to-string pid)) :ignore-error-status t))
+               (child-pids (uiop:process-info-pid proc)))
+         (uiop:terminate-process proc))))))