summaryrefslogtreecommitdiff
path: root/guix/scripts/package.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/scripts/package.scm')
-rw-r--r--guix/scripts/package.scm68
1 files changed, 44 insertions, 24 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 7cebf6b4d4..c12ddcd8c9 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -1,5 +1,5 @@
;;; 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>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;;
@@ -293,6 +293,22 @@ return its return value."
(format (current-error-port) " interrupted by signal ~a~%" SIGINT)
#f))))
+(define-syntax-rule (leave-on-EPIPE exp ...)
+ "Run EXP... in a context when EPIPE errors are caught and lead to 'exit'
+with successful exit code. This is useful when writing to the standard output
+may lead to EPIPE, because the standard output is piped through 'head' or
+similar."
+ (catch 'system-error
+ (lambda ()
+ exp ...)
+ (lambda args
+ ;; We really have to exit this brutally, otherwise Guile eventually
+ ;; attempts to flush all the ports, leading to an uncaught EPIPE down
+ ;; the path.
+ (if (= EPIPE (system-error-errno args))
+ (primitive-_exit 0)
+ (apply throw args)))))
+
(define* (specification->package+output spec #:optional (output "out"))
"Return the package and output specified by SPEC, or #f and #f; SPEC may
optionally contain a version number and an output name, as in these examples:
@@ -958,15 +974,17 @@ more information.~%"))
profile))
((string-null? pattern)
(let ((numbers (generation-numbers profile)))
- (if (equal? numbers '(0))
- (exit 0)
- (for-each list-generation numbers))))
+ (leave-on-EPIPE
+ (if (equal? numbers '(0))
+ (exit 0)
+ (for-each list-generation numbers)))))
((matching-generations pattern profile)
=>
(lambda (numbers)
(if (null-list? numbers)
(exit 1)
- (for-each list-generation numbers))))
+ (leave-on-EPIPE
+ (for-each list-generation numbers)))))
(else
(leave (_ "invalid syntax: ~a~%")
pattern)))
@@ -976,15 +994,16 @@ more information.~%"))
(let* ((regexp (and regexp (make-regexp regexp)))
(manifest (profile-manifest profile))
(installed (manifest-entries manifest)))
- (for-each (match-lambda
- (($ <manifest-entry> name version output path _)
- (when (or (not regexp)
- (regexp-exec regexp name))
- (format #t "~a\t~a\t~a\t~a~%"
- name (or version "?") output path))))
-
- ;; Show most recently installed packages last.
- (reverse installed))
+ (leave-on-EPIPE
+ (for-each (match-lambda
+ (($ <manifest-entry> name version output path _)
+ (when (or (not regexp)
+ (regexp-exec regexp name))
+ (format #t "~a\t~a\t~a\t~a~%"
+ name (or version "?") output path))))
+
+ ;; Show most recently installed packages last.
+ (reverse installed)))
#t))
(('list-available regexp)
@@ -998,16 +1017,17 @@ more information.~%"))
r)
(cons p r))))
'())))
- (for-each (lambda (p)
- (format #t "~a\t~a\t~a\t~a~%"
- (package-name p)
- (package-version p)
- (string-join (package-outputs p) ",")
- (location->string (package-location p))))
- (sort available
- (lambda (p1 p2)
- (string<? (package-name p1)
- (package-name p2)))))
+ (leave-on-EPIPE
+ (for-each (lambda (p)
+ (format #t "~a\t~a\t~a\t~a~%"
+ (package-name p)
+ (package-version p)
+ (string-join (package-outputs p) ",")
+ (location->string (package-location p))))
+ (sort available
+ (lambda (p1 p2)
+ (string<? (package-name p1)
+ (package-name p2))))))
#t))
(('search regexp)