diff options
Diffstat (limited to 'nix/scripts')
| -rw-r--r-- | nix/scripts/list-runtime-roots.in | 24 |
1 files changed, 21 insertions, 3 deletions
diff --git a/nix/scripts/list-runtime-roots.in b/nix/scripts/list-runtime-roots.in index 4d329c5ff5..993eb169c1 100644 --- a/nix/scripts/list-runtime-roots.in +++ b/nix/scripts/list-runtime-roots.in @@ -1,7 +1,7 @@ #!@GUILE@ -ds !# ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -109,9 +109,27 @@ or the empty list." (define (lsof-roots) "Return the list of roots as found by calling `lsof'." - (catch 'system + (define parent (getpid)) + + (catch 'system-error (lambda () - (let ((pipe (open-pipe* OPEN_READ "lsof" "-n" "-w" "-F" "n"))) + (let ((pipe (catch 'system-error + (lambda () + (open-pipe* OPEN_READ "lsof" "-n" "-w" "-F" "n")) + (lambda args + ;; In Guile 2.0.5, when (ice-9 popen) was still written + ;; in Scheme, 'open-pipe*' would leave the child process + ;; behind it when 'execlp' failed (that was mostly + ;; harmless though, because the uncaught exception would + ;; cause it to terminate after printing a backtrace.) + ;; Make sure that doesn't happen. + (if (= (getpid) parent) + (apply throw args) + (begin + (format (current-error-port) + "failed to execute 'lsof': ~a~%" + (strerror (system-error-errno args))) + (primitive-exit 1))))))) (define %file-rx (make-regexp "^n/(.*)$")) |