[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/03: pack: Add '--symlink'.
|
From: |
Ludovic Courtès |
|
Subject: |
03/03: pack: Add '--symlink'. |
|
Date: |
Tue, 14 Mar 2017 12:57:38 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 5895ec8aa234ec9a4ce68ab8f94e795807630168
Author: Ludovic Courtès <address@hidden>
Date: Tue Mar 14 16:37:17 2017 +0100
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.
---
doc/guix.texi | 24 +++++++++++
gnu/build/install.scm | 1 +
guix/scripts/pack.scm | 107 +++++++++++++++++++++++++++++++++++++-------------
3 files changed, 104 insertions(+), 28 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 86fc86d..82298e6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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
(@pxref{Binary Installation}).
+Users of this pack would have to run
address@hidden/gnu/store/@dots{}-profile/bin/guile} to run Guile, which you may
+find inconvenient. To work around it, you can create, say, a
address@hidden/opt/gnu/bin} symlink to the profile:
+
address@hidden
+guix pack -S /opt/gnu/bin=bin guile emacs geiser
address@hidden example
+
address@hidden
+That way, users can happily type @file{/opt/gnu/bin/guile} and enjoy.
+
Several command-line options allow you to customize your pack:
@table @code
@@ -2435,6 +2447,18 @@ the system type of the build host.
Compress the resulting tarball using @var{tool}---one of @code{gzip},
@code{bzip2}, @code{xz}, or @code{lzip}.
address@hidden address@hidden
address@hidden -S @var{spec}
+Add the symlinks specified by @var{spec} to the pack. This option can
+appear several times.
+
address@hidden has the form @address@hidden@var{target}}, where
address@hidden 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
Include the ``local state directory'', @file{/var/guix}, in the
resulting pack.
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 11f107d..5cb6055 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -24,6 +24,7 @@
#:use-module (ice-9 match)
#:export (install-grub
install-grub-config
+ evaluate-populate-directive
populate-root-file-system
reset-timestamps
register-closure
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 138e2c5..7a0e54d 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -70,21 +70,41 @@ found."
(define* (self-contained-tarball name profile
#:key deduplicate?
(compressor (first %compressors))
- localstatedir?)
+ localstatedir?
+ (symlinks '()))
"Return a self-contained tarball containing a store initialized with the
closure of PROFILE, a derivation. The tarball contains /gnu/store; if
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
(with-imported-modules '((guix build utils)
(guix build store-copy)
(gnu build install))
#~(begin
(use-modules (guix build utils)
- (gnu build install))
+ (gnu build install)
+ (srfi srfi-1)
+ (srfi srfi-26)
+ (ice-9 match))
(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'.
(setenv "PATH"
(string-append #$(if localstatedir?
@@ -102,34 +122,46 @@ with a properly initialized store database."
#:deduplicate? #f
#:register? #$localstatedir?)
+ ;; Create SYMLINKS.
+ (for-each (cut evaluate-populate-directive <> %root)
+ directives)
+
;; Create the tarball. Use GNU format so there's no file name
;; length limitation.
(with-directory-excursion %root
- (zero? (system* "tar" #$(compressor-tar-option compressor)
- "--format=gnu"
-
- ;; Avoid non-determinism in the archive. Use
- ;; mtime = 1, not zero, because that is what the
- ;; daemon does for files in the store (see the
- ;; 'mtimeStore' constant in local-store.cc.)
- "--sort=name"
- "address@hidden" ;for files in /var/guix
- "--owner=root:0"
- "--group=root:0"
-
- "--check-links"
- "-cvf" #$output
- ;; Avoid adding / and /var to the tarball, so
- ;; that the ownership and permissions of those
- ;; directories will not be overwritten when
- ;; extracting the archive. Do not include /root
- ;; because the root account might have a
- ;; different home directory.
- #$@(if localstatedir?
- '("./var/guix")
- '())
-
- (string-append "." (%store-directory))))))))
+ (exit
+ (zero? (apply system* "tar" #$(compressor-tar-option compressor)
+ "--format=gnu"
+
+ ;; Avoid non-determinism in the archive. Use
+ ;; mtime = 1, not zero, because that is what the
+ ;; daemon does for files in the store (see the
+ ;; 'mtimeStore' constant in local-store.cc.)
+ "--sort=name"
+ "address@hidden" ;for files in /var/guix
+ "--owner=root:0"
+ "--group=root:0"
+
+ "--check-links"
+ "-cvf" #$output
+ ;; Avoid adding / and /var to the tarball, so
+ ;; that the ownership and permissions of those
+ ;; directories will not be overwritten when
+ ;; extracting the archive. Do not include /root
+ ;; because the root account might have a
+ ;; different home directory.
+ #$@(if localstatedir?
+ '("./var/guix")
+ '())
+
+ (string-append "." (%store-directory))
+
+ (delete-duplicates
+ (filter-map (match-lambda
+ (('directory directory)
+ (string-append "." directory))
+ (_ #f))
+ directives)))))))))
(gexp->derivation (string-append name ".tar."
(compressor-extension compressor))
@@ -149,6 +181,7 @@ with a properly initialized store database."
(graft? . #t)
(max-silent-time . 3600)
(verbosity . 0)
+ (symlinks . ())
(compressor . ,(first %compressors))))
(define %options
@@ -172,6 +205,19 @@ with a properly initialized store database."
(lambda (opt name arg result)
(alist-cons 'compressor (lookup-compressor arg)
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
(lambda (opt name arg result)
(alist-cons 'localstatedir? #t result)))
@@ -191,6 +237,8 @@ Create a bundle of PACKAGE.\n"))
(display (_ "
-C, --compression=TOOL compress using TOOL--e.g., \"lzip\""))
(display (_ "
+ -S, --symlink=SPEC create symlinks to the profile according to SPEC"))
+ (display (_ "
--localstatedir include /var/guix in the resulting pack"))
(newline)
(display (_ "
@@ -224,6 +272,7 @@ Create a bundle of PACKAGE.\n"))
list))
specs))
(compressor (assoc-ref opts 'compressor))
+ (symlinks (assoc-ref opts 'symlinks))
(localstatedir? (assoc-ref opts 'localstatedir?)))
(with-store store
(run-with-store store
@@ -232,6 +281,8 @@ Create a bundle of PACKAGE.\n"))
(drv (self-contained-tarball "pack" profile
#:compressor
compressor
+ #:symlinks
+ symlinks
#:localstatedir?
localstatedir?)))
(mbegin %store-monad