me
/
guix
Archived
1
0
Fork 0
Code

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>.
master
Ludovic Courtès 2014-05-16 10:20:45 +02:00
parent 5ce3defed1
commit d0281fec03
1 changed files with 21 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
nix/scripts/list-runtime-roots.in
View File

@ -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/(.*)$"))