aboutsummaryrefslogtreecommitdiff
path: root/nix/scripts
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-05-16 10:20:45 +0200
committerLudovic Courtès <ludo@gnu.org>2014-05-16 10:20:45 +0200
commitd0281fec03d93a44f7abaa270a3f7417b8e14627 (patch)
tree3d077779eb4c9a58f5bceab3073a568582cd3be7 /nix/scripts
parent5ce3defed18c204989dceed64d3434ed9f3f1a92 (diff)
downloadguix-d0281fec03d93a44f7abaa270a3f7417b8e14627.tar
guix-d0281fec03d93a44f7abaa270a3f7417b8e14627.tar.gz
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 <andreas@enge.fr>.
Diffstat (limited to 'nix/scripts')
-rw-r--r--nix/scripts/list-runtime-roots.in24
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/(.*)$"))