pack: Allow embedding custom control files in deb packs.
* guix/scripts/pack.scm (self-contained-tarball/builder) [extra-options]: New argument. (self-contained-tarball, squashfs-image, docker-image) (debian-archive): Likewise. Remove two TODO comments. Document EXTRA-OPTIONS. Use the custom control files when provided. (%deb-format-options): New variable. (show-deb-format-options, show-deb-format-options/detailed): New procedures. (%options): Register new options. (show-help): Augment with new usage. (guix-pack): Validate and propagate new argument values. * doc/guix.texi (Invoking guix pack)[deb]: Document how to list advanced options. Add an example. * tests/pack.scm (deb archive...): Provide extra-options to the debian-archive procedure, and validate that the provided files are embedded in the pack.
This commit is contained in:
parent
15b4372b60
commit
aeded14b83
|
@ -6047,6 +6047,14 @@ such file or directory'' message.
|
||||||
This produces a Debian archive (a package with the @samp{.deb} file
|
This produces a Debian archive (a package with the @samp{.deb} file
|
||||||
extension) containing all the specified binaries and symbolic links,
|
extension) containing all the specified binaries and symbolic links,
|
||||||
that can be installed on top of any dpkg-based GNU(/Linux) distribution.
|
that can be installed on top of any dpkg-based GNU(/Linux) distribution.
|
||||||
|
Advanced options can be revealed via the @option{--help-deb-format}
|
||||||
|
option. They allow embedding control files for more fine-grained
|
||||||
|
control, such as activating specific triggers or providing a maintainer
|
||||||
|
configure script to run arbitrary setup code upon installation.
|
||||||
|
|
||||||
|
@example
|
||||||
|
guix pack -f deb -C xz -S /usr/bin/hello=bin/hello hello
|
||||||
|
@end example
|
||||||
|
|
||||||
@quotation Note
|
@quotation Note
|
||||||
Because archives produced with @command{guix pack} contain a collection
|
Because archives produced with @command{guix pack} contain a collection
|
||||||
|
|
|
@ -205,7 +205,8 @@ its source property."
|
||||||
(compressor (first %compressors))
|
(compressor (first %compressors))
|
||||||
localstatedir?
|
localstatedir?
|
||||||
(symlinks '())
|
(symlinks '())
|
||||||
(archiver tar))
|
(archiver tar)
|
||||||
|
(extra-options '()))
|
||||||
"Return the G-Expression of the builder used for self-contained-tarball."
|
"Return the G-Expression of the builder used for self-contained-tarball."
|
||||||
(define database
|
(define database
|
||||||
(and localstatedir?
|
(and localstatedir?
|
||||||
|
@ -324,7 +325,8 @@ its source property."
|
||||||
(compressor (first %compressors))
|
(compressor (first %compressors))
|
||||||
localstatedir?
|
localstatedir?
|
||||||
(symlinks '())
|
(symlinks '())
|
||||||
(archiver tar))
|
(archiver tar)
|
||||||
|
(extra-options '()))
|
||||||
"Return a self-contained tarball containing a store initialized with the
|
"Return a self-contained tarball containing a store initialized with the
|
||||||
closure of PROFILE, a derivation. The tarball contains /gnu/store; if
|
closure of PROFILE, a derivation. The tarball contains /gnu/store; if
|
||||||
LOCALSTATEDIR? is true, it also contains /var/guix, including /var/guix/db
|
LOCALSTATEDIR? is true, it also contains /var/guix, including /var/guix/db
|
||||||
|
@ -389,7 +391,8 @@ to the search paths of PROFILE."
|
||||||
entry-point
|
entry-point
|
||||||
localstatedir?
|
localstatedir?
|
||||||
(symlinks '())
|
(symlinks '())
|
||||||
(archiver squashfs-tools))
|
(archiver squashfs-tools)
|
||||||
|
(extra-options '()))
|
||||||
"Return a squashfs image containing a store initialized with the closure of
|
"Return a squashfs image containing a store initialized with the closure of
|
||||||
PROFILE, a derivation. The image contains a subset of /gnu/store, empty mount
|
PROFILE, a derivation. The image contains a subset of /gnu/store, empty mount
|
||||||
points for virtual file systems (like procfs), and optional symlinks.
|
points for virtual file systems (like procfs), and optional symlinks.
|
||||||
|
@ -567,7 +570,8 @@ added to the pack."
|
||||||
entry-point
|
entry-point
|
||||||
localstatedir?
|
localstatedir?
|
||||||
(symlinks '())
|
(symlinks '())
|
||||||
(archiver tar))
|
(archiver tar)
|
||||||
|
(extra-options '()))
|
||||||
"Return a derivation to construct a Docker image of PROFILE. The
|
"Return a derivation to construct a Docker image of PROFILE. The
|
||||||
image is a tarball conforming to the Docker Image Specification, compressed
|
image is a tarball conforming to the Docker Image Specification, compressed
|
||||||
with COMPRESSOR. It can be passed to 'docker load'. If TARGET is true, it
|
with COMPRESSOR. It can be passed to 'docker load'. If TARGET is true, it
|
||||||
|
@ -654,8 +658,6 @@ the image."
|
||||||
;;; TODO: When relocatable option is selected, install to a unique prefix.
|
;;; TODO: When relocatable option is selected, install to a unique prefix.
|
||||||
;;; This would enable installation of multiple deb packs with conflicting
|
;;; This would enable installation of multiple deb packs with conflicting
|
||||||
;;; files at the same time.
|
;;; files at the same time.
|
||||||
;;; TODO: Allow passing a custom control file from the CLI.
|
|
||||||
;;; TODO: Allow providing a postinst script.
|
|
||||||
(define* (debian-archive name profile
|
(define* (debian-archive name profile
|
||||||
#:key target
|
#:key target
|
||||||
(profile-name "guix-profile")
|
(profile-name "guix-profile")
|
||||||
|
@ -664,7 +666,8 @@ the image."
|
||||||
(compressor (first %compressors))
|
(compressor (first %compressors))
|
||||||
localstatedir?
|
localstatedir?
|
||||||
(symlinks '())
|
(symlinks '())
|
||||||
(archiver tar))
|
(archiver tar)
|
||||||
|
(extra-options '()))
|
||||||
"Return a Debian archive (.deb) containing a store initialized with the
|
"Return a Debian archive (.deb) containing a store initialized with the
|
||||||
closure of PROFILE, a derivation. The archive contains /gnu/store; if
|
closure of PROFILE, a derivation. The archive contains /gnu/store; if
|
||||||
LOCALSTATEDIR? is true, it also contains /var/guix, including /var/guix/db
|
LOCALSTATEDIR? is true, it also contains /var/guix, including /var/guix/db
|
||||||
|
@ -672,7 +675,8 @@ with a properly initialized store database. The supported compressors are
|
||||||
\"none\", \"gz\" or \"xz\".
|
\"none\", \"gz\" or \"xz\".
|
||||||
|
|
||||||
SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be
|
SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be
|
||||||
added to the pack."
|
added to the pack. EXTRA-OPTIONS may contain the CONFIG-FILE, POSTINST-FILE
|
||||||
|
or TRIGGERS-FILE keyword arguments."
|
||||||
;; For simplicity, limit the supported compressors to the superset of
|
;; For simplicity, limit the supported compressors to the superset of
|
||||||
;; compressors able to compress both the control file (gz or xz) and the
|
;; compressors able to compress both the control file (gz or xz) and the
|
||||||
;; data tarball (gz, bz2 or xz).
|
;; data tarball (gz, bz2 or xz).
|
||||||
|
@ -714,21 +718,23 @@ Valid compressors are: ~a~%") compressor-name %valid-compressors)))
|
||||||
(guix build utils)
|
(guix build utils)
|
||||||
(guix profiles)
|
(guix profiles)
|
||||||
(ice-9 match)
|
(ice-9 match)
|
||||||
|
((oop goops) #:select (get-keyword))
|
||||||
(srfi srfi-1))
|
(srfi srfi-1))
|
||||||
|
|
||||||
(define machine-type
|
(define machine-type
|
||||||
;; Extract the machine type from the specified target, else from the
|
;; Extract the machine type from the specified target, else from the
|
||||||
;; current system.
|
;; current system.
|
||||||
(and=> (or #$target %host-type) (lambda (triplet)
|
(and=> (or #$target %host-type)
|
||||||
(first (string-split triplet #\-)))))
|
(lambda (triplet)
|
||||||
|
(first (string-split triplet #\-)))))
|
||||||
|
|
||||||
(define (gnu-machine-type->debian-machine-type type)
|
(define (gnu-machine-type->debian-machine-type type)
|
||||||
"Translate machine TYPE from the GNU to Debian terminology."
|
"Translate machine TYPE from the GNU to Debian terminology."
|
||||||
;; Debian has its own jargon, different from the one used in GNU, for
|
;; Debian has its own jargon, different from the one used in GNU, for
|
||||||
;; machine types (see data/cputable in the sources of dpkg).
|
;; machine types (see data/cputable in the sources of dpkg).
|
||||||
(match type
|
(match type
|
||||||
("i586" "i386")
|
|
||||||
("i486" "i386")
|
("i486" "i386")
|
||||||
|
("i586" "i386")
|
||||||
("i686" "i386")
|
("i686" "i386")
|
||||||
("x86_64" "amd64")
|
("x86_64" "amd64")
|
||||||
("aarch64" "arm64")
|
("aarch64" "arm64")
|
||||||
|
@ -773,21 +779,40 @@ Valid compressors are: ~a~%") compressor-name %valid-compressors)))
|
||||||
|
|
||||||
(copy-file #+data-tarball data-tarball-file-name)
|
(copy-file #+data-tarball data-tarball-file-name)
|
||||||
|
|
||||||
|
;; Generate the control archive.
|
||||||
|
(define control-file
|
||||||
|
(get-keyword #:control-file '#$extra-options))
|
||||||
|
|
||||||
|
(define postinst-file
|
||||||
|
(get-keyword #:postinst-file '#$extra-options))
|
||||||
|
|
||||||
|
(define triggers-file
|
||||||
|
(get-keyword #:triggers-file '#$extra-options))
|
||||||
|
|
||||||
(define control-tarball-file-name
|
(define control-tarball-file-name
|
||||||
(string-append "control.tar"
|
(string-append "control.tar"
|
||||||
#$(compressor-extension compressor)))
|
#$(compressor-extension compressor)))
|
||||||
|
|
||||||
;; Write the compressed control tarball. Only the control file is
|
;; Write the compressed control tarball. Only the control file is
|
||||||
;; mandatory (see: 'man deb' and 'man deb-control').
|
;; mandatory (see: 'man deb' and 'man deb-control').
|
||||||
(call-with-output-file "control"
|
(if control-file
|
||||||
(lambda (port)
|
(copy-file control-file "control")
|
||||||
(format port "\
|
(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.
|
||||||
Maintainer: GNU Guix
|
Maintainer: GNU Guix
|
||||||
Architecture: ~a
|
Architecture: ~a
|
||||||
~%" package-name package-version architecture)))
|
~%" package-name package-version architecture))))
|
||||||
|
|
||||||
|
(when postinst-file
|
||||||
|
(copy-file postinst-file "postinst")
|
||||||
|
(chmod "postinst" #o755))
|
||||||
|
|
||||||
|
(when triggers-file
|
||||||
|
(copy-file triggers-file "triggers"))
|
||||||
|
|
||||||
(define tar (string-append #+archiver "/bin/tar"))
|
(define tar (string-append #+archiver "/bin/tar"))
|
||||||
|
|
||||||
|
@ -796,7 +821,9 @@ Architecture: ~a
|
||||||
#: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 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
|
||||||
|
@ -1157,6 +1184,34 @@ last resort for relocation."
|
||||||
deb Debian archive installable via dpkg/apt"))
|
deb Debian archive installable via dpkg/apt"))
|
||||||
(newline))
|
(newline))
|
||||||
|
|
||||||
|
(define %deb-format-options
|
||||||
|
(let ((required-option (lambda (symbol)
|
||||||
|
(option (list (symbol->string symbol)) #t #f
|
||||||
|
(lambda (opt name arg result . rest)
|
||||||
|
(apply values
|
||||||
|
(alist-cons symbol arg result)
|
||||||
|
rest))))))
|
||||||
|
(list (required-option 'control-file)
|
||||||
|
(required-option 'postinst-file)
|
||||||
|
(required-option 'triggers-file))))
|
||||||
|
|
||||||
|
(define (show-deb-format-options)
|
||||||
|
(display (G_ "
|
||||||
|
--help-deb-format list options specific to the deb format")))
|
||||||
|
|
||||||
|
(define (show-deb-format-options/detailed)
|
||||||
|
(display (G_ "
|
||||||
|
--control-file=FILE
|
||||||
|
Embed the provided control FILE"))
|
||||||
|
(display (G_ "
|
||||||
|
--postinst-file=FILE
|
||||||
|
Embed the provided postinst script"))
|
||||||
|
(display (G_ "
|
||||||
|
--triggers-file=FILE
|
||||||
|
Embed the provided triggers FILE"))
|
||||||
|
(newline)
|
||||||
|
(exit 0))
|
||||||
|
|
||||||
(define %options
|
(define %options
|
||||||
;; Specifications of the command-line options.
|
;; Specifications of the command-line options.
|
||||||
(cons* (option '(#\h "help") #f #f
|
(cons* (option '(#\h "help") #f #f
|
||||||
|
@ -1250,7 +1305,12 @@ last resort for relocation."
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'bootstrap? #t result)))
|
(alist-cons 'bootstrap? #t result)))
|
||||||
|
|
||||||
(append %transformation-options
|
(option '("help-deb-format") #f #f
|
||||||
|
(lambda args
|
||||||
|
(show-deb-format-options/detailed)))
|
||||||
|
|
||||||
|
(append %deb-format-options
|
||||||
|
%transformation-options
|
||||||
%standard-build-options)))
|
%standard-build-options)))
|
||||||
|
|
||||||
(define (show-help)
|
(define (show-help)
|
||||||
|
@ -1260,6 +1320,8 @@ Create a bundle of PACKAGE.\n"))
|
||||||
(newline)
|
(newline)
|
||||||
(show-transformation-options-help)
|
(show-transformation-options-help)
|
||||||
(newline)
|
(newline)
|
||||||
|
(show-deb-format-options)
|
||||||
|
(newline)
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
-f, --format=FORMAT build a pack in the given FORMAT"))
|
-f, --format=FORMAT build a pack in the given FORMAT"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
|
@ -1369,6 +1431,18 @@ Create a bundle of PACKAGE.\n"))
|
||||||
(else
|
(else
|
||||||
(packages->manifest packages))))))
|
(packages->manifest packages))))))
|
||||||
|
|
||||||
|
(define (process-file-arg opts name)
|
||||||
|
;; Validate that the file exists and return it as a <local-file> object,
|
||||||
|
;; else #f.
|
||||||
|
(let ((value (assoc-ref opts name)))
|
||||||
|
(match value
|
||||||
|
((and (? string?) (not (? file-exists?)))
|
||||||
|
(leave (G_ "file provided with option ~a does not exist: ~a~%")
|
||||||
|
(string-append "--" (symbol->string name)) value))
|
||||||
|
((? string?)
|
||||||
|
(local-file value))
|
||||||
|
(#f #f))))
|
||||||
|
|
||||||
(with-error-handling
|
(with-error-handling
|
||||||
(with-store store
|
(with-store store
|
||||||
(with-status-verbosity (assoc-ref opts 'verbosity)
|
(with-status-verbosity (assoc-ref opts 'verbosity)
|
||||||
|
@ -1401,6 +1475,15 @@ Create a bundle of PACKAGE.\n"))
|
||||||
manifest)
|
manifest)
|
||||||
manifest)))
|
manifest)))
|
||||||
(pack-format (assoc-ref opts 'format))
|
(pack-format (assoc-ref opts 'format))
|
||||||
|
(extra-options (match pack-format
|
||||||
|
('deb
|
||||||
|
(list #:control-file
|
||||||
|
(process-file-arg opts 'control-file)
|
||||||
|
#:postinst-file
|
||||||
|
(process-file-arg opts 'postinst-file)
|
||||||
|
#:triggers-file
|
||||||
|
(process-file-arg opts 'triggers-file)))
|
||||||
|
(_ '())))
|
||||||
(target (assoc-ref opts 'target))
|
(target (assoc-ref opts 'target))
|
||||||
(bootstrap? (assoc-ref opts 'bootstrap?))
|
(bootstrap? (assoc-ref opts 'bootstrap?))
|
||||||
(compressor (if bootstrap?
|
(compressor (if bootstrap?
|
||||||
|
@ -1465,7 +1548,9 @@ to your package list.")))
|
||||||
#:profile-name
|
#:profile-name
|
||||||
profile-name
|
profile-name
|
||||||
#:archiver
|
#:archiver
|
||||||
archiver)))
|
archiver
|
||||||
|
#:extra-options
|
||||||
|
extra-options)))
|
||||||
(mbegin %store-monad
|
(mbegin %store-monad
|
||||||
(mwhen derivation?
|
(mwhen derivation?
|
||||||
(return (format #t "~a~%"
|
(return (format #t "~a~%"
|
||||||
|
|
|
@ -277,17 +277,25 @@
|
||||||
(built-derivations (list check))))
|
(built-derivations (list check))))
|
||||||
|
|
||||||
(unless store (test-skip 1))
|
(unless store (test-skip 1))
|
||||||
(test-assertm "deb archive with symlinks" store
|
(test-assertm "deb archive with symlinks and control files" store
|
||||||
(mlet* %store-monad
|
(mlet* %store-monad
|
||||||
((guile (set-guile-for-build (default-guile)))
|
((guile (set-guile-for-build (default-guile)))
|
||||||
(profile (profile-derivation (packages->manifest
|
(profile (profile-derivation (packages->manifest
|
||||||
(list %bootstrap-guile))
|
(list %bootstrap-guile))
|
||||||
#:hooks '()
|
#:hooks '()
|
||||||
#:locales? #f))
|
#:locales? #f))
|
||||||
(deb (debian-archive "deb-pack" profile
|
(deb (debian-archive
|
||||||
#:compressor %gzip-compressor
|
"deb-pack" profile
|
||||||
#:symlinks '(("/opt/gnu/bin" -> "bin"))
|
#:compressor %gzip-compressor
|
||||||
#:archiver %tar-bootstrap))
|
#:symlinks '(("/opt/gnu/bin" -> "bin"))
|
||||||
|
#:archiver %tar-bootstrap
|
||||||
|
#:extra-options
|
||||||
|
(list #:triggers-file
|
||||||
|
(plain-file "triggers"
|
||||||
|
"activate-noawait /usr/share/icons/hicolor\n")
|
||||||
|
#:postinst-file
|
||||||
|
(plain-file "postinst"
|
||||||
|
"echo running configure script\n"))))
|
||||||
(check
|
(check
|
||||||
(gexp->derivation "check-deb-pack"
|
(gexp->derivation "check-deb-pack"
|
||||||
(with-imported-modules '((guix build utils))
|
(with-imported-modules '((guix build utils))
|
||||||
|
@ -344,6 +352,15 @@
|
||||||
(unless (null? hard-links)
|
(unless (null? hard-links)
|
||||||
(error "hard links found in data.tar.gz" hard-links))
|
(error "hard links found in data.tar.gz" hard-links))
|
||||||
|
|
||||||
|
;; Verify the presence of the control files.
|
||||||
|
(invoke "tar" "-xf" "control.tar.gz")
|
||||||
|
(assert (file-exists? "control"))
|
||||||
|
(assert (and (file-exists? "postinst")
|
||||||
|
(= #o111 ;script is executable
|
||||||
|
(logand #o111 (stat:perms
|
||||||
|
(stat "postinst"))))))
|
||||||
|
(assert (file-exists? "triggers"))
|
||||||
|
|
||||||
(mkdir #$output))))))
|
(mkdir #$output))))))
|
||||||
(built-derivations (list check)))))
|
(built-derivations (list check)))))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue