ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-24 03:29:40 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

pull: Honor the standard build options.

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

6
doc/guix.texi
View file

@ -2390,13 +2390,13 @@ For example, to download and deploy version 0.12.0 of Guix from the
canonical Git repo: canonical Git repo:
@example @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 @end example
It can also be used to deploy arbitrary Git revisions: It can also be used to deploy arbitrary Git revisions:
@example @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 @end example
@item --bootstrap @item --bootstrap
@ -2404,6 +2404,8 @@ Use the bootstrap Guile to build the latest Guix. This option is only
useful to Guix developers. useful to Guix developers.
@end table @end table
In addition, @command{guix pull} supports all the common build options
(@pxref{Common Build Options}).
@node Invoking guix pack @node Invoking guix pack
@section Invoking @command{guix pack} @section Invoking @command{guix pack}

103
guix/scripts/pull.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -28,6 +28,7 @@ (define-module (guix scripts pull)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix scripts build)
#:use-module ((guix build utils) #:use-module ((guix build utils)
#:select (with-directory-excursion delete-file-recursively)) #:select (with-directory-excursion delete-file-recursively))
#:use-module ((guix build download) #:use-module ((guix build download)
@ -72,7 +73,12 @@ (define-syntax-rule (with-PATH value body ...)
(define %default-options (define %default-options
;; Alist of default option values. ;; 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) (define (show-help)
(display (G_ "Usage: guix pull [OPTION]... (display (G_ "Usage: guix pull [OPTION]...
@ -84,6 +90,7 @@ (define (show-help)
(display (G_ " (display (G_ "
--bootstrap use the bootstrap Guile to build the new Guix")) --bootstrap use the bootstrap Guile to build the new Guix"))
(newline) (newline)
(show-build-options-help)
(display (G_ " (display (G_ "
-h, --help display this help and exit")) -h, --help display this help and exit"))
(display (G_ " (display (G_ "
@ -93,24 +100,29 @@ (define (show-help)
(define %options (define %options
;; Specifications of the command-line options. ;; Specifications of the command-line options.
(list (option '("verbose") #f #f (cons* (option '("verbose") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'verbose? #t result))) (alist-cons 'verbose? #t result)))
(option '("url") #t #f (option '("url") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'tarball-url arg (alist-cons 'tarball-url arg
(alist-delete 'tarball-url result)))) (alist-delete 'tarball-url result))))
(option '("bootstrap") #f #f (option '(#\n "dry-run") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'bootstrap? #t 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)))
(option '(#\h "help") #f #f (option '(#\h "help") #f #f
(lambda args (lambda args
(show-help) (show-help)
(exit 0))) (exit 0)))
(option '(#\V "version") #f #f (option '(#\V "version") #f #f
(lambda args (lambda args
(show-version-and-exit "guix pull"))))) (show-version-and-exit "guix pull")))
%standard-build-options))
(define what-to-build (define what-to-build
(store-lift show-what-to-build)) (store-lift show-what-to-build))
@ -215,16 +227,8 @@ (define* (build-and-install tarball config-dir
(return #t)))) (return #t))))
(leave (G_ "failed to update Guix, check the build log~%"))))) (leave (G_ "failed to update Guix, check the build log~%")))))
(define (guix-pull . args) (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) (define (use-le-certs? url)
(string-prefix? "https://git.savannah.gnu.org/" url)) (string-prefix? "https://git.savannah.gnu.org/" url))
@ -232,28 +236,31 @@ (define (fetch-tarball store url)
(download-to-store store url "guix-latest.tar.gz")) (download-to-store store url "guix-latest.tar.gz"))
(with-error-handling (with-error-handling
(let* ((opts (parse-options)) (let* ((opts (parse-command-line args %options
(list %default-options)))
(store (open-connection)) (store (open-connection))
(url (assoc-ref opts 'tarball-url))) (url (assoc-ref opts 'tarball-url)))
(let ((tarball (set-build-options-from-command-line store opts)
(if (use-le-certs? url) (unless (assoc-ref opts 'dry-run?) ;XXX: not very useful
(let* ((drv (package-derivation store le-certs)) (let ((tarball
(certs (string-append (derivation->output-path drv) (if (use-le-certs? url)
"/etc/ssl/certs"))) (let* ((drv (package-derivation store le-certs))
(build-derivations store (list drv)) (certs (string-append (derivation->output-path drv)
(parameterize ((%x509-certificate-directory certs)) "/etc/ssl/certs")))
(fetch-tarball store url))) (build-derivations store (list drv))
(fetch-tarball store url)))) (parameterize ((%x509-certificate-directory certs))
(unless tarball (fetch-tarball store url)))
(leave (G_ "failed to download up-to-date source, exiting\n"))) (fetch-tarball store url))))
(parameterize ((%guile-for-build (unless tarball
(package-derivation store (leave (G_ "failed to download up-to-date source, exiting\n")))
(if (assoc-ref opts 'bootstrap?) (parameterize ((%guile-for-build
%bootstrap-guile (package-derivation store
(canonical-package guile-2.0))))) (if (assoc-ref opts 'bootstrap?)
(run-with-store store %bootstrap-guile
(build-and-install tarball (config-directory) (canonical-package guile-2.0)))))
#:verbose? (assoc-ref opts 'verbose?)))))))) (run-with-store store
(build-and-install tarball (config-directory)
#:verbose? (assoc-ref opts 'verbose?)))))))))
;; Local Variables: ;; Local Variables:
;; eval: (put 'with-PATH 'scheme-indent-function 1) ;; eval: (put 'with-PATH 'scheme-indent-function 1)