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>.
This commit is contained in:
Ludovic Courtès 2014-05-16 10:20:45 +02:00
parent 5ce3defed1
commit d0281fec03
1 changed files with 21 additions and 3 deletions

View File

@ -1,7 +1,7 @@
#!@GUILE@ -ds #!@GUILE@ -ds
!# !#
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -109,9 +109,27 @@ or the empty list."
(define (lsof-roots) (define (lsof-roots)
"Return the list of roots as found by calling `lsof'." "Return the list of roots as found by calling `lsof'."
(catch 'system (define parent (getpid))
(catch 'system-error
(lambda () (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 (define %file-rx
(make-regexp "^n/(.*)$")) (make-regexp "^n/(.*)$"))