From fd214f1522063905021a297dab1ac4d85d94ad83 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 21 May 2019 14:33:51 +0200 Subject: pack: Add '--root'. * guix/scripts/pack.scm (%options, show-help): Add "--root". (guix-pack): Honor it. * tests/guix-pack.sh: Test it. * doc/guix.texi (Invoking guix pack): Document it. --- guix/scripts/pack.scm | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) (limited to 'guix/scripts') diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index b1d1e87c57..58c6ac6148 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -724,6 +724,10 @@ (define %options (alist-cons 'profile-name arg result)) (_ (leave (G_ "~a: unsupported profile name~%") arg))))) + (option '(#\r "root") #t #f + (lambda (opt name arg result) + (alist-cons 'gc-root arg result))) + (option '(#\v "verbosity") #t #f (lambda (opt name arg result) (let ((level (string->number* arg))) @@ -769,6 +773,9 @@ (define (show-help) --profile-name=NAME populate /var/guix/profiles/.../NAME")) (display (G_ " + -r, --root=FILE make FILE a symlink to the result, and register it + as a garbage collector root")) + (display (G_ " -v, --verbosity=LEVEL use the given verbosity LEVEL")) (display (G_ " --bootstrap use the bootstrap binaries to build the pack")) @@ -882,7 +889,8 @@ (define properties (leave (G_ "~a: unknown pack format~%") pack-format)))) (localstatedir? (assoc-ref opts 'localstatedir?)) - (profile-name (assoc-ref opts 'profile-name))) + (profile-name (assoc-ref opts 'profile-name)) + (gc-root (assoc-ref opts 'gc-root))) (run-with-store store (mlet* %store-monad ((profile (profile-derivation manifest @@ -919,6 +927,11 @@ (define properties #:dry-run? dry-run?) (munless dry-run? (built-derivations (list drv)) + (mwhen gc-root + (register-root* (match (derivation->output-paths drv) + (((names . items) ...) + items)) + gc-root)) (return (format #t "~a~%" (derivation->output-path drv)))))) #:system (assoc-ref opts 'system)))))))) -- cgit v1.2.3