From f05cb10acd118a0aedd93df76fd08f368bb96540 Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Fri, 8 Sep 2017 20:38:41 -0700 Subject: [PATCH] Fix #41: Report proper process status The main problem is that we weren't calling wait3 with WCONTINUED so that we would be signaled when the process continues. And we also need to check that result of wait call was WCONTINUED> Replace the wait3 routine with a C routine (prog_status) so we don't have to deal with the OS-specific flags. This function basically returns what the lisp function wait3 did. Use this function in GET-PROCESSES-STATUS-CHANGES. - runprog.c: - Add prog_status - run-program.lisp: - Use prog_status instead of wait3 - issues.lisp: - Add basic test --- src/code/run-program.lisp | 18 +++++++++++++- src/lisp/runprog.c | 49 +++++++++++++++++++++++++++++++++++++++ tests/issues.lisp | 38 ++++++++++++++++++++++++++++++ 3 files changed, 104 insertions(+), 1 deletion(-) diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index 87ed8fce1..f16dfb088 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -34,6 +34,12 @@ (options c-call:int) (rusage c-call:int)) +(alien:def-alien-routine ("prog_status" c-prog-status) c-call:void + (pid c-call:int :out) + (what c-call:int :out) + (code c-call:int :out) + (corep c-call:int :out)) + (eval-when (load eval compile) (defconstant wait-wnohang #-svr4 1 #+svr4 #o100) (defconstant wait-wuntraced #-svr4 2 #+svr4 4) @@ -73,6 +79,16 @@ signal (not (zerop (ldb (byte 1 7) status))))))))) +(defun prog-status () + (multiple-value-bind (ret pid what code corep) + (c-prog-status) + (declare (ignore ret)) + (when (plusp pid) + (values pid + (aref #(nil :signaled :stopped :continued :exited) what) + code + (not (zerop corep)))))) + ;;;; Process control stuff. @@ -235,7 +251,7 @@ (defun get-processes-status-changes () (loop (multiple-value-bind (pid what code core) - (wait3 t t) + (prog-status) (unless pid (return)) (let ((proc (find pid *active-processes* :key #'process-pid))) diff --git a/src/lisp/runprog.c b/src/lisp/runprog.c index 4832ff817..e6a5a0d77 100644 --- a/src/lisp/runprog.c +++ b/src/lisp/runprog.c @@ -10,6 +10,7 @@ #include <stdlib.h> #include <termios.h> #include <unistd.h> +#include <sys/wait.h> pid_t spawn(char *program, char *argv[], char *envp[], char *pty_name, @@ -70,3 +71,51 @@ spawn(char *program, char *argv[], char *envp[], char *pty_name, /* The exec didn't work, flame out. */ exit(1); } + +/* + * Call waitpid and return appropriate information about what happened. + * + * what - int taking the values: + * 0 - ok + * 1 - signaled + * 2 - stopped + * 3 - continued + * 4 - exited + * code - the terminating signal + * core - true (non-zero) if a core was produced + */ + +void +prog_status(pid_t* pid, int* what, int* code, int* corep) +{ + pid_t w; + int status; + + w = waitpid(-1, &status, WNOHANG | WUNTRACED | WCONTINUED); + *pid = w; + + if (w == -1) { + + return; + } + + if (WIFEXITED(status)) { + *what = 4; + *code = WEXITSTATUS(status); + *corep = 0; + } else if (WIFSIGNALED(status)) { + *what = 1; + *code = WTERMSIG(status); + *corep = WCOREDUMP(status); + } else if (WIFSTOPPED(status)) { + *what = 2; + *code = WSTOPSIG(status); + *corep = 0; + } else if (WIFCONTINUED(status)) { + *what = 3; + *code = 0; + *corep = 0; + } + + return; +} diff --git a/tests/issues.lisp b/tests/issues.lisp index 0cff9c139..1af498f42 100644 --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -367,3 +367,41 @@ ;; get-universal-time only has an accuracy of 1 sec, just verify ;; more than 3 sec have elapsed. (assert-true (>= (- (get-universal-time) start-time) 3))))) + +(defun issue-41-tester (stop-signal) + (let* ((p (ext:run-program "/bin/sleep" '("5") :wait nil)) + (pid (ext:process-pid p))) + (flet ((external-kill (pid signal) + (ext:run-program "/usr/bin/env" + (list "kill" + (format nil "-~D" signal) + (format nil "~D" pid))))) + (assert-eql :running (ext:process-status p)) + + (external-kill pid stop-signal) + (sleep 1) + (assert-eql :stopped (ext:process-status p)) + + (external-kill pid unix:sigcont) + (sleep 1) + (assert-eql :continued (ext:process-status p)) + + (external-kill pid stop-signal) + (sleep 1) + (assert-eql :stopped (ext:process-status p)) + + (external-kill pid unix:sigcont) + (sleep 1) + (assert-eql :continued (ext:process-status p)) + + (sleep 5) + (assert-eql :exited (ext:process-status p))))) + +(define-test issue.41.1 + (:tag :issues) + (issue-41-tester unix:sigstop)) + +#+nil +(define-test issue.41.2 + (:tag :issues) + (issue-41-tester unix:sigtstp)) -- GitLab