pull: Honor the standard build options.

Reported by Niall Dooley <dooleyn@gmail.com>
in <https://lists.gnu.org/archive/html/help-guix/2017-05/msg00038.html>.

* guix/scripts/pull.scm (%options): Add --dry-run and all of
%STANDARD-BUILD-OPTIONS.
(show-help): Add call to 'show-build-options-help'.
(%default-options): Add 'system', 'substitutes?', 'graft?',
'max-silent-time', and 'verbosity'.
(guix-pull)[parse-options]: Remove.
Use 'parse-command-line' instead.  Honor --dry-run.
This commit is contained in:
Ludovic Courtès 2017-05-09 15:45:04 +02:00
parent f0b7dc7ede
commit 4902d3c4e0
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 59 additions and 50 deletions

View File

@ -2390,13 +2390,13 @@ For example, to download and deploy version 0.12.0 of Guix from the
canonical Git repo:
@example
guix pull --url=http://git.savannah.gnu.org/cgit/guix.git/snapshot/v0.12.0.tar.gz
guix pull --url=https://git.savannah.gnu.org/cgit/guix.git/snapshot/v0.12.0.tar.gz
@end example
It can also be used to deploy arbitrary Git revisions:
@example
guix pull --url=http://git.savannah.gnu.org/cgit/guix.git/snapshot/74d862e8a.tar.gz
guix pull --url=https://git.savannah.gnu.org/cgit/guix.git/snapshot/74d862e8a.tar.gz
@end example
@item --bootstrap
@ -2404,6 +2404,8 @@ Use the bootstrap Guile to build the latest Guix. This option is only
useful to Guix developers.
@end table
In addition, @command{guix pull} supports all the common build options
(@pxref{Common Build Options}).
@node Invoking guix pack
@section Invoking @command{guix pack}

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;;
;;; This file is part of GNU Guix.
@ -28,6 +28,7 @@
#:use-module (guix download)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix scripts build)
#:use-module ((guix build utils)
#:select (with-directory-excursion delete-file-recursively))
#:use-module ((guix build download)
@ -72,7 +73,12 @@
(define %default-options
;; Alist of default option values.
`((tarball-url . ,%snapshot-url)))
`((tarball-url . ,%snapshot-url)
(system . ,(%current-system))
(substitutes? . #t)
(graft? . #t)
(max-silent-time . 3600)
(verbosity . 0)))
(define (show-help)
(display (G_ "Usage: guix pull [OPTION]...
@ -84,6 +90,7 @@ Download and deploy the latest version of Guix.\n"))
(display (G_ "
--bootstrap use the bootstrap Guile to build the new Guix"))
(newline)
(show-build-options-help)
(display (G_ "
-h, --help display this help and exit"))
(display (G_ "
@ -93,13 +100,16 @@ Download and deploy the latest version of Guix.\n"))
(define %options
;; Specifications of the command-line options.
(list (option '("verbose") #f #f
(cons* (option '("verbose") #f #f
(lambda (opt name arg result)
(alist-cons 'verbose? #t result)))
(option '("url") #t #f
(lambda (opt name arg result)
(alist-cons 'tarball-url arg
(alist-delete 'tarball-url result))))
(option '(#\n "dry-run") #f #f
(lambda (opt name arg result)
(alist-cons 'dry-run? #t (alist-cons 'graft? #f result))))
(option '("bootstrap") #f #f
(lambda (opt name arg result)
(alist-cons 'bootstrap? #t result)))
@ -110,7 +120,9 @@ Download and deploy the latest version of Guix.\n"))
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix pull")))))
(show-version-and-exit "guix pull")))
%standard-build-options))
(define what-to-build
(store-lift show-what-to-build))
@ -215,16 +227,8 @@ contained therein."
(return #t))))
(leave (G_ "failed to update Guix, check the build log~%")))))
(define (guix-pull . args)
(define (parse-options)
;; Return the alist of option values.
(args-fold* args %options
(lambda (opt name arg result)
(leave (G_ "~A: unrecognized option~%") name))
(lambda (arg result)
(leave (G_ "~A: unexpected argument~%") arg))
%default-options))
(define (use-le-certs? url)
(string-prefix? "https://git.savannah.gnu.org/" url))
@ -232,9 +236,12 @@ contained therein."
(download-to-store store url "guix-latest.tar.gz"))
(with-error-handling
(let* ((opts (parse-options))
(let* ((opts (parse-command-line args %options
(list %default-options)))
(store (open-connection))
(url (assoc-ref opts 'tarball-url)))
(set-build-options-from-command-line store opts)
(unless (assoc-ref opts 'dry-run?) ;XXX: not very useful
(let ((tarball
(if (use-le-certs? url)
(let* ((drv (package-derivation store le-certs))
@ -253,7 +260,7 @@ contained therein."
(canonical-package guile-2.0)))))
(run-with-store store
(build-and-install tarball (config-directory)
#:verbose? (assoc-ref opts 'verbose?))))))))
#:verbose? (assoc-ref opts 'verbose?)))))))))
;; Local Variables:
;; eval: (put 'with-PATH 'scheme-indent-function 1)