diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-03-22 21:50:12 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-03-22 22:57:09 +0100 |
| commit | 443eb4e9506026094f5e0dadc3e11d3cf7a86a24 (patch) | |
| tree | 65aaa990b06517dcb1a1d5a89b2856f7ef78e460 /guix/utils.scm | |
| parent | ca534666aa18405c96f661fd108686f2ae72c9aa (diff) | |
| download | gnu-guix-443eb4e9506026094f5e0dadc3e11d3cf7a86a24.tar gnu-guix-443eb4e9506026094f5e0dadc3e11d3cf7a86a24.tar.gz | |
utils: 'filtered-port' doesn't leave dangling processes behind.
* guix/utils.scm (filtered-port): Make sure the 'execl' child process
always exits, and does (primitive-_exit 1) upon execution failure.
Use 'primitive-_exit' in the 'dump-port' child process.
* tests/utils.scm ("filtered-port, does not exist"): New test.
Diffstat (limited to 'guix/utils.scm')
| -rw-r--r-- | guix/utils.scm | 27 |
1 files changed, 19 insertions, 8 deletions
diff --git a/guix/utils.scm b/guix/utils.scm index 68329ec915..15a4390074 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -155,18 +155,29 @@ COMMAND (a list). In addition, return a list of PIDs that the caller must wait. When INPUT is a file port, it must be unbuffered; otherwise, any buffered data is lost." (let loop ((input input) - (pids '())) + (pids '())) (if (file-port? input) (match (pipe) ((in . out) (match (primitive-fork) (0 - (close-port in) - (close-port (current-input-port)) - (dup2 (fileno input) 0) - (close-port (current-output-port)) - (dup2 (fileno out) 1) - (apply execl (car command) command)) + (dynamic-wind + (const #f) + (lambda () + (close-port in) + (close-port (current-input-port)) + (dup2 (fileno input) 0) + (close-port (current-output-port)) + (dup2 (fileno out) 1) + (catch 'system-error + (lambda () + (apply execl (car command) command)) + (lambda args + (format (current-error-port) + "filtered-port: failed to execute '~{~a ~}': ~a~%" + command (strerror (system-error-errno args)))))) + (lambda () + (primitive-_exit 1)))) (child (close-port out) (values in (cons child pids)))))) @@ -184,7 +195,7 @@ buffered data is lost." (dump-port input out)) (lambda () (false-if-exception (close out)) - (primitive-exit 0)))) + (primitive-_exit 0)))) (child (close-port out) (loop in (cons child pids))))))))) |