me/guix
Archived
1
0
Fork 0
Code Activity

guix package: Gracefully deal with EPIPE on stdout for --list-*.

Browse source 
* guix/scripts/package.scm (leave-on-EPIPE): New macro.
  (guix-package): Use it for 'list-installed', 'list-available', and
  '--list-generations'.
* tests/guix-package.sh: Add test.
This commit is contained in:
Ludovic Courtès 2014-01-04 22:42:42 +01:00
parent aebaeaee33
commit 1a43e4dc57
2 changed files with 51 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

66
guix/scripts/package.scm
View file

@ -1,5 +1,5 @@
;;; 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>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.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) (format (current-error-port) " interrupted by signal ~a~%" SIGINT)
#f)))) #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")) (define* (specification->package+output spec #:optional (output "out"))
"Return the package and output specified by SPEC, or #f and #f; SPEC may "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: optionally contain a version number and an output name, as in these examples:
@ -958,15 +974,17 @@ more information.~%"))
profile)) profile))
((string-null? pattern) ((string-null? pattern)
(let ((numbers (generation-numbers profile))) (let ((numbers (generation-numbers profile)))
(if (equal? numbers '(0)) (leave-on-EPIPE
(exit 0) (if (equal? numbers '(0))
(for-each list-generation numbers)))) (exit 0)
(for-each list-generation numbers)))))
((matching-generations pattern profile) ((matching-generations pattern profile)
=> =>
(lambda (numbers) (lambda (numbers)
(if (null-list? numbers) (if (null-list? numbers)
(exit 1) (exit 1)
(for-each list-generation numbers)))) (leave-on-EPIPE
(for-each list-generation numbers)))))
(else (else
(leave (_ "invalid syntax: ~a~%") (leave (_ "invalid syntax: ~a~%")
pattern))) pattern)))
@ -976,15 +994,16 @@ more information.~%"))
(let* ((regexp (and regexp (make-regexp regexp))) (let* ((regexp (and regexp (make-regexp regexp)))
(manifest (profile-manifest profile)) (manifest (profile-manifest profile))
(installed (manifest-entries manifest))) (installed (manifest-entries manifest)))
(for-each (match-lambda (leave-on-EPIPE
(($ <manifest-entry> name version output path _) (for-each (match-lambda
(when (or (not regexp) (($ <manifest-entry> name version output path _)
(regexp-exec regexp name)) (when (or (not regexp)
(format #t "~a\t~a\t~a\t~a~%" (regexp-exec regexp name))
name (or version "?") output path)))) (format #t "~a\t~a\t~a\t~a~%"
name (or version "?") output path))))
;; Show most recently installed packages last. ;; Show most recently installed packages last.
(reverse installed)) (reverse installed)))
#t)) #t))
(('list-available regexp) (('list-available regexp)
@ -998,16 +1017,17 @@ more information.~%"))
r) r)
(cons p r)))) (cons p r))))
'()))) '())))
(for-each (lambda (p) (leave-on-EPIPE
(format #t "~a\t~a\t~a\t~a~%" (for-each (lambda (p)
(package-name p) (format #t "~a\t~a\t~a\t~a~%"
(package-version p) (package-name p)
(string-join (package-outputs p) ",") (package-version p)
(location->string (package-location p)))) (string-join (package-outputs p) ",")
(sort available (location->string (package-location p))))
(lambda (p1 p2) (sort available
(string<? (package-name p1) (lambda (p1 p2)
(package-name p2))))) (string<? (package-name p1)
(package-name p2))))))
#t)) #t))
(('search regexp) (('search regexp)

9
tests/guix-package.sh
View file

@ -1,5 +1,5 @@
# 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>
# Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> # Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
# #
# This file is part of GNU Guix. # This file is part of GNU Guix.
@ -218,3 +218,10 @@ done
# Extraneous argument. # Extraneous argument.
if guix package install foo-bar; if guix package install foo-bar;
then false; else true; fi then false; else true; fi
# Make sure the "broken pipe" doesn't yield an error.
# Note: 'pipefail' is a Bash-specific option.
set -o pipefail || true
guix package -A g | head -1 2> "$HOME/err1"
guix package -I | head -1 2> "$HOME/err2"
test "`cat "$HOME/err1" "$HOME/err2"`" = ""