diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/scripts/pack.scm | 97 |
1 files changed, 44 insertions, 53 deletions
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index f65642fb85..e552cb108a 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -678,16 +678,15 @@ Valid compressors are: ~a~%") compressor-name %valid-compressors))) (define data-tarball (computed-file (string-append "data.tar" (compressor-extension compressor)) - (self-contained-tarball/builder - profile - #:profile-name profile-name - #:compressor compressor - #:localstatedir? localstatedir? - #:symlinks symlinks - #:archiver archiver) - #:local-build? #f ;allow offloading - #:options (list #:references-graphs `(("profile" ,profile)) - #:target target))) + (self-contained-tarball/builder profile + #:profile-name profile-name + #:compressor compressor + #:localstatedir? localstatedir? + #:symlinks symlinks + #:archiver archiver) + #:local-build? #f ;allow offloading + #:options (list #:references-graphs `(("profile" ,profile)) + #:target target))) (define build (with-extensions (list guile-gcrypt) @@ -702,6 +701,7 @@ Valid compressors are: ~a~%") compressor-name %valid-compressors))) (guix build utils) (guix profiles) (ice-9 match) + (ice-9 optargs) (srfi srfi-1)) (define machine-type @@ -762,32 +762,23 @@ Valid compressors are: ~a~%") compressor-name %valid-compressors))) (copy-file #+data-tarball data-tarball-file-name) - (define (keyword-ref lst keyword) - (match (memq keyword lst) - ((_ value . _) value) - (#f #f))) - ;; Generate the control archive. - (define control-file - (keyword-ref '#$extra-options #:control-file)) - - (define postinst-file - (keyword-ref '#$extra-options #:postinst-file)) - - (define triggers-file - (keyword-ref '#$extra-options #:triggers-file)) - - (define control-tarball-file-name - (string-append "control.tar" - #$(compressor-extension compressor))) - - ;; Write the compressed control tarball. Only the control file is - ;; mandatory (see: 'man deb' and 'man deb-control'). - (if control-file - (copy-file control-file "control") - (call-with-output-file "control" - (lambda (port) - (format port "\ + (let-keywords '#$extra-options #f + ((control-file #f) + (postinst-file #f) + (triggers-file #f)) + + (define control-tarball-file-name + (string-append "control.tar" + #$(compressor-extension compressor))) + + ;; Write the compressed control tarball. Only the control file is + ;; mandatory (see: 'man deb' and 'man deb-control'). + (if control-file + (copy-file control-file "control") + (call-with-output-file "control" + (lambda (port) + (format port "\ Package: ~a Version: ~a Description: Debian archive generated by GNU Guix. @@ -797,28 +788,28 @@ Priority: optional Section: misc ~%" package-name package-version architecture)))) - (when postinst-file - (copy-file postinst-file "postinst") - (chmod "postinst" #o755)) + (when postinst-file + (copy-file postinst-file "postinst") + (chmod "postinst" #o755)) - (when triggers-file - (copy-file triggers-file "triggers")) + (when triggers-file + (copy-file triggers-file "triggers")) - (define tar (string-append #+archiver "/bin/tar")) + (define tar (string-append #+archiver "/bin/tar")) - (apply invoke tar - `(,@(tar-base-options - #:tar tar - #:compressor #+(and=> compressor compressor-command)) - "-cvf" ,control-tarball-file-name - "control" - ,@(if postinst-file '("postinst") '()) - ,@(if triggers-file '("triggers") '()))) + (apply invoke tar + `(,@(tar-base-options + #:tar tar + #:compressor #+(and=> compressor compressor-command)) + "-cvf" ,control-tarball-file-name + "control" + ,@(if postinst-file '("postinst") '()) + ,@(if triggers-file '("triggers") '()))) - ;; Create the .deb archive using GNU ar. - (invoke (string-append #+binutils "/bin/ar") "-rv" #$output - "debian-binary" - control-tarball-file-name data-tarball-file-name))))) + ;; Create the .deb archive using GNU ar. + (invoke (string-append #+binutils "/bin/ar") "-rv" #$output + "debian-binary" + control-tarball-file-name data-tarball-file-name)))))) (gexp->derivation (string-append name ".deb") build |