diff options
Diffstat (limited to 'guix-build.in')
| -rw-r--r-- | guix-build.in | 46 |
1 files changed, 44 insertions, 2 deletions
diff --git a/guix-build.in b/guix-build.in index bd32ce951e..7089a74731 100644 --- a/guix-build.in +++ b/guix-build.in @@ -101,6 +101,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) --no-substitutes build instead of resorting to pre-built substitutes")) (display (_ " -c, --cores=N allow the use of up to N CPU cores for the build")) + (display (_ " + -r, --root=FILE make FILE a symlink to the result, and register it + as a garbage collector root")) (newline) (display (_ " -h, --help display this help and exit")) @@ -151,7 +154,10 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@")) (option '("no-substitutes") #f #f (lambda (opt name arg result) (alist-cons 'substitutes? #f - (alist-delete 'substitutes? result)))))) + (alist-delete 'substitutes? result)))) + (option '(#\r "root") #t #f + (lambda (opt name arg result) + (alist-cons 'gc-root arg result))))) ;;; @@ -168,6 +174,33 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@")) (alist-cons 'argument arg result)) %default-options)) + (define (register-root drv root) + ;; Register ROOT as an indirect GC root for DRV's outputs. + (let* ((root (string-append (canonicalize-path (dirname root)) + "/" root)) + (drv* (call-with-input-file drv read-derivation)) + (outputs (derivation-outputs drv*)) + (outputs* (map (compose derivation-output-path cdr) outputs))) + (catch 'system-error + (lambda () + (match outputs* + ((output) + (symlink output root) + (add-indirect-root %store root)) + ((outputs ...) + (fold (lambda (output count) + (let ((root (string-append root "-" (number->string count)))) + (symlink output root) + (add-indirect-root %store root)) + (+ 1 count)) + 0 + outputs)))) + (lambda args + (format (current-error-port) + (_ "failed to create GC root `~a': ~a~%") + root (strerror (system-error-errno args))) + (exit 1))))) + (setlocale LC_ALL "") (textdomain "guix") (setvbuf (current-output-port) _IOLBF) @@ -244,7 +277,16 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@")) (derivation-path->output-path d out-name))) (derivation-outputs drv))))) - drv))))))) + drv) + (let ((roots (filter-map (match-lambda + (('gc-root . root) + root) + (_ #f)) + opts))) + (when roots + (for-each (cut register-root <> <>) + drv roots) + #t)))))))) ;; Local Variables: ;; eval: (put 'guard 'scheme-indent-function 1) |