From d0281fec03d93a44f7abaa270a3f7417b8e14627 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 16 May 2014 10:20:45 +0200 Subject: list-runtime-roots: Don't display a backtrace on 2.0.5 when lsof is lacking. * nix/scripts/list-runtime-roots.in (lsof-roots): Fix typo in 'catch' tag. Add 'parent' variable. Wrap 'open-pipe*' call in 'catch'. Reported by Andreas Enge . --- nix/scripts/list-runtime-roots.in | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) (limited to 'nix/scripts/list-runtime-roots.in') 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 +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; ;;; 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/(.*)$")) -- cgit v1.2.3