diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 35b10a0..8937d76 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -37,6 +37,7 @@ #:export (%standard-build-options set-build-options-from-command-line show-build-options-help + specification->package guix-build)) diff --git a/guix/scripts/prefetch.scm b/guix/scripts/prefetch.scm new file mode 100644 index 0000000..dbcef0f --- /dev/null +++ b/guix/scripts/prefetch.scm @@ -0,0 +1,141 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Nikita Karetnikov +;;; Copyright © 2014 Ludovic Courtès +;;; +;;; 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 prefetch) + #:use-module (guix derivations) + #:use-module (guix packages) + #:use-module (guix store) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix scripts build) + #: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-prefetch)) + +;;; Commentary: +;;; +;;; This program is used to download and add to the store all inputs that are +;;; needed to build the specified packages. +;;; +;;; Code. + +(define (derivation-input->derivation input) + (call-with-input-file (derivation-input-path input) + read-derivation)) + +(define* (derivations-to-prefetch store package #:key (use-substitutes? #t)) + "Return the list of fixed-output derivations for PACKAGE." + (filter fixed-output-derivation? + (map derivation-input->derivation + (derivation-prerequisites-to-build + store + (package-derivation store package) + #:use-substitutes? use-substitutes?)))) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '((substitutes? . #t))) + +(define (show-help) + (display (_ "Usage: guix prefetch [OPTION]... PACKAGES... +Download and add to the store all inputs that are needed to build +PACKAGES.\n")) + (display (_ " + -n, --dry-run do not build the derivations")) + (display (_ " + --no-substitutes build instead of resorting to pre-built substitutes")) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (list (option '("no-substitutes") #f #f + (lambda (opt name arg result . rest) + (apply values + (alist-cons 'substitutes? #f + (alist-delete 'substitutes? result)) + rest))) + (option '(#\n "dry-run") #f #f + (lambda (opt name arg result) + (alist-cons 'dry-run? #t result))) + + (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix prefetch"))))) + + +;;; +;;; Entry point. +;;; + +(define (guix-prefetch . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (dry-run? (assoc-ref opts 'dry-run?)) + (substitutes? (assoc-ref opts 'substitutes?)) + (store (open-connection)) + (drvs + (append-map (lambda (package) + (derivations-to-prefetch + store + package + #:use-substitutes? substitutes?)) + + (delete-duplicates + (filter-map (match-lambda + (('argument . value) + (identity ; discard the second value + ;; Check that all VALUEs in the list are + ;; valid packages before calling + ;; 'derivations-to-prefetch'. If VALUE + ;; is not a valid package, + ;; 'specification->package' will raise + ;; an error. + (specification->package value))) + (_ #f)) + (reverse opts)))))) + (show-what-to-build store + drvs + #:dry-run? dry-run? + #:use-substitutes? substitutes?) + (unless dry-run? + (build-derivations store drvs))))