pack: Add '--symlink'.
* guix/scripts/pack.scm (self-contained-tarball): Add #:symlinks parameter. [build](symlink->directives): New procedure (directives): New variable. Add call to 'evaluate-populate-directive'. Pass the directories among DIRECTIVES to 'tar'. (%default-options): Add 'symlinks'. (%options, show-help): Add '--symlink'. (guix-pack): Honor it. * gnu/build/install.scm (evaluate-populate-directive): Export. * doc/guix.texi (Invoking guix pack): Document it.master
parent
df12920744
commit
5895ec8aa2
|
@ -2422,6 +2422,18 @@ same as would be created by @command{guix package -i}. It is this
|
||||||
mechanism that is used to create Guix's own standalone binary tarball
|
mechanism that is used to create Guix's own standalone binary tarball
|
||||||
(@pxref{Binary Installation}).
|
(@pxref{Binary Installation}).
|
||||||
|
|
||||||
|
Users of this pack would have to run
|
||||||
|
@file{/gnu/store/@dots{}-profile/bin/guile} to run Guile, which you may
|
||||||
|
find inconvenient. To work around it, you can create, say, a
|
||||||
|
@file{/opt/gnu/bin} symlink to the profile:
|
||||||
|
|
||||||
|
@example
|
||||||
|
guix pack -S /opt/gnu/bin=bin guile emacs geiser
|
||||||
|
@end example
|
||||||
|
|
||||||
|
@noindent
|
||||||
|
That way, users can happily type @file{/opt/gnu/bin/guile} and enjoy.
|
||||||
|
|
||||||
Several command-line options allow you to customize your pack:
|
Several command-line options allow you to customize your pack:
|
||||||
|
|
||||||
@table @code
|
@table @code
|
||||||
|
@ -2435,6 +2447,18 @@ the system type of the build host.
|
||||||
Compress the resulting tarball using @var{tool}---one of @code{gzip},
|
Compress the resulting tarball using @var{tool}---one of @code{gzip},
|
||||||
@code{bzip2}, @code{xz}, or @code{lzip}.
|
@code{bzip2}, @code{xz}, or @code{lzip}.
|
||||||
|
|
||||||
|
@item --symlink=@var{spec}
|
||||||
|
@itemx -S @var{spec}
|
||||||
|
Add the symlinks specified by @var{spec} to the pack. This option can
|
||||||
|
appear several times.
|
||||||
|
|
||||||
|
@var{spec} has the form @code{@var{source}=@var{target}}, where
|
||||||
|
@var{source} is the symlink that will be created and @var{target} is the
|
||||||
|
symlink target.
|
||||||
|
|
||||||
|
For instance, @code{-S /opt/gnu/bin=bin} creates a @file{/opt/gnu/bin}
|
||||||
|
symlink pointing to the @file{bin} sub-directory of the profile.
|
||||||
|
|
||||||
@item --localstatedir
|
@item --localstatedir
|
||||||
Include the ``local state directory'', @file{/var/guix}, in the
|
Include the ``local state directory'', @file{/var/guix}, in the
|
||||||
resulting pack.
|
resulting pack.
|
||||||
|
|
|
@ -24,6 +24,7 @@
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:export (install-grub
|
#:export (install-grub
|
||||||
install-grub-config
|
install-grub-config
|
||||||
|
evaluate-populate-directive
|
||||||
populate-root-file-system
|
populate-root-file-system
|
||||||
reset-timestamps
|
reset-timestamps
|
||||||
register-closure
|
register-closure
|
||||||
|
|
|
@ -70,21 +70,41 @@ found."
|
||||||
(define* (self-contained-tarball name profile
|
(define* (self-contained-tarball name profile
|
||||||
#:key deduplicate?
|
#:key deduplicate?
|
||||||
(compressor (first %compressors))
|
(compressor (first %compressors))
|
||||||
localstatedir?)
|
localstatedir?
|
||||||
|
(symlinks '()))
|
||||||
"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
|
||||||
with a properly initialized store database."
|
with a properly initialized store database.
|
||||||
|
|
||||||
|
SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be
|
||||||
|
added to the pack."
|
||||||
(define build
|
(define build
|
||||||
(with-imported-modules '((guix build utils)
|
(with-imported-modules '((guix build utils)
|
||||||
(guix build store-copy)
|
(guix build store-copy)
|
||||||
(gnu build install))
|
(gnu build install))
|
||||||
#~(begin
|
#~(begin
|
||||||
(use-modules (guix build utils)
|
(use-modules (guix build utils)
|
||||||
(gnu build install))
|
(gnu build install)
|
||||||
|
(srfi srfi-1)
|
||||||
|
(srfi srfi-26)
|
||||||
|
(ice-9 match))
|
||||||
|
|
||||||
(define %root "root")
|
(define %root "root")
|
||||||
|
|
||||||
|
(define symlink->directives
|
||||||
|
;; Return "populate directives" to make the given symlink and its
|
||||||
|
;; parent directories.
|
||||||
|
(match-lambda
|
||||||
|
((source '-> target)
|
||||||
|
(let ((target (string-append #$profile "/" target)))
|
||||||
|
`((directory ,(dirname source))
|
||||||
|
(,source -> ,target))))))
|
||||||
|
|
||||||
|
(define directives
|
||||||
|
;; Fully-qualified symlinks.
|
||||||
|
(append-map symlink->directives '#$symlinks))
|
||||||
|
|
||||||
;; We need Guix here for 'guix-register'.
|
;; We need Guix here for 'guix-register'.
|
||||||
(setenv "PATH"
|
(setenv "PATH"
|
||||||
(string-append #$(if localstatedir?
|
(string-append #$(if localstatedir?
|
||||||
|
@ -102,34 +122,46 @@ with a properly initialized store database."
|
||||||
#:deduplicate? #f
|
#:deduplicate? #f
|
||||||
#:register? #$localstatedir?)
|
#:register? #$localstatedir?)
|
||||||
|
|
||||||
|
;; Create SYMLINKS.
|
||||||
|
(for-each (cut evaluate-populate-directive <> %root)
|
||||||
|
directives)
|
||||||
|
|
||||||
;; Create the tarball. Use GNU format so there's no file name
|
;; Create the tarball. Use GNU format so there's no file name
|
||||||
;; length limitation.
|
;; length limitation.
|
||||||
(with-directory-excursion %root
|
(with-directory-excursion %root
|
||||||
(zero? (system* "tar" #$(compressor-tar-option compressor)
|
(exit
|
||||||
"--format=gnu"
|
(zero? (apply system* "tar" #$(compressor-tar-option compressor)
|
||||||
|
"--format=gnu"
|
||||||
|
|
||||||
;; Avoid non-determinism in the archive. Use
|
;; Avoid non-determinism in the archive. Use
|
||||||
;; mtime = 1, not zero, because that is what the
|
;; mtime = 1, not zero, because that is what the
|
||||||
;; daemon does for files in the store (see the
|
;; daemon does for files in the store (see the
|
||||||
;; 'mtimeStore' constant in local-store.cc.)
|
;; 'mtimeStore' constant in local-store.cc.)
|
||||||
"--sort=name"
|
"--sort=name"
|
||||||
"--mtime=@1" ;for files in /var/guix
|
"--mtime=@1" ;for files in /var/guix
|
||||||
"--owner=root:0"
|
"--owner=root:0"
|
||||||
"--group=root:0"
|
"--group=root:0"
|
||||||
|
|
||||||
"--check-links"
|
"--check-links"
|
||||||
"-cvf" #$output
|
"-cvf" #$output
|
||||||
;; Avoid adding / and /var to the tarball, so
|
;; Avoid adding / and /var to the tarball, so
|
||||||
;; that the ownership and permissions of those
|
;; that the ownership and permissions of those
|
||||||
;; directories will not be overwritten when
|
;; directories will not be overwritten when
|
||||||
;; extracting the archive. Do not include /root
|
;; extracting the archive. Do not include /root
|
||||||
;; because the root account might have a
|
;; because the root account might have a
|
||||||
;; different home directory.
|
;; different home directory.
|
||||||
#$@(if localstatedir?
|
#$@(if localstatedir?
|
||||||
'("./var/guix")
|
'("./var/guix")
|
||||||
'())
|
'())
|
||||||
|
|
||||||
(string-append "." (%store-directory))))))))
|
(string-append "." (%store-directory))
|
||||||
|
|
||||||
|
(delete-duplicates
|
||||||
|
(filter-map (match-lambda
|
||||||
|
(('directory directory)
|
||||||
|
(string-append "." directory))
|
||||||
|
(_ #f))
|
||||||
|
directives)))))))))
|
||||||
|
|
||||||
(gexp->derivation (string-append name ".tar."
|
(gexp->derivation (string-append name ".tar."
|
||||||
(compressor-extension compressor))
|
(compressor-extension compressor))
|
||||||
|
@ -149,6 +181,7 @@ with a properly initialized store database."
|
||||||
(graft? . #t)
|
(graft? . #t)
|
||||||
(max-silent-time . 3600)
|
(max-silent-time . 3600)
|
||||||
(verbosity . 0)
|
(verbosity . 0)
|
||||||
|
(symlinks . ())
|
||||||
(compressor . ,(first %compressors))))
|
(compressor . ,(first %compressors))))
|
||||||
|
|
||||||
(define %options
|
(define %options
|
||||||
|
@ -172,6 +205,19 @@ with a properly initialized store database."
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'compressor (lookup-compressor arg)
|
(alist-cons 'compressor (lookup-compressor arg)
|
||||||
result)))
|
result)))
|
||||||
|
(option '(#\S "symlink") #t #f
|
||||||
|
(lambda (opt name arg result)
|
||||||
|
(match (string-tokenize arg
|
||||||
|
(char-set-complement
|
||||||
|
(char-set #\=)))
|
||||||
|
((source target)
|
||||||
|
(let ((symlinks (assoc-ref result 'symlinks)))
|
||||||
|
(alist-cons 'symlinks
|
||||||
|
`((,source -> ,target) ,@symlinks)
|
||||||
|
(alist-delete 'symlinks result eq?))))
|
||||||
|
(x
|
||||||
|
(leave (_ "~a: invalid symlink specification~%")
|
||||||
|
arg)))))
|
||||||
(option '("localstatedir") #f #f
|
(option '("localstatedir") #f #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'localstatedir? #t result)))
|
(alist-cons 'localstatedir? #t result)))
|
||||||
|
@ -190,6 +236,8 @@ Create a bundle of PACKAGE.\n"))
|
||||||
-s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\""))
|
-s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\""))
|
||||||
(display (_ "
|
(display (_ "
|
||||||
-C, --compression=TOOL compress using TOOL--e.g., \"lzip\""))
|
-C, --compression=TOOL compress using TOOL--e.g., \"lzip\""))
|
||||||
|
(display (_ "
|
||||||
|
-S, --symlink=SPEC create symlinks to the profile according to SPEC"))
|
||||||
(display (_ "
|
(display (_ "
|
||||||
--localstatedir include /var/guix in the resulting pack"))
|
--localstatedir include /var/guix in the resulting pack"))
|
||||||
(newline)
|
(newline)
|
||||||
|
@ -224,6 +272,7 @@ Create a bundle of PACKAGE.\n"))
|
||||||
list))
|
list))
|
||||||
specs))
|
specs))
|
||||||
(compressor (assoc-ref opts 'compressor))
|
(compressor (assoc-ref opts 'compressor))
|
||||||
|
(symlinks (assoc-ref opts 'symlinks))
|
||||||
(localstatedir? (assoc-ref opts 'localstatedir?)))
|
(localstatedir? (assoc-ref opts 'localstatedir?)))
|
||||||
(with-store store
|
(with-store store
|
||||||
(run-with-store store
|
(run-with-store store
|
||||||
|
@ -232,6 +281,8 @@ Create a bundle of PACKAGE.\n"))
|
||||||
(drv (self-contained-tarball "pack" profile
|
(drv (self-contained-tarball "pack" profile
|
||||||
#:compressor
|
#:compressor
|
||||||
compressor
|
compressor
|
||||||
|
#:symlinks
|
||||||
|
symlinks
|
||||||
#:localstatedir?
|
#:localstatedir?
|
||||||
localstatedir?)))
|
localstatedir?)))
|
||||||
(mbegin %store-monad
|
(mbegin %store-monad
|
||||||
|
|
Loading…
Reference in New Issue