summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-05-23 22:45:03 +0200
committerLudovic Courtès <ludo@gnu.org>2017-05-23 23:57:28 +0200
commit807ba51950720d5321ea1c95234805ccdf9b479b (patch)
tree844d1e9ff96468747bf84481d9bdafa0a4d1c1b9
parent59d0f067ff9f830d9438d5337ee71120e9694410 (diff)
downloadguix-807ba51950720d5321ea1c95234805ccdf9b479b.tar.gz
guix package: Swallow EPIPE upon 'guix package --list-generations'.
Fixes <http://bugs.gnu.org/27017>.
Reported by Alex Vong <alexvong1995@gmail.com>.

* guix/scripts/package.scm (process-query) <'list-generations>: Wrap
body in 'leave-on-EPIPE'.
-rw-r--r--guix/scripts/package.scm38
1 files changed, 20 insertions, 18 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 1f3f49fc6f..f050fad976 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -681,24 +681,26 @@ processed, #f otherwise."
          (unless (null-list? (cdr numbers))
            (display-profile-content-diff profile (car numbers) (cadr numbers))
            (diff-profiles profile (cdr numbers))))
-       (cond ((not (file-exists? profile))      ; XXX: race condition
-              (raise (condition (&profile-not-found-error
-                                 (profile profile)))))
-             ((string-null? pattern)
-              (list-generation display-profile-content
-                               (car (profile-generations profile)))
-              (diff-profiles profile (profile-generations profile)))
-             ((matching-generations pattern profile)
-              =>
-              (lambda (numbers)
-                (if (null-list? numbers)
-                    (exit 1)
-                    (leave-on-EPIPE
-                     (list-generation display-profile-content (car numbers))
-                     (diff-profiles profile numbers)))))
-             (else
-              (leave (G_ "invalid syntax: ~a~%")
-                     pattern)))
+
+       (leave-on-EPIPE
+        (cond ((not (file-exists? profile))       ; XXX: race condition
+               (raise (condition (&profile-not-found-error
+                                  (profile profile)))))
+              ((string-null? pattern)
+               (list-generation display-profile-content
+                                (car (profile-generations profile)))
+               (diff-profiles profile (profile-generations profile)))
+              ((matching-generations pattern profile)
+               =>
+               (lambda (numbers)
+                 (if (null-list? numbers)
+                     (exit 1)
+                     (begin
+                       (list-generation display-profile-content (car numbers))
+                       (diff-profiles profile numbers)))))
+              (else
+               (leave (G_ "invalid syntax: ~a~%")
+                      pattern))))
        #t)
 
       (('list-installed regexp)