diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/package.scm | 16 | ||||
| -rw-r--r-- | guix/scripts/publish.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/size.scm | 21 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 11 |
4 files changed, 19 insertions, 31 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 56a6e2db64..b545ea2672 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -307,22 +307,6 @@ RX." ((<) #t) (else #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 (upgradeable? name current-version current-path) "Return #t if there's a version of package NAME newer than CURRENT-VERSION, or if the newest available version is equal to CURRENT-VERSION but would have diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index 7bad2619b9..e0226f35ee 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -143,7 +143,7 @@ Publish ~a over HTTP.\n") %store-directory) "Generate a narinfo key/value string for STORE-PATH using the details in PATH-INFO. The narinfo is signed with KEY." (let* ((url (string-append "nar/" (basename store-path))) - (hash (bytevector->base32-string + (hash (bytevector->nix-base32-string (path-info-hash path-info))) (size (path-info-nar-size path-info)) (references (string-join diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm index 13341fdfe2..1339742946 100644 --- a/guix/scripts/size.scm +++ b/guix/scripts/size.scm @@ -280,15 +280,16 @@ Report the size of PACKAGE and its dependencies.\n")) (() (leave (_ "missing store item argument\n"))) ((file) - (with-store store - (run-with-store store - (mlet* %store-monad ((item (ensure-store-item file)) - (profile (store-profile item))) - (if map-file - (begin - (profile->page-map profile map-file) - (return #t)) - (display-profile* profile))) - #:system system))) + (leave-on-EPIPE + (with-store store + (run-with-store store + (mlet* %store-monad ((item (ensure-store-item file)) + (profile (store-profile item))) + (if map-file + (begin + (profile->page-map profile map-file) + (return #t)) + (display-profile* profile))) + #:system system)))) ((files ...) (leave (_ "too many arguments\n"))))))) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 6084ab8a37..45f598219d 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -249,16 +249,19 @@ it atomically, and then run OS's activation script." (('boot-parameters ('version 0) ('label label) ('root-device root) ('kernel linux) - _ ...) + rest ...) (menu-entry (label (string-append label " (#" (number->string number) ", " (seconds->string time) ")")) (linux linux) (linux-arguments - (list (string-append "--root=" root) - #~(string-append "--system=" #$system) - #~(string-append "--load=" #$system "/boot"))) + (cons* (string-append "--root=" root) + #~(string-append "--system=" #$system) + #~(string-append "--load=" #$system "/boot") + (match (assq 'kernel-arguments rest) + ((_ args) args) + (#f '())))) ;old format (initrd #~(string-append #$system "/initrd")))) (_ ;unsupported format (warning (_ "unrecognized boot parameters for '~a'~%") |