From 1edcfda81ba5c20ca715473d45315662c60dd81e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 15 Nov 2019 21:30:37 +0100 Subject: pull: Remove unused '--verbose' option. This option had been ignored since commit 0d39a3b98948314e135566b9315717695a9035ea (August 2018). * guix/scripts/pull.scm (show-help, %options): Remove "--verbose". (build-and-install): Remove #:verbose?, which was unused. (guix-pull): Adjust accordingly. --- guix/scripts/pull.scm | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) (limited to 'guix') diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 92aac6066e..418998409a 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -78,8 +78,6 @@ (define %default-options (define (show-help) (display (G_ "Usage: guix pull [OPTION]... Download and deploy the latest version of Guix.\n")) - (display (G_ " - --verbose produce verbose output")) (display (G_ " -C, --channels=FILE deploy the channels defined in FILE")) (display (G_ " @@ -120,10 +118,7 @@ (define (show-help) (define %options ;; Specifications of the command-line options. - (cons* (option '("verbose") #f #f - (lambda (opt name arg result) - (alist-cons 'verbose? #t result))) - (option '(#\C "channels") #t #f + (cons* (option '(#\C "channels") #t #f (lambda (opt name arg result) (alist-cons 'channel-file arg result))) (option '(#\l "list-generations") #f #t @@ -382,7 +377,7 @@ (define (display-news profile) (display-channel-news profile)) (define* (build-and-install instances profile - #:key use-substitutes? verbose? dry-run?) + #:key use-substitutes? dry-run?) "Build the tool from SOURCE, and install it in PROFILE. When DRY-RUN? is true, display what would be built without actually building it." (define update-profile @@ -823,8 +818,6 @@ (define (guix-pull . args) #:dry-run? (assoc-ref opts 'dry-run?) #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:verbose? - (assoc-ref opts 'verbose?)))))))))))))) + (assoc-ref opts 'substitutes?)))))))))))))) ;;; pull.scm ends here -- cgit v1.2.3 From f675f8dec73d02e319e607559ed2316c299ae8c7 Mon Sep 17 00:00:00 2001 From: Konrad Hinsen Date: Fri, 25 Oct 2019 17:42:21 +0200 Subject: Add 'guix time-machine'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/scripts/time-machine.scm: New file. * Makefile.am: (MODULES): Add it. * guix/scripts/pull.scm (channel-list): Export. * guix/inferior.scm (cached-channel-instance): New procedure. (inferior-for-channels): Use it. * doc/guix.texi (Invoking guix time-machine): New section. (Channels): Cross-reference it. Signed-off-by: Ludovic Courtès --- Makefile.am | 1 + doc/guix.texi | 59 +++++++++++++++++++++++- guix/inferior.scm | 38 +++++++++++----- guix/scripts/pull.scm | 1 + guix/scripts/time-machine.scm | 102 ++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 187 insertions(+), 14 deletions(-) create mode 100644 guix/scripts/time-machine.scm (limited to 'guix') diff --git a/Makefile.am b/Makefile.am index b1f33946c5..b3f03d44c8 100644 --- a/Makefile.am +++ b/Makefile.am @@ -278,6 +278,7 @@ MODULES = \ guix/scripts/container.scm \ guix/scripts/container/exec.scm \ guix/scripts/deploy.scm \ + guix/scripts/time-machine.scm \ guix.scm \ $(GNU_SYSTEM_MODULES) diff --git a/doc/guix.texi b/doc/guix.texi index ed88778016..bc1d5d863a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -198,6 +198,7 @@ Package Management * Invoking guix gc:: Running the garbage collector. * Invoking guix pull:: Fetching the latest Guix and distribution. * Channels:: Customizing the package collection. +* Invoking guix time-machine:: Running an older revision of Guix. * Inferiors:: Interacting with another revision of Guix. * Invoking guix describe:: Display information about your Guix revision. * Invoking guix archive:: Exporting and importing store files. @@ -2550,6 +2551,7 @@ guix install emacs-guix * Invoking guix gc:: Running the garbage collector. * Invoking guix pull:: Fetching the latest Guix and distribution. * Channels:: Customizing the package collection. +* Invoking guix time-machine:: Running an older revision of Guix. * Inferiors:: Interacting with another revision of Guix. * Invoking guix describe:: Display information about your Guix revision. * Invoking guix archive:: Exporting and importing store files. @@ -4152,7 +4154,10 @@ say, on another machine, by providing a channel specification in @end lisp The @command{guix describe --format=channels} command can even generate this -list of channels directly (@pxref{Invoking guix describe}). +list of channels directly (@pxref{Invoking guix describe}). The resulting +file can be used with the -C options of @command{guix pull} +(@pxref{Invoking guix pull}) or @command{guix time-machine} +(@pxref{Invoking guix time-machine}). At this point the two machines run the @emph{exact same Guix}, with access to the @emph{exact same packages}. The output of @command{guix build gimp} on @@ -4166,6 +4171,57 @@ artifacts with very fine grain, and to reproduce software environments at will---some sort of ``meta reproducibility'' capabilities, if you will. @xref{Inferiors}, for another way to take advantage of these super powers. +@node Invoking guix time-machine +@section Invoking @command{guix time-machine} + +@cindex @command{guix time-machine} +@cindex pinning, channels +@cindex replicating Guix +@cindex reproducibility, of Guix + +The @command{guix time-machine} command provides access to other +revisions of Guix, for example to install older versions of packages, +or to reproduce a computation in an identical environment. The revision +of Guix to be used is defined by a commit or by a channel +description file created by @command{guix describe} +(@pxref{Invoking guix describe}). + +The general syntax is: + +@example +guix time-machine @var{options}@dots{} -- @var{command} @var {arg}@dots{} +@end example + +where @var{command} and @var{arg}@dots{} are passed unmodified to the +@command{guix} command if the specified revision. The @var{options} that define +this revision are the same as for @command{guix pull} (@pxref{Invoking guix pull}): + +@table @code +@item --url=@var{url} +@itemx --commit=@var{commit} +@itemx --branch=@var{branch} +Use the @code{guix} channel from the specified @var{url}, at the +given @var{commit} (a valid Git commit ID represented as a hexadecimal +string), or @var{branch}. + +@item --channels=@var{file} +@itemx -C @var{file} +Read the list of channels from @var{file}. @var{file} must contain +Scheme code that evaluates to a list of channel objects. +@xref{Channels} for more information. +@end table + +As for @command{guix pull}, the absence of any options means that the +the latest commit on the master branch will be used. The command + +@example +guix time-machine -- build hello +@end example + +will thus build the package @code{hello} as defined in the master branch, +which is in general a newer revison of Guix than you have installed. +Time travel works in both directions! + @node Inferiors @section Inferiors @@ -10589,7 +10645,6 @@ ClientPID: 19419 ClientCommand: cuirass --cache-directory /var/cache/cuirass @dots{} @end example - @node System Configuration @chapter System Configuration diff --git a/guix/inferior.scm b/guix/inferior.scm index b8e2f21f42..be50e0ec26 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -89,6 +89,7 @@ (define-module (guix inferior) gexp->derivation-in-inferior %inferior-cache-directory + cached-channel-instance inferior-for-channels)) ;;; Commentary: @@ -635,16 +636,13 @@ (define %inferior-cache-directory (make-parameter (string-append (cache-directory #:ensure? #f) "/inferiors"))) -(define* (inferior-for-channels channels - #:key - (cache-directory (%inferior-cache-directory)) - (ttl (* 3600 24 30))) - "Return an inferior for CHANNELS, a list of channels. Use the cache at -CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds. This -procedure opens a new connection to the build daemon. - -This is a convenience procedure that people may use in manifests passed to -'guix package -m', for instance." +(define* (cached-channel-instance channels + #:key + (cache-directory (%inferior-cache-directory)) + (ttl (* 3600 24 30))) + "Return a directory containing a guix filetree defined by CHANNELS, a list of channels. +The directory is a subdirectory of CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds. +This procedure opens a new connection to the build daemon." (with-store store (let () (define instances @@ -680,7 +678,7 @@ (define add-indirect-root* (file-expiration-time ttl)) (if (file-exists? cached) - (open-inferior cached) + cached (run-with-store store (mlet %store-monad ((profile (channel-instances->derivation instances))) @@ -689,4 +687,20 @@ (define add-indirect-root* (built-derivations (list profile)) (symlink* (derivation->output-path profile) cached) (add-indirect-root* cached) - (return (open-inferior cached))))))))) + (return cached)))))))) + +(define* (inferior-for-channels channels + #:key + (cache-directory (%inferior-cache-directory)) + (ttl (* 3600 24 30))) + "Return an inferior for CHANNELS, a list of channels. Use the cache at +CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds. This +procedure opens a new connection to the build daemon. + +This is a convenience procedure that people may use in manifests passed to +'guix package -m', for instance." + (define cached + (cached-channel-instance channels + #:cache-directory cache-directory + #:ttl ttl)) + (open-inferior cached)) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 418998409a..c42794dbcb 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -56,6 +56,7 @@ (define-module (guix scripts pull) #:use-module (ice-9 vlist) #:use-module (ice-9 format) #:export (display-profile-content + channel-list guix-pull)) diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm new file mode 100644 index 0000000000..a6598fb0f7 --- /dev/null +++ b/guix/scripts/time-machine.scm @@ -0,0 +1,102 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Konrad Hinsen +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix scripts time-machine) + #:use-module (guix ui) + #:use-module (guix scripts) + #:use-module (guix inferior) + #:use-module (guix channels) + #:use-module ((guix scripts pull) #:select (channel-list)) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:export (guix-time-machine)) + + +;;; +;;; Command-line options. +;;; + +(define (show-help) + (display (G_ "Usage: guix time-machine [OPTION] -- COMMAND ARGS... +Execute COMMAND ARGS... in an older version of Guix.\n")) + (display (G_ " + -C, --channels=FILE deploy the channels defined in FILE")) + (display (G_ " + --url=URL use the Git repository at URL")) + (display (G_ " + --commit=COMMIT use the specified COMMIT")) + (display (G_ " + --branch=BRANCH use the tip of the specified BRANCH")) + (display (G_ " + -h, --help display this help and exit")) + (display (G_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specifications of the command-line options. + (list (option '(#\C "channels") #t #f + (lambda (opt name arg result) + (alist-cons 'channel-file arg result))) + (option '("url") #t #f + (lambda (opt name arg result) + (alist-cons 'repository-url arg + (alist-delete 'repository-url result)))) + (option '("commit") #t #f + (lambda (opt name arg result) + (alist-cons 'ref `(commit . ,arg) result))) + (option '("branch") #t #f + (lambda (opt name arg result) + (alist-cons 'ref `(branch . ,arg) result))) + (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix time-machine"))))) + +(define (parse-args args) + "Parse the list of command line arguments ARGS." + ;; The '--' token is used to separate the command to run from the rest of + ;; the operands. + (let-values (((args command) (break (cut string=? "--" <>) args))) + (let ((opts (parse-command-line args %options '(()) #:build-options? #f))) + (match command + (() opts) + (("--") opts) + (("--" command ...) (alist-cons 'exec command opts)))))) + + +;;; +;;; Entry point. +;;; + +(define (guix-time-machine . args) + (with-error-handling + (let* ((opts (parse-args args)) + (channels (channel-list opts)) + (command-line (assoc-ref opts 'exec))) + (when command-line + (let* ((directory (cached-channel-instance channels)) + (executable (string-append directory "/bin/guix"))) + (apply execl (cons* executable executable command-line))))))) -- cgit v1.2.3 From 1d5485690ba75d6b355fd519caf40881a606678b Mon Sep 17 00:00:00 2001 From: Konrad Hinsen Date: Tue, 12 Nov 2019 16:39:46 +0100 Subject: inferior: 'cached-channel-instance' takes an open store connection. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/inferior.scm (cached-channel-instance): Take an explicit 'store' argument. (inferior-for-channels): Wrap call to 'cached-channel-instance' in 'with-store'. * guix/time-machine.scm (guix-time-machine): Wrap call to 'cached-channel-instance' in 'with-store'. Signed-off-by: Ludovic Courtès --- guix/inferior.scm | 99 ++++++++++++++++++++++--------------------- guix/scripts/time-machine.scm | 4 +- 2 files changed, 53 insertions(+), 50 deletions(-) (limited to 'guix') diff --git a/guix/inferior.scm b/guix/inferior.scm index be50e0ec26..71dae89e92 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -636,58 +636,57 @@ (define %inferior-cache-directory (make-parameter (string-append (cache-directory #:ensure? #f) "/inferiors"))) -(define* (cached-channel-instance channels +(define* (cached-channel-instance store + channels #:key (cache-directory (%inferior-cache-directory)) (ttl (* 3600 24 30))) "Return a directory containing a guix filetree defined by CHANNELS, a list of channels. The directory is a subdirectory of CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds. This procedure opens a new connection to the build daemon." - (with-store store - (let () - (define instances - (latest-channel-instances store channels)) - - (define key - (bytevector->base32-string - (sha256 - (string->utf8 - (string-concatenate (map channel-instance-commit instances)))))) - - (define cached - (string-append cache-directory "/" key)) - - (define (base32-encoded-sha256? str) - (= (string-length str) 52)) - - (define (cache-entries directory) - (map (lambda (file) - (string-append directory "/" file)) - (scandir directory base32-encoded-sha256?))) - - (define symlink* - (lift2 symlink %store-monad)) - - (define add-indirect-root* - (store-lift add-indirect-root)) - - (mkdir-p cache-directory) - (maybe-remove-expired-cache-entries cache-directory - cache-entries - #:entry-expiration - (file-expiration-time ttl)) - - (if (file-exists? cached) - cached - (run-with-store store - (mlet %store-monad ((profile - (channel-instances->derivation instances))) - (mbegin %store-monad - (show-what-to-build* (list profile)) - (built-derivations (list profile)) - (symlink* (derivation->output-path profile) cached) - (add-indirect-root* cached) - (return cached)))))))) + (define instances + (latest-channel-instances store channels)) + + (define key + (bytevector->base32-string + (sha256 + (string->utf8 + (string-concatenate (map channel-instance-commit instances)))))) + + (define cached + (string-append cache-directory "/" key)) + + (define (base32-encoded-sha256? str) + (= (string-length str) 52)) + + (define (cache-entries directory) + (map (lambda (file) + (string-append directory "/" file)) + (scandir directory base32-encoded-sha256?))) + + (define symlink* + (lift2 symlink %store-monad)) + + (define add-indirect-root* + (store-lift add-indirect-root)) + + (mkdir-p cache-directory) + (maybe-remove-expired-cache-entries cache-directory + cache-entries + #:entry-expiration + (file-expiration-time ttl)) + + (if (file-exists? cached) + cached + (run-with-store store + (mlet %store-monad ((profile + (channel-instances->derivation instances))) + (mbegin %store-monad + (show-what-to-build* (list profile)) + (built-derivations (list profile)) + (symlink* (derivation->output-path profile) cached) + (add-indirect-root* cached) + (return cached)))))) (define* (inferior-for-channels channels #:key @@ -700,7 +699,9 @@ (define* (inferior-for-channels channels This is a convenience procedure that people may use in manifests passed to 'guix package -m', for instance." (define cached - (cached-channel-instance channels - #:cache-directory cache-directory - #:ttl ttl)) + (with-store store + (cached-channel-instance store + channels + #:cache-directory cache-directory + #:ttl ttl))) (open-inferior cached)) diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm index a6598fb0f7..a64badc27b 100644 --- a/guix/scripts/time-machine.scm +++ b/guix/scripts/time-machine.scm @@ -21,6 +21,7 @@ (define-module (guix scripts time-machine) #:use-module (guix scripts) #:use-module (guix inferior) #:use-module (guix channels) + #:use-module (guix store) #:use-module ((guix scripts pull) #:select (channel-list)) #:use-module (ice-9 match) #:use-module (srfi srfi-1) @@ -97,6 +98,7 @@ (define (guix-time-machine . args) (channels (channel-list opts)) (command-line (assoc-ref opts 'exec))) (when command-line - (let* ((directory (cached-channel-instance channels)) + (let* ((directory (with-store store + (cached-channel-instance store channels))) (executable (string-append directory "/bin/guix"))) (apply execl (cons* executable executable command-line))))))) -- cgit v1.2.3 From d17e012da7b41165cb49a5604a773459736144e3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 15 Nov 2019 21:11:58 +0100 Subject: time-machine: Handle 'git-error' exceptions. * guix/scripts/pull.scm (with-git-error-handling): Export. * guix/scripts/time-machine.scm (guix-time-machine): Wrap body in 'with-git-error-handling'. --- guix/scripts/pull.scm | 1 + guix/scripts/time-machine.scm | 20 +++++++++++--------- 2 files changed, 12 insertions(+), 9 deletions(-) (limited to 'guix') diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index c42794dbcb..0ab688ac24 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -57,6 +57,7 @@ (define-module (guix scripts pull) #:use-module (ice-9 format) #:export (display-profile-content channel-list + with-git-error-handling guix-pull)) diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm index a64badc27b..946b523741 100644 --- a/guix/scripts/time-machine.scm +++ b/guix/scripts/time-machine.scm @@ -22,7 +22,8 @@ (define-module (guix scripts time-machine) #:use-module (guix inferior) #:use-module (guix channels) #:use-module (guix store) - #:use-module ((guix scripts pull) #:select (channel-list)) + #:use-module ((guix scripts pull) + #:select (with-git-error-handling channel-list)) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) @@ -94,11 +95,12 @@ (define (parse-args args) (define (guix-time-machine . args) (with-error-handling - (let* ((opts (parse-args args)) - (channels (channel-list opts)) - (command-line (assoc-ref opts 'exec))) - (when command-line - (let* ((directory (with-store store - (cached-channel-instance store channels))) - (executable (string-append directory "/bin/guix"))) - (apply execl (cons* executable executable command-line))))))) + (with-git-error-handling + (let* ((opts (parse-args args)) + (channels (channel-list opts)) + (command-line (assoc-ref opts 'exec))) + (when command-line + (let* ((directory (with-store store + (cached-channel-instance store channels))) + (executable (string-append directory "/bin/guix"))) + (apply execl (cons* executable executable command-line)))))))) -- cgit v1.2.3 From 87e7faa2ae641d8302efc8b90f1e45f43f67f6da Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 15 Nov 2019 21:48:35 +0100 Subject: time-machine: Honor the standard build options. * guix/scripts/time-machine.scm (show-help): Call 'show-build-options-help'. (%options): Add %STANDARD-BUILD-OPTIONS. (%default-options): New variable. (parse-args): Pass (list %default-options) to 'parse-command-line' and remove #:build-options? parameter. (guix-time-machine): Call 'set-build-options-from-command-line' and wrap 'cached-channel-instance' call in 'with-status-verbosity'. * doc/guix.texi (Invoking guix time-machine): Mention common build options. --- doc/guix.texi | 4 ++++ guix/scripts/time-machine.scm | 55 +++++++++++++++++++++++++++++++++---------- 2 files changed, 46 insertions(+), 13 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index bc1d5d863a..51147e3e9a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4222,6 +4222,10 @@ will thus build the package @code{hello} as defined in the master branch, which is in general a newer revison of Guix than you have installed. Time travel works in both directions! +Note that @command{guix time-machine} can trigger builds of channels and +their dependencies, and these are controlled by the standard build +options (@pxref{Common Build Options}). + @node Inferiors @section Inferiors diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm index 946b523741..19e635555a 100644 --- a/guix/scripts/time-machine.scm +++ b/guix/scripts/time-machine.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Konrad Hinsen +;;; Copyright © 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,8 +23,15 @@ (define-module (guix scripts time-machine) #:use-module (guix inferior) #:use-module (guix channels) #:use-module (guix store) + #:use-module (guix status) + #:use-module ((guix utils) + #:select (%current-system)) #:use-module ((guix scripts pull) #:select (with-git-error-handling channel-list)) + #:use-module ((guix scripts build) + #:select (%standard-build-options + show-build-options-help + set-build-options-from-command-line)) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) @@ -47,6 +55,9 @@ (define (show-help) --commit=COMMIT use the specified COMMIT")) (display (G_ " --branch=BRANCH use the tip of the specified BRANCH")) + (newline) + (show-build-options-help) + (newline) (display (G_ " -h, --help display this help and exit")) (display (G_ " @@ -56,9 +67,9 @@ (define (show-help) (define %options ;; Specifications of the command-line options. - (list (option '(#\C "channels") #t #f - (lambda (opt name arg result) - (alist-cons 'channel-file arg result))) + (cons* (option '(#\C "channels") #t #f + (lambda (opt name arg result) + (alist-cons 'channel-file arg result))) (option '("url") #t #f (lambda (opt name arg result) (alist-cons 'repository-url arg @@ -69,20 +80,35 @@ (define %options (option '("branch") #t #f (lambda (opt name arg result) (alist-cons 'ref `(branch . ,arg) result))) - (option '(#\h "help") #f #f - (lambda args - (show-help) - (exit 0))) - (option '(#\V "version") #f #f - (lambda args - (show-version-and-exit "guix time-machine"))))) + (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix time-machine"))) + + %standard-build-options)) + +(define %default-options + ;; Alist of default option values. + `((system . ,(%current-system)) + (substitutes? . #t) + (build-hook? . #t) + (print-build-trace? . #t) + (print-extended-build-trace? . #t) + (multiplexed-build-output? . #t) + (graft? . #t) + (debug . 0) + (verbosity . 1))) (define (parse-args args) "Parse the list of command line arguments ARGS." ;; The '--' token is used to separate the command to run from the rest of ;; the operands. (let-values (((args command) (break (cut string=? "--" <>) args))) - (let ((opts (parse-command-line args %options '(()) #:build-options? #f))) + (let ((opts (parse-command-line args %options + (list %default-options)))) (match command (() opts) (("--") opts) @@ -100,7 +126,10 @@ (define (guix-time-machine . args) (channels (channel-list opts)) (command-line (assoc-ref opts 'exec))) (when command-line - (let* ((directory (with-store store - (cached-channel-instance store channels))) + (let* ((directory + (with-store store + (with-status-verbosity (assoc-ref opts 'verbosity) + (set-build-options-from-command-line store opts) + (cached-channel-instance store channels)))) (executable (string-append directory "/bin/guix"))) (apply execl (cons* executable executable command-line)))))))) -- cgit v1.2.3 From 9c9982dc0c8c38ce3821b154b7e92509c1564317 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Nov 2019 23:10:34 +0100 Subject: guix build: Handle "guix build /….drv" correctly for non-existent derivations. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This lets the daemon substitute missing derivations, as in the example at , instead of failing with ENOENT. * guix/scripts/build.scm (options->things-to-build): In the 'derivation-path?' case, don't fail when 'read-derivation-from-file' raises to ENOENT; return the empty list in that case. (guix-build): Add non-existent '.drv' files to ITEMS. Pass ITEMS in addition to DRV to 'build-derivations'. * tests/guix-build.sh: Add test. --- guix/scripts/build.scm | 19 ++++++++++++++++--- tests/guix-build.sh | 7 +++++++ 2 files changed, 23 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 9ad7379bbe..ae78df9c5c 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -802,7 +802,15 @@ (define (ensure-list x) (append-map (match-lambda (('argument . (? string? spec)) (cond ((derivation-path? spec) - (list (read-derivation-from-file spec))) + (catch 'system-error + (lambda () + (list (read-derivation-from-file spec))) + (lambda args + ;; Non-existent .drv files can be substituted down + ;; the road, so don't error out. + (if (= ENOENT (system-error-errno args)) + '() + (apply throw args))))) ((store-path? spec) ;; Nothing to do; maybe for --log-file. '()) @@ -934,7 +942,11 @@ (define opts '()))) (items (filter-map (match-lambda (('argument . (? store-path? file)) - (and (not (derivation-path? file)) + ;; If FILE is a .drv that's not in + ;; store, keep it so that it can be + ;; substituted. + (and (or (not (derivation-path? file)) + (not (file-exists? file))) file)) (_ #f)) opts)) @@ -965,7 +977,8 @@ (define opts (map (compose list derivation-file-name) drv) roots)) ((not (assoc-ref opts 'dry-run?)) - (and (build-derivations store drv mode) + (and (build-derivations store (append drv items) + mode) (for-each show-derivation-outputs drv) (for-each (cut register-root store <> <>) (map (lambda (drv) diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 62cdd5fe14..21b6af4395 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -42,6 +42,13 @@ out="`guix build "$drv"`" out2="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`" test "$out" = "$out2" +# Passing the name of a .drv that doesn't exist. The daemon should try to +# substitute the .drv. Here we just look for the "cannot build missing +# derivation" error that indicates that the daemon did try to substitute the +# .drv. +guix build "$NIX_STORE_DIR/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo.drv" 2>&1 \ + | grep "missing derivation" + # Passing a URI. GUIX_DAEMON_SOCKET="file://$GUIX_STATE_DIRECTORY/daemon-socket/socket" \ guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)' -- cgit v1.2.3 From b997d43214445462f23947afbbcadf24c6018217 Mon Sep 17 00:00:00 2001 From: Alex Sassmannshausen Date: Mon, 8 Apr 2019 15:18:23 +0100 Subject: utils: Handle #f file-name. * guix/utils.scm (current-source-directory): Change dispatch to handle #f file-name. Signed-off-by: Maxim Cournoyer --- guix/utils.scm | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) (limited to 'guix') diff --git a/guix/utils.scm b/guix/utils.scm index 1f99c5b3f5..64853f2989 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -782,13 +782,11 @@ (define-syntax current-source-directory ;; the absolute file name by looking at %LOAD-PATH; doing this at ;; run time rather than expansion time is necessary to allow files ;; to be moved on the file system. - (cond ((not file-name) - #f) ;raising an error would upset Geiser users - ((string-prefix? "/" file-name) - (dirname file-name)) - (else - #`(absolute-dirname #,file-name)))) - (#f + (if (string-prefix? "/" file-name) + (dirname file-name) + #`(absolute-dirname #,file-name))) + ((or ('filename . #f) #f) + ;; raising an error would upset Geiser users #f)))))) ;; A source location. -- cgit v1.2.3 From e1d31e6457481b471073e395136e7538e6692c97 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Mon, 28 Oct 2019 08:09:03 -0400 Subject: build-system: emacs: Simplify the SET-EMACS-LOAD-PATH phase. It is no longer necessary to search for the Elisp libraries manually, as Emacs now include a search path specification serving that purpose. * guix/build/emacs-build-system.scm (set-emacs-load-path): Replace by... (add-source-to-load-path): ...this. (%standard-phases): Adjust accordingly. --- guix/build/emacs-build-system.scm | 42 ++++++++------------------------------- 1 file changed, 8 insertions(+), 34 deletions(-) (limited to 'guix') diff --git a/guix/build/emacs-build-system.scm b/guix/build/emacs-build-system.scm index 47a9eda9e6..f0c41812f1 100644 --- a/guix/build/emacs-build-system.scm +++ b/guix/build/emacs-build-system.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2015 Federico Beffa ;;; Copyright © 2016 David Thompson ;;; Copyright © 2016 Alex Kost -;;; Copyright © 2018 Maxim Cournoyer +;;; Copyright © 2018, 2019 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -74,40 +74,14 @@ (define* (unpack #:key source #:allow-other-keys) #t) (gnu:unpack #:source source))) -(define* (set-emacs-load-path #:key source inputs #:allow-other-keys) - (define (inputs->directories inputs) - "Extract the directory part from INPUTS." - (match inputs - (((names . directories) ...) directories))) - - (define (input-directory->el-directory input-directory) - "Return the correct Emacs Lisp directory in INPUT-DIRECTORY or #f, if there -is no Emacs Lisp directory." - (let ((legacy-elisp-directory (string-append input-directory %legacy-install-suffix)) - (guix-elisp-directory - (string-append - input-directory %install-suffix "/" - (store-directory->elpa-name-version input-directory)))) - (cond - ((file-exists? guix-elisp-directory) guix-elisp-directory) - ((file-exists? legacy-elisp-directory) legacy-elisp-directory) - (else #f)))) - - (define (input-directories->el-directories input-directories) - "Return the list of Emacs Lisp directories in INPUT-DIRECTORIES." - (filter-map input-directory->el-directory input-directories)) - - "Set the EMACSLOADPATH environment variable so that dependencies are found." +(define* (add-source-to-load-path #:key dummy #:allow-other-keys) + "Augment the EMACSLOADPATH environment variable with the source directory." (let* ((source-directory (getcwd)) - (input-elisp-directories (input-directories->el-directories - (inputs->directories inputs))) - (emacs-load-path-value - (string-join - (append input-elisp-directories (list source-directory)) - ":" 'suffix))) + (emacs-load-path-value (string-append (getenv "EMACSLOADPATH") ":" + source-directory))) (setenv "EMACSLOADPATH" emacs-load-path-value) - (format #t "environment variable `EMACSLOADPATH' set to ~a\n" - emacs-load-path-value))) + (format #t "source directory ~s appended to the `EMACSLOADPATH' \ +environment variable\n" source-directory))) (define* (build #:key outputs inputs #:allow-other-keys) "Compile .el files." @@ -269,7 +243,7 @@ (define (store-directory->elpa-name-version store-dir) (define %standard-phases (modify-phases gnu:%standard-phases (replace 'unpack unpack) - (add-after 'unpack 'set-emacs-load-path set-emacs-load-path) + (add-after 'unpack 'add-source-to-load-path add-source-to-load-path) (delete 'bootstrap) (delete 'configure) ;; Move the build phase after install: the .el files are byte compiled -- cgit v1.2.3 From 0d78d0f09c10f5c7a25ac2ab4da4197913cd3321 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 18 Nov 2019 10:32:26 +0100 Subject: download: Load *.crt certificate bundles when *.pem files are missing. Fixes . * guix/build/download.scm (make-credendials-with-ca-trust-files): Look for *.crt files under DIRECTORY when *.pem files cannot be found. --- guix/build/download.scm | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/guix/build/download.scm b/guix/build/download.scm index a4c91550a6..141ef409d6 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -187,10 +187,13 @@ (define (make-credendials-with-ca-trust-files directory) DIRECTORY. Those authority certificates are checked when 'peer-certificate-status' is later called." (let ((cred (make-certificate-credentials)) - (files (or (scandir directory - (lambda (file) - (string-suffix? ".pem" file))) - '()))) + (files (match (scandir directory (cut string-suffix? ".pem" <>)) + ((or #f ()) + ;; Some distros provide nothing but bundles (*.crt) under + ;; /etc/ssl/certs, so look for them. + (or (scandir directory (cut string-suffix? ".crt" <>)) + '())) + (pem pem)))) (for-each (lambda (file) (let ((file (string-append directory "/" file))) ;; Protect against dangling symlinks. @@ -198,7 +201,7 @@ (define (make-credendials-with-ca-trust-files directory) (set-certificate-credentials-x509-trust-file!* cred file x509-certificate-format/pem)))) - (or files '())) + files) cred)) (define (peer-certificate session) -- cgit v1.2.3 From 6fbd8fde2fad113dbfc90c8b1b55f7ead919a90a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 18 Nov 2019 22:22:59 +0100 Subject: pull: Acquire a lock for the target profile. This is a followup to b1fb663404894268b5ee92c040f12c52c0bee425. * guix/scripts/pull.scm (guix-pull): Wrap 'run-with-store' call in 'with-file-lock/no-wait'. --- .dir-locals.el | 1 + guix/scripts/pull.scm | 19 +++++++++++++------ 2 files changed, 14 insertions(+), 6 deletions(-) (limited to 'guix') diff --git a/.dir-locals.el b/.dir-locals.el index 22aac2c402..e4947f5f10 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -35,6 +35,7 @@ (eval . (put 'modify-services 'scheme-indent-function 1)) (eval . (put 'with-directory-excursion 'scheme-indent-function 1)) (eval . (put 'with-file-lock 'scheme-indent-function 1)) + (eval . (put 'with-file-lock/no-wait 'scheme-indent-function 1)) (eval . (put 'package 'scheme-indent-function 0)) (eval . (put 'origin 'scheme-indent-function 0)) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 0ab688ac24..ef8d5c8fd9 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -36,6 +36,8 @@ (define-module (guix scripts pull) #:autoload (guix inferior) (open-inferior) #:use-module (guix scripts build) #:autoload (guix build utils) (which) + #:use-module ((guix build syscalls) + #:select (with-file-lock/no-wait)) #:use-module (guix git) #:use-module (git) #:use-module (gnu packages) @@ -815,11 +817,16 @@ (define (guix-pull . args) (if (assoc-ref opts 'bootstrap?) %bootstrap-guile (canonical-package guile-2.2))))) - (run-with-store store - (build-and-install instances profile - #:dry-run? - (assoc-ref opts 'dry-run?) - #:use-substitutes? - (assoc-ref opts 'substitutes?)))))))))))))) + (with-file-lock/no-wait (string-append profile ".lock") + (lambda (key . args) + (leave (G_ "profile ~a is locked by another process~%") + profile)) + + (run-with-store store + (build-and-install instances profile + #:dry-run? + (assoc-ref opts 'dry-run?) + #:use-substitutes? + (assoc-ref opts 'substitutes?))))))))))))))) ;;; pull.scm ends here -- cgit v1.2.3 From 1bdb63e73b73a6b581b65c4018aae587aebfcab4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 18 Nov 2019 22:59:21 +0100 Subject: deploy: Handle "--version". * guix/scripts/deploy.scm (%options): Add "--version". --- guix/scripts/deploy.scm | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'guix') diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm index f311587ec3..27b7e4fd1c 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -62,6 +62,10 @@ (define %options (lambda args (show-help) (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix deploy"))) + (option '(#\s "system") #t #f (lambda (opt name arg result) (alist-cons 'system arg -- cgit v1.2.3 From 064a967ba0480d35d706f96e8aa5bb86f0947b4d Mon Sep 17 00:00:00 2001 From: Timothy Sample Date: Wed, 30 Oct 2019 22:22:30 -0400 Subject: gnu: Use GHC 8.6.5 as the main Haskell compiler. * gnu/package/haskell.scm (ghc-8): Change to 'ghc-8.6'. * guix/import/hackage.scm (ghc-standard-libraries): Add 'ghc-heap' and 'libiserv'. --- gnu/packages/haskell.scm | 2 +- guix/import/hackage.scm | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/gnu/packages/haskell.scm b/gnu/packages/haskell.scm index d86daa52c5..8db650e6ae 100644 --- a/gnu/packages/haskell.scm +++ b/gnu/packages/haskell.scm @@ -604,7 +604,7 @@ (define-public ghc-8.6 (file-pattern ".*\\.conf\\.d$") (file-type 'directory)))))) -(define-public ghc-8 ghc-8.4) +(define-public ghc-8 ghc-8.6) (define-public ghc ghc-8) diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm index 5fe3d85a7f..9cf07c9504 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -52,8 +52,8 @@ (define-module (guix import hackage) hackage-package?)) (define ghc-standard-libraries - ;; List of libraries distributed with ghc (8.4.3). - ;; Contents of ...-ghc-8.4.3/lib/ghc-8.4.3. + ;; List of libraries distributed with ghc (8.6.5). + ;; Contents of ...-ghc-8.6.5/lib/ghc-8.6.5. '("ghc" "cabal" ;; in the output of `ghc-pkg list` Cabal is uppercased, but ;; hackage-name->package-name takes this into account. @@ -70,11 +70,13 @@ (define ghc-standard-libraries "ghc-boot" "ghc-boot-th" "ghc-compact" + "ghc-heap" "ghc-prim" "ghci" "haskeline" "hpc" "integer-gmp" + "libiserv" "mtl" "parsec" "pretty" -- cgit v1.2.3 From a2e661e95f8ab2fcb7741198234395b367a794c1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 20 Nov 2019 09:57:08 +0100 Subject: pack: Add "--derivation". * guix/scripts/pack.scm (%options, show-help): Add "--derivation". (guix-pack): Honor it. * tests/guix-pack.sh: Test it. * doc/guix.texi (Invoking guix pack): Document it. --- doc/guix.texi | 4 ++++ guix/scripts/pack.scm | 21 ++++++++++++++++----- tests/guix-pack.sh | 4 ++++ 3 files changed, 24 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index ea8a8783d8..1f120b0501 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5253,6 +5253,10 @@ added to it or removed from it after extraction of the pack. One use case for this is the Guix self-contained binary tarball (@pxref{Binary Installation}). +@item --derivation +@itemx -d +Print the name of the derivation that builds the pack. + @item --bootstrap Use the bootstrap binaries to build the pack. This option is only useful to Guix developers. diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 920d6c01fe..89b3e389fc 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -800,6 +800,10 @@ (define %options (option '(#\n "dry-run") #f #f (lambda (opt name arg result) (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) + (option '(#\d "derivation") #f #f + (lambda (opt name arg result) + (alist-cons 'derivation-only? #t result))) + (option '(#\f "format") #t #f (lambda (opt name arg result) (alist-cons 'format (string->symbol arg) result))) @@ -918,6 +922,8 @@ (define (show-help) -r, --root=FILE make FILE a symlink to the result, and register it as a garbage collector root")) (display (G_ " + -d, --derivation return the derivation of the pack")) + (display (G_ " -v, --verbosity=LEVEL use the given verbosity LEVEL")) (display (G_ " --bootstrap use the bootstrap binaries to build the pack")) @@ -1002,6 +1008,7 @@ (define properties (assoc-ref opts 'system) #:graft? (assoc-ref opts 'graft?)))) (let* ((dry-run? (assoc-ref opts 'dry-run?)) + (derivation? (assoc-ref opts 'derivation-only?)) (relocatable? (assoc-ref opts 'relocatable?)) (proot? (eq? relocatable? 'proot)) (manifest (let ((manifest (manifest-from-args store opts))) @@ -1070,11 +1077,15 @@ (define properties #:archiver archiver))) (mbegin %store-monad - (show-what-to-build* (list drv) - #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:dry-run? dry-run?) - (munless dry-run? + (munless derivation? + (show-what-to-build* (list drv) + #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:dry-run? dry-run?)) + (mwhen derivation? + (return (format #t "~a~%" + (derivation-file-name drv)))) + (munless (or derivation? dry-run?) (built-derivations (list drv)) (mwhen gc-root (register-root* (match (derivation->output-paths drv) diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh index 0feae6d1e8..cf4e4ca4f9 100644 --- a/tests/guix-pack.sh +++ b/tests/guix-pack.sh @@ -36,6 +36,10 @@ export GUIX_BUILD_OPTIONS test_directory="`mktemp -d`" trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT +# Compute the derivation of a pack. +drv="`guix pack coreutils -d --no-grafts`" +guix gc -R "$drv" | grep "`guix build coreutils -d --no-grafts`" + # Build a tarball with no compression. guix pack --compression=none --bootstrap guile-bootstrap -- cgit v1.2.3