diff options
author | Jan Nieuwenhuizen <janneke@gnu.org> | 2018-10-21 23:18:19 +0200 |
---|---|---|
committer | Jan Nieuwenhuizen <janneke@gnu.org> | 2018-10-21 23:19:35 +0200 |
commit | cf7658f7cb5de0e17f4801faa84c378a4b40033e (patch) | |
tree | 646fa120d67bb41868a543461700e62aa170b2c0 /guix/scripts/pack.scm | |
parent | 09c5a5680a06011f985a84aa26fb890b3be453bd (diff) | |
parent | ffddb42d6c510456997ee6de1c1b8026c9ce6d14 (diff) | |
download | guix-patches-cf7658f7cb5de0e17f4801faa84c378a4b40033e.tar guix-patches-cf7658f7cb5de0e17f4801faa84c378a4b40033e.tar.gz |
Merge branch 'core-updates' into core-updates-next
Diffstat (limited to 'guix/scripts/pack.scm')
-rw-r--r-- | guix/scripts/pack.scm | 150 |
1 files changed, 79 insertions, 71 deletions
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 28462d9b8d..13aa8923cd 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -25,6 +25,7 @@ #:use-module (guix gexp) #:use-module (guix utils) #:use-module (guix store) + #:use-module (guix status) #:use-module (guix grafts) #:use-module (guix monads) #:use-module (guix modules) @@ -197,8 +198,11 @@ added to the pack." (with-directory-excursion %root (exit (zero? (apply system* "tar" - "-I" - (string-join '#+(compressor-command compressor)) + #+@(if (compressor-command compressor) + #~("-I" + (string-join + '#+(compressor-command compressor))) + #~()) "--format=gnu" ;; Avoid non-determinism in the archive. Use @@ -538,6 +542,9 @@ please email '~a'~%") (substitutes? . #t) (build-hook? . #t) (graft? . #t) + (print-build-trace? . #t) + (print-extended-build-trace? . #t) + (multiplexed-build-output? . #t) (verbosity . 0) (symlinks . ()) (compressor . ,(first %compressors)))) @@ -684,72 +691,73 @@ Create a bundle of PACKAGE.\n")) (with-error-handling (with-store store - ;; Set the build options before we do anything else. - (set-build-options-from-command-line store opts) - - (parameterize ((%graft? (assoc-ref opts 'graft?)) - (%guile-for-build (package-derivation - store - (if (assoc-ref opts 'bootstrap?) - %bootstrap-guile - (canonical-package guile-2.2)) - (assoc-ref opts 'system) - #:graft? (assoc-ref opts 'graft?)))) - (let* ((dry-run? (assoc-ref opts 'dry-run?)) - (relocatable? (assoc-ref opts 'relocatable?)) - (manifest (let ((manifest (manifest-from-args store opts))) - ;; Note: We cannot honor '--bootstrap' here because - ;; 'glibc-bootstrap' lacks 'libc.a'. - (if relocatable? - (map-manifest-entries wrapped-package manifest) - manifest))) - (pack-format (assoc-ref opts 'format)) - (name (string-append (symbol->string pack-format) - "-pack")) - (target (assoc-ref opts 'target)) - (bootstrap? (assoc-ref opts 'bootstrap?)) - (compressor (if bootstrap? - bootstrap-xz - (assoc-ref opts 'compressor))) - (archiver (if (equal? pack-format 'squashfs) - squashfs-tools-next - (if bootstrap? - %bootstrap-coreutils&co - tar))) - (symlinks (assoc-ref opts 'symlinks)) - (build-image (match (assq-ref %formats pack-format) - ((? procedure? proc) proc) - (#f - (leave (G_ "~a: unknown pack format~%") - pack-format)))) - (localstatedir? (assoc-ref opts 'localstatedir?))) - (run-with-store store - (mlet* %store-monad ((profile (profile-derivation - manifest - #:relative-symlinks? relocatable? - #:hooks (if bootstrap? - '() - %default-profile-hooks) - #:locales? (not bootstrap?) - #:target target)) - (drv (build-image name profile - #:target - target - #:compressor - compressor - #:symlinks - symlinks - #:localstatedir? - localstatedir? - #:archiver - archiver))) - (mbegin %store-monad - (show-what-to-build* (list drv) - #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:dry-run? dry-run?) - (munless dry-run? - (built-derivations (list drv)) - (return (format #t "~a~%" - (derivation->output-path drv)))))) - #:system (assoc-ref opts 'system))))))) + (with-status-report print-build-event + ;; Set the build options before we do anything else. + (set-build-options-from-command-line store opts) + + (parameterize ((%graft? (assoc-ref opts 'graft?)) + (%guile-for-build (package-derivation + store + (if (assoc-ref opts 'bootstrap?) + %bootstrap-guile + (canonical-package guile-2.2)) + (assoc-ref opts 'system) + #:graft? (assoc-ref opts 'graft?)))) + (let* ((dry-run? (assoc-ref opts 'dry-run?)) + (relocatable? (assoc-ref opts 'relocatable?)) + (manifest (let ((manifest (manifest-from-args store opts))) + ;; Note: We cannot honor '--bootstrap' here because + ;; 'glibc-bootstrap' lacks 'libc.a'. + (if relocatable? + (map-manifest-entries wrapped-package manifest) + manifest))) + (pack-format (assoc-ref opts 'format)) + (name (string-append (symbol->string pack-format) + "-pack")) + (target (assoc-ref opts 'target)) + (bootstrap? (assoc-ref opts 'bootstrap?)) + (compressor (if bootstrap? + bootstrap-xz + (assoc-ref opts 'compressor))) + (archiver (if (equal? pack-format 'squashfs) + squashfs-tools-next + (if bootstrap? + %bootstrap-coreutils&co + tar))) + (symlinks (assoc-ref opts 'symlinks)) + (build-image (match (assq-ref %formats pack-format) + ((? procedure? proc) proc) + (#f + (leave (G_ "~a: unknown pack format~%") + pack-format)))) + (localstatedir? (assoc-ref opts 'localstatedir?))) + (run-with-store store + (mlet* %store-monad ((profile (profile-derivation + manifest + #:relative-symlinks? relocatable? + #:hooks (if bootstrap? + '() + %default-profile-hooks) + #:locales? (not bootstrap?) + #:target target)) + (drv (build-image name profile + #:target + target + #:compressor + compressor + #:symlinks + symlinks + #:localstatedir? + localstatedir? + #:archiver + archiver))) + (mbegin %store-monad + (show-what-to-build* (list drv) + #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:dry-run? dry-run?) + (munless dry-run? + (built-derivations (list drv)) + (return (format #t "~a~%" + (derivation->output-path drv)))))) + #:system (assoc-ref opts 'system)))))))) |