external-process-status not always updated correctly

[gb]

see ​https://lists.clozure.com/pipermail/openmcl-devel/2016-August/011376.html

[pipping]

[copying over my email]

I’m trying to find out how different lisp compilers handle external processes(*). As a part of that, I’ve created a short piece of code that launches an external process, sends it SIGSTOP, asks its about its well-being, and allows its to go about its business again by sending SIGCONT.

I would expect that ccl:external-process-status consequently reports

1. :running before SIGSTOP is sent
2. then :stopped
3. then :running again once SIGCONT was received
4. and finally :exited.

Indeed, that is what ps would do if you ran it on the command line (so I’ve added that to the example for comparison). Here’s the output of my script:

external status: [S] (expected: [S])
internal status: RUNNING (expected: running)
external status: [T] (expected: [T])
internal status: STOPPED (expected: stopped)
external status: [S] (expected: [S])
internal status: STOPPED (expected: running)
external status: [] (expected: [] or [Z])
internal status: EXITED (expected: exited)

My expectations aren’t met in (3): The SIGCONT prompts the process to continue its work but ccl continues to report its status as :stopped, which I find rather confusing.

(*) I've sent similar e-mails to sbcl-devel and ecl-devel.

Here's the [updated] code that I used:

;; careful with cmucl. it doesn't actually sleep when external processes
;; are around https://gitlab.common-lisp.net/cmucl/cmucl/issues/26
#+clozure (use-package :ccl)
#+sbcl (use-package :sb-ext)
#+cmu (use-package :ext)
#+mkcl (use-package :mk-ext)

#+clozure (setf (fdefinition 'process-output) #'external-process-output-stream)
#+ecl (setf (fdefinition 'process-output) #'ext:external-process-output)

(defun my-run-program (&rest rest)
  #+ecl (nth-value 2 (apply #'ext:run-program rest))
  #+mkcl (nth-value 1 (apply #'mk-ext:run-program rest))
  #-(or ecl mkcl) (apply #'run-program rest))

(defconstant +sigstop+
  #+clozure (symbol-value (read-from-string "#$SIGSTOP"))
  #+cmu unix:sigstop
  #+ecl ext:+sigstop+
  #+sbcl (progn (require :sb-posix)
                (symbol-value (find-symbol (symbol-name :sigstop)
                                           (find-package :sb-posix))))
  #-(or clozure cmu ecl sbcl) (or #+darwin 17 #-darwin 19)) ; FIXME
(defconstant +sigtstp+
  #+clozure (symbol-value (read-from-string "#$SIGTSTP"))
  #+cmu unix:sigtstp
  #+ecl ext:+sigtstp+
  #+sbcl (progn (require :sb-posix)
                (symbol-value (find-symbol (symbol-name :sigtstp)
                                           (find-package :sb-posix))))
  #-(or clozure cmu ecl sbcl) (or #+darwin 18 #-darwin 20)) ; FIXME
(defconstant +sigcont+
  #+clozure (symbol-value (read-from-string "#$SIGCONT"))
  #+cmu unix:sigcont
  #+ecl ext:+sigcont+
  #+sbcl (progn (require :sb-posix)
                (symbol-value (find-symbol (symbol-name :sigcont)
                                           (find-package :sb-posix))))
  #-(or clozure cmu ecl sbcl) (or #+darwin 19 #-darwin 18)) ; FIXME

(defun internal-status (process)
  #+clozure (external-process-status process)
  #+(or sbcl cmu) (process-status process)
  #+ecl (ext:external-process-status process)
  #+mkcl (mk-ext:process-status process))

(defun external-kill (pid signal)
  (my-run-program "/usr/bin/env" (list "kill"
                                    (format nil "-~a" signal)
                                    (format nil "~a" pid))))

;; ecl does not support writing to a string stream
(defun external-status (pid)
  (let* ((arg-list (list "ps" "-h" "-p" (format nil "~a" pid) "-o" "state"))
         (process (my-run-program "/usr/bin/env" arg-list :output :stream))
         (output (process-output process))
         ; we expect a single letter
         (target (make-string 1)))
    (read-sequence target output)
    target))

(defun get-pid (process)
  #+clozure (ccl::external-process-pid process)
  #+ecl (ext:external-process-pid process)
  #+(or sbcl cmu) (process-pid process)
  #+mkcl (mkcl:process-id process))

(let* ((p (my-run-program "/usr/bin/env" '("sleep" "3") :wait nil))
       (pid (get-pid p)))
  (format t "external status: [~a] (expected: [S])~%" (external-status pid))
  (format t "internal status: ~a (expected: running)~%" (internal-status p))
  
  (external-kill pid +sigstop+)
  (sleep 1)
  (format t "external status: [~a] (expected: [T])~%" (external-status pid))
  (format t "internal status: ~a (expected: stopped)~%" (internal-status p))

  (external-kill pid +sigcont+)
  (sleep 1)
  (format t "external status: [~a] (expected: [S])~%" (external-status pid))
  (format t "internal status: ~a (expected: running)~%" (internal-status p))

  (sleep 3)
  (format t "external status: [~a] (expected: [] or [Z])~%" (external-status pid))
  (format t "internal status: ~a (expected: exited)~%" (internal-status p)))

[pipping]

Here's another piece of sample code:

#+sbcl (require :sb-posix)

(defconstant +sigkill+
  #+clozure (symbol-value (read-from-string "#$SIGKILL"))
  #+sbcl sb-posix:sigkill)
(defconstant +sigstop+
  #+clozure (symbol-value (read-from-string "#$SIGSTOP"))
  #+sbcl sb-posix:sigstop)
(defconstant +sigcont+
  #+clozure (symbol-value (read-from-string "#$SIGCONT"))
  #+sbcl sb-posix:sigcont)

(defun check-internal-status (process expected)
  (format t "Internal status now: ~a (expected: ~a)~%"
          #+clozure (ccl:external-process-status process)
          #+sbcl (sb-ext:process-status process)
          expected))

(defun get-pid (process)
  #+clozure (ccl::external-process-pid process)
  #+sbcl (sb-ext:process-pid process))

(defun internal-kill-by-symbol (process signal-symbol)
  (format t "Sending signal: ~S~%" signal-symbol)
  (let ((signal-value (symbol-value signal-symbol)))
    #+clozure (ccl:signal-external-process process signal-value)
    #+sbcl (sb-ext:process-kill process signal-value)))

(defun check-external-status (process expected)
  (let ((pid (get-pid process))
        (stream (make-string-output-stream)))
    (let ((arg-list (list "ps" "-h" "-p" (format nil "~a" pid) "-o" "state")))
      (funcall #+clozure #'ccl:run-program
               #+sbcl #'sb-ext:run-program
               "/usr/bin/env" arg-list :output stream))
    (format t "External status now: [~a] (expected: ~a)~%"
            (string-right-trim '(#\Newline)
                               (get-output-stream-string stream))
            expected)))

(defun wait-for-process (process)
  #+clozure (ccl::external-process-wait process)
  #+sbcl (sb-ext:process-wait process))

(let ((p (funcall #+clozure #'ccl:run-program
                  #+sbcl #'sb-ext:run-program
                 "/bin/sleep" (list "7") :wait nil)))
  (internal-kill-by-symbol p '+sigstop+)
  (sleep 3)
  (check-internal-status p "STOPPED")
  (check-external-status p "[T]")
  
  (internal-kill-by-symbol p '+sigcont+)
  (sleep 3)
  (check-internal-status p "RUNNING")
  (check-external-status p "[S]")

  (internal-kill-by-symbol p '+sigkill+)
  (sleep 3)
  (check-internal-status p "SIGNALED")
  (check-external-status p "[]/[Z]")

  (sleep 10)
  (check-internal-status p "SIGNALED")
  (check-external-status p "[]/[Z]")

  (format t "If we're lucky, this will terminate at some point...~%")
  (wait-for-process p))

This prints

Sending signal: +SIGSTOP+
Internal status now: STOPPED (expected: STOPPED)
External status now: [T] (expected: [T])
Sending signal: +SIGCONT+
Internal status now: STOPPED (expected: RUNNING)
External status now: [S] (expected: [S])
Sending signal: +SIGKILL+
Internal status now: SIGNALED (expected: SIGNALED)
External status now: [] (expected: []/[Z])
Internal status now: SIGNALED (expected: SIGNALED)
External status now: [] (expected: []/[Z])
If we're lucky, this will terminate at some point...

and then terminates. Here, a process that's really running is reported as stopped.

[pipping]

I think this bug report has been paid to little attention, for which I also have myself to blame because it’s really not fun to read.

In summary: CCL appears not to detect when a process is resumed. After a SIGCONT the process will still be considered stopped.

I’ve put up a more recent, hopefully more comprehensible combination of code and output here, where I can easily update it:

​https://gitlab.common-lisp.net/asdf/asdf/snippets/24

Hope that helps.