From 686f14e8a45b06e0b27cc6100b60a475e6970fe6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 4 Dec 2012 00:17:49 +0100 Subject: distro: Add psmisc. * distro/packages/linux.scm (psmisc): New variable. --- distro/packages/linux.scm | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/distro/packages/linux.scm b/distro/packages/linux.scm index 54a0606a11..3048181ecd 100644 --- a/distro/packages/linux.scm +++ b/distro/packages/linux.scm @@ -21,6 +21,7 @@ #:use-module (guix download) #:use-module (distro packages flex) #:use-module (distro packages perl) + #:use-module (distro packages ncurses) #:use-module (guix build-system gnu)) (define-public linux-libre-headers @@ -104,3 +105,26 @@ Pluggable authentication modules are small shared object files that can be used through the PAM API to perform tasks, like authenticating a user at login. Local and dynamic reconfiguration are its key features") (license "BSD"))) + +(define-public psmisc + (package + (name "psmisc") + (version "22.20") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/psmisc/psmisc/psmisc-" + version ".tar.gz")) + (sha256 + (base32 + "052mfraykmxnavpi8s78aljx8w87hyvpx8mvzsgpjsjz73i28wmi")))) + (build-system gnu-build-system) + (inputs `(("ncurses" ,ncurses))) + (home-page "http://psmisc.sourceforge.net/") + (synopsis + "set of utilities that use the proc filesystem, such as fuser, killall, and pstree") + (description + "This PSmisc package is a set of some small useful utilities that +use the proc filesystem. We're not about changing the world, but +providing the system administrator with some help in common tasks.") + (license "GPLv2+"))) -- cgit v1.2.3 From 02b80c3f652bfd0814a37a0710822268f7934294 Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Mon, 3 Dec 2012 23:13:02 +0000 Subject: distro: Add util-linux. * distro/packages/linux.scm (util-linux): New variable. --- distro/packages/linux.scm | 45 +++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 43 insertions(+), 2 deletions(-) diff --git a/distro/packages/linux.scm b/distro/packages/linux.scm index 3048181ecd..d6669312dc 100644 --- a/distro/packages/linux.scm +++ b/distro/packages/linux.scm @@ -1,5 +1,6 @@ ;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- ;;; Copyright (C) 2012 Ludovic Courtès +;;; Copyright (C) 2012 Nikita Karetnikov ;;; ;;; This file is part of Guix. ;;; @@ -17,11 +18,13 @@ ;;; along with Guix. If not, see . (define-module (distro packages linux) - #:use-module (guix packages) - #:use-module (guix download) + #:use-module (distro packages compression) #:use-module (distro packages flex) + #:use-module (distro packages ncurses) #:use-module (distro packages perl) #:use-module (distro packages ncurses) + #:use-module (guix packages) + #:use-module (guix download) #:use-module (guix build-system gnu)) (define-public linux-libre-headers @@ -128,3 +131,41 @@ at login. Local and dynamic reconfiguration are its key features") use the proc filesystem. We're not about changing the world, but providing the system administrator with some help in common tasks.") (license "GPLv2+"))) + +(define-public util-linux + (package + (name "util-linux") + (version "2.21") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://kernel.org/linux/utils/" + name "/v" version "/" + name "-" version ".2" ".tar.xz")) + (sha256 + (base32 + "1rpgghf7n0zx0cdy8hibr41wvkm2qp1yvd8ab1rxr193l1jmgcir")))) + (build-system gnu-build-system) + (arguments + `(#:configure-flags '("--disable-use-tty-group") + #:phases (alist-cons-after + 'install 'patch-chkdupexe + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (substitute* (string-append out "/bin/chkdupexe") + ;; Allow 'patch-shebang' to do its work. + (("@PERL@") "/bin/perl")))) + %standard-phases))) + (inputs `(("zlib" ,zlib) + ("ncurses" ,ncurses) + ("perl" ,perl))) + (home-page "https://www.kernel.org/pub/linux/utils/util-linux/") + (synopsis + "util-linux is a random collection of utilities for the Linux kernel") + (description + "util-linux is a random collection of utilities for the Linux kernel.") + ;; Note that util-linux doesn't use the same license for all the + ;; code. GPLv2+ is the default license for a code without an + ;; explicitly defined license. + (license '("GPLv3+" "GPLv2+" "GPLv2" "LGPLv2+" + "BSD-original" "Public Domain")))) -- cgit v1.2.3 From 18d50d76216f5c207d8178cb2d2d2f31eb8fe3eb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 4 Dec 2012 22:03:21 +0100 Subject: distro: Add GNU lsh. * distro/packages/lsh.scm, distro/packages/patches/lsh-guile-compat.patch: distro/packages/patches/lsh-no-root-login.patch: distro/packages/patches/lsh-pam-service-name.patch: New files. * Makefile.am (MODULES): Add lsh.scm. (dist_patch_DATA): Add the above patches. --- Makefile.am | 4 + distro/packages/lsh.scm | 125 +++++++++++++++++++++ distro/packages/patches/lsh-guile-compat.patch | 9 ++ distro/packages/patches/lsh-no-root-login.patch | 16 +++ distro/packages/patches/lsh-pam-service-name.patch | 14 +++ 5 files changed, 168 insertions(+) create mode 100644 distro/packages/lsh.scm create mode 100644 distro/packages/patches/lsh-guile-compat.patch create mode 100644 distro/packages/patches/lsh-no-root-login.patch create mode 100644 distro/packages/patches/lsh-pam-service-name.patch diff --git a/Makefile.am b/Makefile.am index 8bb3b55634..2500c0e2a7 100644 --- a/Makefile.am +++ b/Makefile.am @@ -67,6 +67,7 @@ MODULES = \ distro/packages/libunistring.scm \ distro/packages/linux.scm \ distro/packages/lout.scm \ + distro/packages/lsh.scm \ distro/packages/m4.scm \ distro/packages/make-bootstrap.scm \ distro/packages/multiprecision.scm \ @@ -103,6 +104,9 @@ dist_patch_DATA = \ distro/packages/patches/guile-default-utf8.patch \ distro/packages/patches/guile-relocatable.patch \ distro/packages/patches/libtool-skip-tests.patch \ + distro/packages/patches/lsh-guile-compat.patch \ + distro/packages/patches/lsh-no-root-login.patch \ + distro/packages/patches/lsh-pam-service-name.patch \ distro/packages/patches/m4-gets-undeclared.patch \ distro/packages/patches/m4-readlink-EINVAL.patch \ distro/packages/patches/m4-s_isdir.patch \ diff --git a/distro/packages/lsh.scm b/distro/packages/lsh.scm new file mode 100644 index 0000000000..f6caf52caf --- /dev/null +++ b/distro/packages/lsh.scm @@ -0,0 +1,125 @@ +;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- +;;; Copyright (C) 2012 Ludovic Courtès +;;; +;;; This file is part of Guix. +;;; +;;; 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. +;;; +;;; 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 Guix. If not, see . + +(define-module (distro packages lsh) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (distro) + #:use-module (distro packages m4) + #:use-module (distro packages linux) + #:use-module (distro packages compression) + #:use-module (distro packages multiprecision) + #:use-module (distro packages readline) + #:use-module (distro packages gperf) + #:use-module (distro packages base)) + +(define-public liboop + (package + (name "liboop") + (version "1.0") + (source + (origin + (method url-fetch) + (uri (string-append "http://download.ofb.net/liboop/liboop-" + version ".tar.gz")) + (sha256 + (base32 + "0z6rlalhvfca64jpvksppc9bdhs7jwhiw4y35g5ibvh91xp3rn1l")))) + (build-system gnu-build-system) + (home-page "http://liboop.ofb.net/") + (synopsis "`liboop', an event loop library") + (description "liboop is an event loop library.") + (license "LGPLv2.1+"))) + +(define-public lsh + (package + (name "lsh") + (version "2.0.4") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnu/lsh/lsh-" + version ".tar.gz")) + (sha256 + (base32 + "149hf49xcj99wwvi7hcb59igq4vpyv8har1br1if3lrsw5irsjv1")))) + (build-system gnu-build-system) + (inputs + `(("linux-pam" ,linux-pam) + ("m4" ,m4) + ("readline" ,readline) + ("liboop" ,liboop) + ("zlib" ,zlib) + ("gmp" ,gmp) + ("guile" ,guile-final) + ("gperf" ,gperf) + ("psmisc" ,psmisc) ; for `killall' + + ("patch/no-root-login" ,(search-patch "lsh-no-root-login.patch")) + ("patch/guile-compat" ,(search-patch "lsh-guile-compat.patch")) + ("patch/pam-service-name" + ,(search-patch "lsh-pam-service-name.patch")))) + (arguments + '(#:patches (list (assoc-ref %build-inputs "patch/no-root-login") + (assoc-ref %build-inputs "patch/pam-service-name") + (assoc-ref %build-inputs "patch/guile-compat")) + + ;; Skip the `configure' test that checks whether /dev/ptmx & + ;; co. work as expected, because it relies on impurities (for + ;; instance, /dev/pts may be unavailable in chroots.) + #:configure-flags '("lsh_cv_sys_unix98_ptys=yes") + + ;; FIXME: Tests won't run in a chroot, presumably because + ;; /etc/profile is missing, and thus clients get an empty $PATH + ;; and nothing works. + #:tests? #f + + #:phases + (alist-cons-before + 'configure 'fix-test-suite + (lambda _ + ;; Tests rely on $USER being set. + (setenv "USER" "guix") + + (substitute* "src/testsuite/functions.sh" + (("localhost") + ;; Avoid host name lookups since they don't work in chroot + ;; builds. + "127.0.0.1") + (("set -e") + ;; Make tests more verbose. + "set -e\nset -x")) + + (substitute* (find-files "src/testsuite" "-test$") + (("localhost") "127.0.0.1")) + + (substitute* "src/testsuite/login-auth-test" + (("/bin/cat") + ;; Use the right path to `cat'. + (search-path (search-path-as-string->list (getenv "PATH")) + "cat")))) + %standard-phases))) + (home-page "http://www.lysator.liu.se/~nisse/lsh/") + (synopsis + "GNU lsh, a GPL'd implementation of the SSH protocol") + (description + "lsh is a free implementation (in the GNU sense) of the ssh +version 2 protocol, currently being standardised by the IETF +SECSH working group.") + (license "GPLv2+"))) diff --git a/distro/packages/patches/lsh-guile-compat.patch b/distro/packages/patches/lsh-guile-compat.patch new file mode 100644 index 0000000000..0fe0484580 --- /dev/null +++ b/distro/packages/patches/lsh-guile-compat.patch @@ -0,0 +1,9 @@ +Use (ice-9 rdelim) for `read-line'. + +--- lsh-2.0.4/src/scm/guile-compat.scm 2012-12-03 23:28:01.000000000 +0100 ++++ lsh-2.0.4/src/scm/guile-compat.scm 2012-12-03 23:28:04.000000000 +0100 +@@ -21,3 +21,4 @@ + ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + (use-syntax (ice-9 syncase)) ++(use-modules (ice-9 rdelim)) diff --git a/distro/packages/patches/lsh-no-root-login.patch b/distro/packages/patches/lsh-no-root-login.patch new file mode 100644 index 0000000000..9dd81de3fb --- /dev/null +++ b/distro/packages/patches/lsh-no-root-login.patch @@ -0,0 +1,16 @@ +Correctly handle the `--no-root-login' option. + +--- lsh-2.0.4/src/lshd.c 2006-05-01 13:47:44.000000000 +0200 ++++ lsh-2.0.4/src/lshd.c 2009-09-08 12:20:36.000000000 +0200 +@@ -758,6 +758,10 @@ main_argp_parser(int key, char *arg, str + self->allow_root = 1; + break; + ++ case OPT_NO_ROOT_LOGIN: ++ self->allow_root = 0; ++ break; ++ + case OPT_KERBEROS_PASSWD: + self->pw_helper = PATH_KERBEROS_HELPER; + break; + diff --git a/distro/packages/patches/lsh-pam-service-name.patch b/distro/packages/patches/lsh-pam-service-name.patch new file mode 100644 index 0000000000..6a6156855c --- /dev/null +++ b/distro/packages/patches/lsh-pam-service-name.patch @@ -0,0 +1,14 @@ +Tell `lsh-pam-checkpw', the PAM password helper program, to use a more +descriptive service name. + +--- lsh-2.0.4/src/lsh-pam-checkpw.c 2003-02-16 22:30:10.000000000 +0100 ++++ lsh-2.0.4/src/lsh-pam-checkpw.c 2008-11-28 16:16:58.000000000 +0100 +@@ -38,7 +38,7 @@ + #include + + #define PWD_MAXLEN 1024 +-#define SERVICE_NAME "other" ++#define SERVICE_NAME "lshd" + #define TIMEOUT 600 + + static int -- cgit v1.2.3 From 3036a01ff7dbf618a0012cea8de85820962f7b8e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 4 Dec 2012 22:04:03 +0100 Subject: Augment `TODO'. --- TODO | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/TODO b/TODO index cecea9636f..f0088a5ae2 100644 --- a/TODO +++ b/TODO @@ -51,6 +51,19 @@ This should specify builder code to be run when building a user environment with ‘guix-package’. For instance, Texinfo’s hook would create a new ‘dir’. +** add ‘patches’ there + +** extend ‘propagated-build-inputs’ with support for multiple outputs + +#+BEGIN_SRC scheme + (outputs '("out" "include")) + (propagated-build-inputs + `(((("i1" ,p1 "o1") + ("i2" ,p2)) + => "include") + ("i3" ,p3))) +#+END_SRC + * support cross-compilation Implement ‘package-cross-derivation’, and add the corresponding code in -- cgit v1.2.3 From 860a6f1ae06151d76d39a402d3d92cc7ea6f36ff Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 4 Dec 2012 23:46:50 +0100 Subject: derivations: Fix erroneous call to `add-to-store' for local files as input. * guix/derivations.scm (derivation)[inputs]: Fix typo in call to `add-to-store'. * tests/derivations.scm ("derivation with local file as input"): New test. * tests/packages.scm ("trivial with local file as input"): New test. --- guix/derivations.scm | 3 +-- tests/derivations.scm | 23 +++++++++++++++++++++++ tests/packages.scm | 17 +++++++++++++++++ 3 files changed, 41 insertions(+), 2 deletions(-) diff --git a/guix/derivations.scm b/guix/derivations.scm index cda1f065d4..b1f54232bc 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -418,8 +418,7 @@ known in advance, such as a file download." ((input . _) (let ((path (add-to-store store (basename input) - (hash-algo sha256) #t #t - input))) + #t #t "sha256" input))) (make-derivation-input path '())))) (delete-duplicates inputs))) (env-vars (env-vars-with-empty-outputs)) diff --git a/tests/derivations.scm b/tests/derivations.scm index bcedfbf948..14e1863a12 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -124,6 +124,29 @@ (string=? (call-with-input-file path read-line) "hello, world")))))) +(test-assert "derivation with local file as input" + (let* ((builder (add-text-to-store + %store "my-builder.sh" + "(while read line ; do echo $line ; done) < $in > $out" + '())) + (input (search-path %load-path "ice-9/boot-9.scm")) + (drv-path (derivation %store "derivation-with-input-file" + (%current-system) + "/bin/sh" `(,builder) + `(("in" + ;; Cheat to pass the actual file + ;; name to the builder. + . ,(add-to-store %store + (basename input) + #t #t "sha256" + input))) + `((,builder) + (,input))))) ; ← local file name + (and (build-derivations %store (list drv-path)) + (let ((p (derivation-path->output-path drv-path))) + (and (call-with-input-file p get-bytevector-all) + (call-with-input-file input get-bytevector-all)))))) + (test-assert "fixed-output derivation" (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" "echo -n hello > $out" '())) diff --git a/tests/packages.scm b/tests/packages.scm index cb69e4be4e..c89f6e7721 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -29,6 +29,7 @@ #:use-module (distro packages bootstrap) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) + #:use-module (rnrs io ports) #:use-module (ice-9 match)) ;; Test the high-level packaging layer. @@ -89,6 +90,22 @@ (equal? '(hello guix) (call-with-input-file (string-append p "/test") read)))))) +(test-assert "trivial with local file as input" + (let* ((i (search-path %load-path "ice-9/boot-9.scm")) + (p (package (inherit (dummy-package "trivial-with-input-file")) + (build-system trivial-build-system) + (source #f) + (arguments + `(#:guile ,%bootstrap-guile + #:builder (copy-file (assoc-ref %build-inputs "input") + %output))) + (inputs `(("input" ,i))))) + (d (package-derivation %store p))) + (and (build-derivations %store (list d)) + (let ((p (pk 'drv d (derivation-path->output-path d)))) + (equal? (call-with-input-file p get-bytevector-all) + (call-with-input-file i get-bytevector-all)))))) + (test-assert "trivial with system-dependent input" (let* ((p (package (inherit (dummy-package "trivial-system-dependent-input")) (build-system trivial-build-system) -- cgit v1.2.3 From cd3ded43015f09c84990dd0dcae4cfd114387410 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 4 Dec 2012 23:48:21 +0100 Subject: store: Honor $NIX_STORE_DIR and $NIX_STATE_DIR. * guix/store.scm (%nix-state-dir): Honor $NIX_STATE_DIR. (%store-prefix): Honor $NIX_STORE_DIR. --- guix/store.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/guix/store.scm b/guix/store.scm index d1621e4504..9aafb332dc 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -111,7 +111,8 @@ (sha1 2) (sha256 3)) -(define %nix-state-dir "/nix/var/nix") +(define %nix-state-dir + (or (getenv "NIX_STATE_DIR") "/nix/var/nix")) (define %default-socket-path (string-append %nix-state-dir "/daemon-socket/socket")) @@ -437,7 +438,8 @@ file name. Return #t on success." (define %store-prefix ;; Absolute path to the Nix store. - (make-parameter "/nix/store")) + (make-parameter (or (and=> (getenv "NIX_STORE_DIR") canonicalize-path) + "/nix/store"))) (define (store-path? path) "Return #t if PATH is a store path." -- cgit v1.2.3 From c7bdb1b9d1c0071e9a61a7bbdb8051a9b1620822 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 4 Dec 2012 23:50:20 +0100 Subject: guix-build: Don't connect to the daemon when run with `--version' or `--help'. * guix-build.in (%store): Turn into a SRFI-39 parameter. Update users. (guix-build): Set %STORE and call `open-connection' only after `parse-options' has been called. --- guix-build.in | 149 +++++++++++++++++++++++++++++----------------------------- 1 file changed, 75 insertions(+), 74 deletions(-) diff --git a/guix-build.in b/guix-build.in index 72386ac511..a3f6f5766b 100644 --- a/guix-build.in +++ b/guix-build.in @@ -45,7 +45,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ #:export (guix-build)) (define %store - (open-connection)) + (make-parameter #f)) (define (derivations-from-package-expressions exp system source?) "Eval EXP and return the corresponding derivation path for SYSTEM. @@ -56,10 +56,10 @@ When SOURCE? is true, return the derivations of the package sources." (let ((source (package-source p)) (loc (package-location p))) (if source - (package-source-derivation %store source) + (package-source-derivation (%store) source) (leave (_ "~a: error: package `~a' has no source~%") (location->string loc) (package-name p)))) - (package-derivation %store p system)) + (package-derivation (%store) p system)) (leave (_ "expression `~s' does not evaluate to a package~%") exp)))) @@ -176,12 +176,12 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@")) (match outputs* ((output) (symlink output root) - (add-indirect-root %store 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)) + (add-indirect-root (%store) root)) (+ 1 count)) 0 outputs)))) @@ -197,77 +197,78 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@")) (setvbuf (current-error-port) _IOLBF) (with-error-handling - (let* ((opts (parse-options)) - (src? (assoc-ref opts 'source?)) - (sys (assoc-ref opts 'system)) - (drv (filter-map (match-lambda - (('expression . exp) - (derivations-from-package-expressions exp sys - src?)) - (('argument . (? derivation-path? drv)) - drv) - (('argument . (? string? x)) - (match (find-packages-by-name x) - ((p _ ...) - (if src? - (let ((s (package-source p))) - (package-source-derivation %store s)) - (package-derivation %store p sys))) - (_ - (leave (_ "~A: unknown package~%") x)))) - (_ #f)) - opts)) - (req (append-map (lambda (drv-path) - (let ((d (call-with-input-file drv-path - read-derivation))) - (derivation-prerequisites-to-build %store d))) - drv)) - (req* (delete-duplicates - (append (remove (compose (cut valid-path? %store <>) - derivation-path->output-path) - drv) - (map derivation-input-path req))))) - (if (assoc-ref opts 'dry-run?) - (format (current-error-port) - (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]" - "~:[the following derivations would be built:~%~{ ~a~%~}~;~]" - (length req*)) - (null? req*) req*) - (format (current-error-port) - (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]" - "~:[the following derivations will be built:~%~{ ~a~%~}~;~]" - (length req*)) - (null? req*) req*)) + (let ((opts (parse-options))) + (parameterize ((%store (open-connection))) + (let* ((src? (assoc-ref opts 'source?)) + (sys (assoc-ref opts 'system)) + (drv (filter-map (match-lambda + (('expression . exp) + (derivations-from-package-expressions exp sys + src?)) + (('argument . (? derivation-path? drv)) + drv) + (('argument . (? string? x)) + (match (find-packages-by-name x) + ((p _ ...) + (if src? + (let ((s (package-source p))) + (package-source-derivation (%store) s)) + (package-derivation (%store) p sys))) + (_ + (leave (_ "~A: unknown package~%") x)))) + (_ #f)) + opts)) + (req (append-map (lambda (drv-path) + (let ((d (call-with-input-file drv-path + read-derivation))) + (derivation-prerequisites-to-build (%store) d))) + drv)) + (req* (delete-duplicates + (append (remove (compose (cut valid-path? (%store) <>) + derivation-path->output-path) + drv) + (map derivation-input-path req))))) + (if (assoc-ref opts 'dry-run?) + (format (current-error-port) + (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]" + "~:[the following derivations would be built:~%~{ ~a~%~}~;~]" + (length req*)) + (null? req*) req*) + (format (current-error-port) + (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]" + "~:[the following derivations will be built:~%~{ ~a~%~}~;~]" + (length req*)) + (null? req*) req*)) - ;; TODO: Add more options. - (set-build-options %store - #:keep-failed? (assoc-ref opts 'keep-failed?) - #:build-cores (or (assoc-ref opts 'cores) 0) - #:use-substitutes? (assoc-ref opts 'substitutes?)) + ;; TODO: Add more options. + (set-build-options (%store) + #:keep-failed? (assoc-ref opts 'keep-failed?) + #:build-cores (or (assoc-ref opts 'cores) 0) + #:use-substitutes? (assoc-ref opts 'substitutes?)) - (if (assoc-ref opts 'derivations-only?) - (format #t "~{~a~%~}" drv) - (or (assoc-ref opts 'dry-run?) - (and (build-derivations %store drv) - (for-each (lambda (d) - (let ((drv (call-with-input-file d - read-derivation))) - (format #t "~{~a~%~}" - (map (match-lambda - ((out-name . out) - (derivation-path->output-path - d out-name))) - (derivation-outputs drv))))) - drv) - (let ((roots (filter-map (match-lambda - (('gc-root . root) - root) - (_ #f)) - opts))) - (when roots - (for-each (cut register-root <> <>) - drv roots) - #t)))))))) + (if (assoc-ref opts 'derivations-only?) + (format #t "~{~a~%~}" drv) + (or (assoc-ref opts 'dry-run?) + (and (build-derivations (%store) drv) + (for-each (lambda (d) + (let ((drv (call-with-input-file d + read-derivation))) + (format #t "~{~a~%~}" + (map (match-lambda + ((out-name . out) + (derivation-path->output-path + d out-name))) + (derivation-outputs 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) -- cgit v1.2.3