me
/
guix
Archived
1
0
Fork 0
Code

pack: Use let-keywords instead of keyword-ref. 

* guix/scripts/pack.scm: (debian-archive): Bind extra-options keyword
arguments via let-keywords.
Maxim Cournoyer 2023-02-01 09:52:43 -05:00
parent 068971805a
commit 5c099f496f
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
1 changed files with 42 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
guix/scripts/pack.scm
View File

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