diff options
Diffstat (limited to 'guix/scripts/pack.scm')
| -rw-r--r-- | guix/scripts/pack.scm | 73 |
1 files changed, 53 insertions, 20 deletions
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 59dd117edb..488638adc5 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net> +;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,7 +34,9 @@ #:use-module (guix derivations) #:use-module (guix scripts build) #:use-module (gnu packages) + #:use-module (gnu packages bootstrap) #:use-module (gnu packages compression) + #:use-module (gnu packages guile) #:autoload (gnu packages base) (tar) #:autoload (gnu packages package-management) (guix) #:autoload (gnu packages gnupg) (libgcrypt) @@ -67,6 +70,11 @@ #~(#+(file-append bzip2 "/bin/bzip2") "-9")) (compressor "none" "" #f))) +;; This one is only for use in this module, so don't put it in %compressors. +(define bootstrap-xz + (compressor "bootstrap-xz" ".xz" + #~(#+(file-append %bootstrap-coreutils&co "/bin/xz") "-e -T0"))) + (define (lookup-compressor name) "Return the compressor object called NAME. Error out if it could not be found." @@ -230,6 +238,7 @@ the image." (define build (with-imported-modules `(,@(source-module-closure '((guix docker)) #:select? not-config?) + (guix build store-copy) ((guix config) => ,config)) #~(begin ;; Guile-JSON is required by (guix docker). @@ -237,13 +246,15 @@ the image." (string-append #+json "/share/guile/site/" (effective-version))) - (use-modules (guix docker) (srfi srfi-19)) + (use-modules (guix docker) (srfi srfi-19) (guix build store-copy)) (setenv "PATH" (string-append #$tar "/bin")) - (build-docker-image #$output #$profile + (build-docker-image #$output + (call-with-input-file "profile" + read-reference-graph) + #$profile #:system (or #$target (utsname:machine (uname))) - #:closure "profile" #:symlinks '#$symlinks #:compressor '#$(compressor-command compressor) #:creation-time (make-time time-utc 0 1))))) @@ -325,6 +336,9 @@ the image." (option '("localstatedir") #f #f (lambda (opt name arg result) (alist-cons 'localstatedir? #t result))) + (option '("bootstrap") #f #f + (lambda (opt name arg result) + (alist-cons 'bootstrap? #t result))) (append %transformation-options %standard-build-options))) @@ -352,6 +366,8 @@ Create a bundle of PACKAGE.\n")) -m, --manifest=FILE create a pack with the manifest from FILE")) (display (G_ " --localstatedir include /var/guix in the resulting pack")) + (display (G_ " + --bootstrap use the bootstrap binaries to build the pack")) (newline) (display (G_ " -h, --help display this help and exit")) @@ -393,28 +409,43 @@ Create a bundle of PACKAGE.\n")) (else (packages->manifest packages))))) (with-error-handling - (parameterize ((%graft? (assoc-ref opts 'graft?))) - (let* ((dry-run? (assoc-ref opts 'dry-run?)) - (manifest (manifest-from-args opts)) - (pack-format (assoc-ref opts 'format)) - (name (string-append (symbol->string pack-format) - "-pack")) - (target (assoc-ref opts 'target)) - (compressor (assoc-ref opts 'compressor)) - (symlinks (assoc-ref opts 'symlinks)) - (build-image (match (assq-ref %formats pack-format) - ((? procedure? proc) proc) - (#f - (leave (G_ "~a: unknown pack format") - format)))) - (localstatedir? (assoc-ref opts 'localstatedir?))) - (with-store store + (let* ((dry-run? (assoc-ref opts 'dry-run?)) + (manifest (manifest-from-args opts)) + (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))) + (tar (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") + format)))) + (localstatedir? (assoc-ref opts 'localstatedir?))) + (with-store store + (parameterize ((%graft? (assoc-ref opts 'graft?)) + (%guile-for-build (package-derivation + store + (if (assoc-ref opts 'bootstrap?) + %bootstrap-guile + (canonical-package guile-2.2))))) ;; Set the build options before we do anything else. (set-build-options-from-command-line store opts) (run-with-store store (mlet* %store-monad ((profile (profile-derivation manifest + #:hooks (if bootstrap? + '() + %default-profile-hooks) + #:locales? (not bootstrap?) #:target target)) (drv (build-image name profile #:target @@ -424,7 +455,9 @@ Create a bundle of PACKAGE.\n")) #:symlinks symlinks #:localstatedir? - localstatedir?))) + localstatedir? + #:tar + tar))) (mbegin %store-monad (show-what-to-build* (list drv) #:use-substitutes? |