On Thu, May 23, 2013 at 08:57:09AM -0700, Bryan Vicknair wrote: > Thanks a lot Evan and Peter. That was very helpful. > > I started looking at the process-fork source to write a patch, but I'm not > familiar enough with chicken-core yet to tackle it. For now I changed my code > to use the process* variant that sends a command to the shell and that is > working.
I've attached a patch that I *think* does the trick. It also shoots down any additional threads which may be running in the child process (even though those should probably not get a chance to run, you never know). I've also simplified the argument handling and needless(?) messing about with process-fork without thunk in process-run. I'd love it if people could test this and provide feedback, because I'm pretty unsure whether this fix is the correct one. I've had some trouble trying to wait for the process, but I was unable to do that even if the program I tried to execute existed, so that must be a case of PEBKAC. Cheers, Peter -- http://www.more-magic.net
>From d4de7eb646e57e8c2d2e3d3649cf1a3ec1b65cd8 Mon Sep 17 00:00:00 2001 From: Peter Bex <[email protected]> Date: Thu, 23 May 2013 21:15:19 +0200 Subject: [PATCH] Kill other threads when starting a process, and exit even when an exception occurs (reported by Bryan Vicknair, analysis by Evan Hanson) --- NEWS | 3 +++ posixunix.scm | 32 ++++++++++++++++++-------------- 2 files changed, 21 insertions(+), 14 deletions(-) diff --git a/NEWS b/NEWS index be9d098..c08ca60 100644 --- a/NEWS +++ b/NEWS @@ -32,6 +32,9 @@ (thanks to Florian Zumbiehl) - posix: memory-mapped file support for Windows (thanks to "rivo") - posix: find-file's test argument now also accepts SRE forms. + - posix: process, process* and process-run now properly kill other threads + and cause the process to exit with status 1 if running the process fails + (thanks to Evan Hanson and Bryan Vicknair) - Runtime system - Special events in poll() are now handled, avoiding hangs in threaded apps. diff --git a/posixunix.scm b/posixunix.scm index a2776da..7d8dcaf 100644 --- a/posixunix.scm +++ b/posixunix.scm @@ -1734,12 +1734,14 @@ EOF (when (fx= -1 pid) (posix-error #:process-error 'process-fork "cannot create child process")) (if (and thunk (zero? pid)) - ((if killothers - ##sys#kill-other-threads - (lambda (thunk) (thunk))) - (lambda () - (thunk) - ((foreign-lambda void "_exit" int) 0) )) + (handle-exceptions exn + ((foreign-lambda void "_exit" int) 1) + ((if killothers + ##sys#kill-other-threads + (lambda (thunk) (thunk))) + (lambda () + (thunk) + ((foreign-lambda void "_exit" int) 0) ))) pid))))) (define process-execute @@ -1816,13 +1818,14 @@ EOF (list "-c" cmdlin) ) (define process-run - (lambda (f . args) - (let ([args (if (pair? args) (car args) #f)] - [pid (process-fork)] ) - (cond [(not (eq? 0 pid)) pid] - [args (process-execute f args)] - [else - (process-execute (##sys#shell-command) (##sys#shell-command-arguments f)) ] ) ) ) ) + (lambda (f #!optional args) + (process-fork + (lambda () + (if args + (process-execute f args) + (process-execute (##sys#shell-command) + (##sys#shell-command-arguments f)) )) + #t) ) ) ;;; Run subprocess connected with pipes: @@ -1893,7 +1896,8 @@ EOF (connect-child loc opipe stdinf fileno/stdin) (connect-child loc (swapped-ends ipipe) stdoutf fileno/stdout) (connect-child loc (swapped-ends epipe) stderrf fileno/stderr) - (process-execute cmd args env)))) ) ) )] + (process-execute cmd args env)) + #t)) ) ) )] [input-port (lambda (loc pid cmd pipe stdf stdfd on-close) (and-let* ([fd (connect-parent loc pipe stdf stdfd)]) -- 1.8.2.3
_______________________________________________ Chicken-users mailing list [email protected] https://lists.nongnu.org/mailman/listinfo/chicken-users
