summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/scripts/pack.scm97
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