From 4c0c4db0702048488a9712dbba7cad862c667d54 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 15 Mar 2017 21:54:34 +0100 Subject: utils: Move base16 procedures to (guix base16). * guix/utils.scm (bytevector->base16-string, base16-string->bytevector): Move to... * guix/base16.scm: ... here. New file. * tests/utils.scm ("bytevector->base16-string->bytevector"): Move to... * tests/base16.scm: ... here. New file. * Makefile.am (MODULES): Add guix/base16.scm. (SCM_TESTS): Add tests/base16.scm. * build-aux/download.scm, guix/derivations.scm, guix/docker.scm, guix/import/snix.scm, guix/pk-crypto.scm, guix/scripts/authenticate.scm, guix/scripts/download.scm, guix/scripts/hash.scm, guix/store.scm, tests/hash.scm, tests/pk-crypto.scm: Adjust imports accordingly. --- guix/base16.scm | 83 +++++++++++++++++++++++++++++++++++++++++++ guix/derivations.scm | 1 + guix/docker.scm | 1 + guix/import/snix.scm | 3 +- guix/pk-crypto.scm | 6 ++-- guix/scripts/authenticate.scm | 4 +-- guix/scripts/download.scm | 4 +-- guix/scripts/hash.scm | 2 +- guix/store.scm | 1 + guix/utils.scm | 65 +-------------------------------- 10 files changed, 96 insertions(+), 74 deletions(-) create mode 100644 guix/base16.scm (limited to 'guix') diff --git a/guix/base16.scm b/guix/base16.scm new file mode 100644 index 0000000000..6c15a9f588 --- /dev/null +++ b/guix/base16.scm @@ -0,0 +1,83 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2012, 2014, 2017 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 base16) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-60) + #:use-module (rnrs bytevectors) + #:use-module (ice-9 vlist) + #:use-module (ice-9 format) + #:export (bytevector->base16-string + base16-string->bytevector)) + +;;; +;;; Base 16. +;;; + +(define (bytevector->base16-string bv) + "Return the hexadecimal representation of BV's contents." + (define len + (bytevector-length bv)) + + (let-syntax ((base16-chars (lambda (s) + (syntax-case s () + (_ + (let ((v (list->vector + (unfold (cut > <> 255) + (lambda (n) + (format #f "~2,'0x" n)) + 1+ + 0)))) + v)))))) + (define chars base16-chars) + (let loop ((i len) + (r '())) + (if (zero? i) + (string-concatenate r) + (let ((i (- i 1))) + (loop i + (cons (vector-ref chars (bytevector-u8-ref bv i)) r))))))) + +(define base16-string->bytevector + (let ((chars->value (fold (lambda (i r) + (vhash-consv (string-ref (number->string i 16) + 0) + i r)) + vlist-null + (iota 16)))) + (lambda (s) + "Return the bytevector whose hexadecimal representation is string S." + (define bv + (make-bytevector (quotient (string-length s) 2) 0)) + + (string-fold (lambda (chr i) + (let ((j (quotient i 2)) + (v (and=> (vhash-assv chr chars->value) cdr))) + (if v + (if (zero? (logand i 1)) + (bytevector-u8-set! bv j + (arithmetic-shift v 4)) + (let ((w (bytevector-u8-ref bv j))) + (bytevector-u8-set! bv j (logior v w)))) + (error "invalid hexadecimal character" chr))) + (+ i 1)) + 0 + s) + bv))) + diff --git a/guix/derivations.scm b/guix/derivations.scm index 47a783f42f..e02d1ee036 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -31,6 +31,7 @@ #:use-module (ice-9 vlist) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix base16) #:use-module (guix memoization) #:use-module (guix combinators) #:use-module (guix monads) diff --git a/guix/docker.scm b/guix/docker.scm index dbe1e5351c..6dabaf25b0 100644 --- a/guix/docker.scm +++ b/guix/docker.scm @@ -19,6 +19,7 @@ (define-module (guix docker) #:use-module (guix hash) #:use-module (guix store) + #:use-module (guix base16) #:use-module (guix utils) #:use-module ((guix build utils) #:select (delete-file-recursively diff --git a/guix/import/snix.scm b/guix/import/snix.scm index bc75cbfda5..778768ff2d 100644 --- a/guix/import/snix.scm +++ b/guix/import/snix.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -39,6 +39,7 @@ #:use-module ((guix build utils) #:select (package-name->name+version)) #:use-module (guix import utils) + #:use-module (guix base16) #:use-module (guix base32) #:use-module (guix config) #:use-module (guix gnu-maintenance) diff --git a/guix/pk-crypto.scm b/guix/pk-crypto.scm index f90c2e61d5..7017006a71 100644 --- a/guix/pk-crypto.scm +++ b/guix/pk-crypto.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2017 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,9 +17,7 @@ ;;; along with GNU Guix. If not, see . (define-module (guix pk-crypto) - #:use-module ((guix utils) - #:select (bytevector->base16-string - base16-string->bytevector)) + #:use-module (guix base16) #:use-module (guix gcrypt) #:use-module (system foreign) diff --git a/guix/scripts/authenticate.scm b/guix/scripts/authenticate.scm index d9f799df26..d9a312f1da 100644 --- a/guix/scripts/authenticate.scm +++ b/guix/scripts/authenticate.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,7 +18,7 @@ (define-module (guix scripts authenticate) #:use-module (guix config) - #:use-module (guix utils) + #:use-module (guix base16) #:use-module (guix pk-crypto) #:use-module (guix pki) #:use-module (guix ui) diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm index dffff79729..1ddfd648cd 100644 --- a/guix/scripts/download.scm +++ b/guix/scripts/download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2015, 2016 Ludovic Courtès +;;; Copyright © 2012, 2013, 2015, 2016, 2017 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,7 +21,7 @@ #:use-module (guix scripts) #:use-module (guix store) #:use-module (guix hash) - #:use-module (guix utils) + #:use-module (guix base16) #:use-module (guix base32) #:use-module ((guix download) #:hide (url-fetch)) #:use-module ((guix build download) diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index 640b2417d2..a048b53461 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -24,7 +24,7 @@ #:use-module (guix serialization) #:use-module (guix ui) #:use-module (guix scripts) - #:use-module (guix utils) + #:use-module (guix base16) #:use-module (ice-9 binary-ports) #:use-module (rnrs files) #:use-module (ice-9 match) diff --git a/guix/store.scm b/guix/store.scm index cce460f3ce..2f05351767 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -22,6 +22,7 @@ #:use-module (guix memoization) #:use-module (guix serialization) #:use-module (guix monads) + #:use-module (guix base16) #:autoload (guix base32) (bytevector->base32-string) #:autoload (guix build syscalls) (terminal-columns) #:use-module (rnrs bytevectors) diff --git a/guix/utils.scm b/guix/utils.scm index b72e3f233f..bc90686de0 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -28,15 +28,12 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-39) - #:use-module (srfi srfi-60) - #:use-module (rnrs bytevectors) #:use-module (ice-9 binary-ports) #:autoload (rnrs io ports) (make-custom-binary-input-port) #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!)) #:use-module (guix memoization) #:use-module ((guix build utils) #:select (dump-port)) #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync)) - #:use-module (ice-9 vlist) #:use-module (ice-9 format) #:autoload (ice-9 popen) (open-pipe*) #:autoload (ice-9 rdelim) (read-line) @@ -46,10 +43,7 @@ #:use-module ((ice-9 iconv) #:prefix iconv:) #:use-module (system foreign) #:re-export (memoize) ; for backwards compatibility - #:export (bytevector->base16-string - base16-string->bytevector - - strip-keyword-arguments + #:export (strip-keyword-arguments default-keyword-arguments substitute-keyword-arguments ensure-keyword-arguments @@ -98,63 +92,6 @@ call-with-compressed-output-port canonical-newline-port)) - -;;; -;;; Base 16. -;;; - -(define (bytevector->base16-string bv) - "Return the hexadecimal representation of BV's contents." - (define len - (bytevector-length bv)) - - (let-syntax ((base16-chars (lambda (s) - (syntax-case s () - (_ - (let ((v (list->vector - (unfold (cut > <> 255) - (lambda (n) - (format #f "~2,'0x" n)) - 1+ - 0)))) - v)))))) - (define chars base16-chars) - (let loop ((i len) - (r '())) - (if (zero? i) - (string-concatenate r) - (let ((i (- i 1))) - (loop i - (cons (vector-ref chars (bytevector-u8-ref bv i)) r))))))) - -(define base16-string->bytevector - (let ((chars->value (fold (lambda (i r) - (vhash-consv (string-ref (number->string i 16) - 0) - i r)) - vlist-null - (iota 16)))) - (lambda (s) - "Return the bytevector whose hexadecimal representation is string S." - (define bv - (make-bytevector (quotient (string-length s) 2) 0)) - - (string-fold (lambda (chr i) - (let ((j (quotient i 2)) - (v (and=> (vhash-assv chr chars->value) cdr))) - (if v - (if (zero? (logand i 1)) - (bytevector-u8-set! bv j - (arithmetic-shift v 4)) - (let ((w (bytevector-u8-ref bv j))) - (bytevector-u8-set! bv j (logior v w)))) - (error "invalid hexadecimal character" chr))) - (+ i 1)) - 0 - s) - bv))) - - ;;; ;;; Filtering & pipes. -- cgit v1.2.3 From d938a58beefc669ab340aa1aeab49df3dc24d123 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 15 Mar 2017 22:14:36 +0100 Subject: gexp: Add '=>' syntax to import computed modules. * guix/gexp.scm (imported-files)[file-pair]: Add case for pairs where the cdr is not a string. (imported-modules): Support '=>' syntax in MODULES. * tests/gexp.scm ("imported-files with file-like objects") ("gexp->derivation & with-imported-module & computed module"): New tests. * doc/guix.texi (G-Expressions): Document '=>' syntax for 'with-imported-modules'. --- doc/guix.texi | 18 ++++++++++++++++-- guix/gexp.scm | 40 +++++++++++++++++++++++++++++----------- tests/gexp.scm | 39 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 84 insertions(+), 13 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 78bf03de9e..2e70848e55 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4347,8 +4347,22 @@ of the @code{gexp?} type (see below.) @deffn {Scheme Syntax} with-imported-modules @var{modules} @var{body}@dots{} Mark the gexps defined in @var{body}@dots{} as requiring @var{modules} -in their execution environment. @var{modules} must be a list of Guile -module names, such as @code{'((guix build utils) (guix build gremlin))}. +in their execution environment. + +Each item in @var{modules} can be the name of a module, such as +@code{(guix build utils)}, or it can be a module name, followed by an +arrow, followed by a file-like object: + +@example +`((guix build utils) + (guix gcrypt) + ((guix config) => ,(scheme-file "config.scm" + #~(define-module @dots{})))) +@end example + +@noindent +In the example above, the first two modules are taken from the search +path, and the last one is created from the given file-like object. This form has @emph{lexical} scope: it has an effect on the gexps directly defined in @var{body}@dots{}, but not on those defined, say, in diff --git a/guix/gexp.scm b/guix/gexp.scm index d11ed177fe..1b8e43e994 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -912,13 +912,17 @@ environment." (system (%current-system)) (guile (%guile-for-build))) "Return a derivation that imports FILES into STORE. FILES must be a list -of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file -system, imported, and appears under FINAL-PATH in the resulting store path." +of (FINAL-PATH . FILE) pairs. Each FILE is mapped to FINAL-PATH in the +resulting store path. FILE can be either a file name, or a file-like object, +as returned by 'local-file' for example." (define file-pair (match-lambda - ((final-path . file-name) + ((final-path . (? string? file-name)) (mlet %store-monad ((file (interned-file file-name (basename final-path)))) + (return (list final-path file)))) + ((final-path . file-like) + (mlet %store-monad ((file (lower-object file-like system))) (return (list final-path file)))))) (mlet %store-monad ((files (sequence %store-monad @@ -950,14 +954,28 @@ system, imported, and appears under FINAL-PATH in the resulting store path." (guile (%guile-for-build)) (module-path %load-path)) "Return a derivation that contains the source files of MODULES, a list of -module names such as `(ice-9 q)'. All of MODULES must be in the MODULE-PATH -search path." - ;; TODO: Determine the closure of MODULES, build the `.go' files, - ;; canonicalize the source files through read/write, etc. - (let ((files (map (lambda (m) - (let ((f (module->source-file-name m))) - (cons f (search-path* module-path f)))) - modules))) +module names such as `(ice-9 q)'. All of MODULES must be either names of +modules to be found in the MODULE-PATH search path, or a module name followed +by an arrow followed by a file-like object. For example: + + (imported-modules `((guix build utils) + (guix gcrypt) + ((guix config) => ,(scheme-file …)))) + +In this example, the first two modules are taken from MODULE-PATH, and the +last one is created from the given object." + (mlet %store-monad ((files + (mapm %store-monad + (match-lambda + (((module ...) '=> file) + (return + (cons (module->source-file-name module) + file))) + ((module ...) + (let ((f (module->source-file-name module))) + (return + (cons f (search-path* module-path f)))))) + modules))) (imported-files files #:name name #:system system #:guile guile))) diff --git a/tests/gexp.scm b/tests/gexp.scm index baf78837ae..b3f7323984 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -598,6 +598,23 @@ get-bytevector-all)))) files)))))) +(test-assertm "imported-files with file-like objects" + (mlet* %store-monad ((plain -> (plain-file "foo" "bar!")) + (q-scm -> (search-path %load-path "ice-9/q.scm")) + (files -> `(("a/b/c" . ,q-scm) + ("p/q" . ,plain))) + (drv (imported-files files))) + (mbegin %store-monad + (built-derivations (list drv)) + (mlet %store-monad ((dir -> (derivation->output-path drv)) + (plain* (text-file "foo" "bar!")) + (q-scm* (interned-file q-scm "c"))) + (return + (and (string=? (readlink (string-append dir "/a/b/c")) + q-scm*) + (string=? (readlink (string-append dir "/p/q")) + plain*))))))) + (test-equal "gexp-modules & ungexp" '((bar) (foo)) ((@@ (guix gexp) gexp-modules) @@ -668,6 +685,28 @@ (equal? '(chdir "/foo") (call-with-input-file b read)))))))) +(test-assertm "gexp->derivation & with-imported-module & computed module" + (mlet* %store-monad + ((module -> (scheme-file "x" #~(begin + (define-module (foo bar) + #:export (the-answer)) + + (define the-answer 42)))) + (build -> (with-imported-modules `(((foo bar) => ,module) + (guix build utils)) + #~(begin + (use-modules (guix build utils) + (foo bar)) + mkdir-p + (call-with-output-file #$output + (lambda (port) + (write the-answer port)))))) + (drv (gexp->derivation "thing" build)) + (out -> (derivation->output-path drv))) + (mbegin %store-monad + (built-derivations (list drv)) + (return (= 42 (call-with-input-file out read)))))) + (test-assertm "gexp->derivation #:references-graphs" (mlet* %store-monad ((one (text-file "one" (random-text))) -- cgit v1.2.3 From 146db52a188b871769d9512867aa7f409f37dbac Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 16 Mar 2017 13:41:51 +0100 Subject: memoization: Micro-optimize code produced by 'define-cache-procedure'. * guix/memoization.scm (%nothing): Remove. (define-cache-procedure): Make '%nothing' a local variable, with a literal list. --- guix/memoization.scm | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) (limited to 'guix') diff --git a/guix/memoization.scm b/guix/memoization.scm index d64f60fe9c..5cae283610 100644 --- a/guix/memoization.scm +++ b/guix/memoization.scm @@ -31,9 +31,6 @@ (define-syntax-rule (return/1 value) value) -(define %nothing ;nothingness - (list 'this 'is 'nothing)) - (define-syntax define-cache-procedure (syntax-rules () "Define a procedure NAME that implements a cache using HASH-REF and @@ -41,15 +38,17 @@ HASH-SET!. Use CALL to invoke the thunk and RETURN to return its value; CALL and RETURN are used to distinguish between multiple-value and single-value returns." ((_ name hash-ref hash-set! call return) - (define (name cache key thunk) - "Cache the result of THUNK under KEY in CACHE, or return the + (define name + (let ((%nothing '(this is nothing))) + (lambda (cache key thunk) + "Cache the result of THUNK under KEY in CACHE, or return the already-cached result." - (let ((results (hash-ref cache key %nothing))) - (if (eq? results %nothing) - (let ((results (call thunk))) - (hash-set! cache key results) - (return results)) - (return results))))) + (let ((results (hash-ref cache key %nothing))) + (if (eq? results %nothing) + (let ((results (call thunk))) + (hash-set! cache key results) + (return results)) + (return results))))))) ((_ name hash-ref hash-set!) (define-cache-procedure name hash-ref hash-set! call/mv return/mv)))) -- cgit v1.2.3 From 2971f39c3330a69f44d1ac97443e42b0f8e0173e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 16 Mar 2017 17:31:10 +0100 Subject: pack: Honor command-line options related to the store. * guix/scripts/pack.scm (guix-pack): Call 'set-build-options-from-command-line'. --- guix/scripts/pack.scm | 3 +++ 1 file changed, 3 insertions(+) (limited to 'guix') diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 067b1227e0..e422b3cdda 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -284,6 +284,9 @@ Create a bundle of PACKAGE.\n")) (symlinks (assoc-ref opts 'symlinks)) (localstatedir? (assoc-ref opts 'localstatedir?))) (with-store store + ;; Set the build options before we do anything else. + (set-build-options-from-command-line store opts) + (run-with-store store (mlet* %store-monad ((profile (profile-derivation (packages->manifest packages))) -- cgit v1.2.3 From b1edfbc37f2f008188d91f594b046c5986485e47 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 16 Mar 2017 18:02:59 +0100 Subject: pack: Add '--format' option and Docker output support. * guix/docker.scm: Remove dependency on (guix store) and (guix utils). Use (guix build store-copy). Load (json) lazily. (build-docker-image): Remove #:system. Add #:closure, #:compressor, and 'image' parameters. Use 'uname' to determine the architecture. Remove use of 'call-with-temporary-directory'. Use 'read-reference-graph' to compute ITEMS. Honor #:compressor. * guix/scripts/pack.scm (docker-image): New procedure. (%default-options): Add 'format'. (%formats): New variable. (%options, show-help): Add '--format'. (guix-pack): Honor '--format'. * guix/scripts/archive.scm: Remove '--format' option. This reverts commits 1545a012cb7cd78e25ed99ecee26df457be590e9, 01445711db6771cea6122859c3f717f130359f55, and 03476a23ff2d4175b7d3c808726178f764359bec. * doc/guix.texi (Invoking guix pack): Document '--format'. (Invoking guix archive): Remove documentation of '--format'. --- doc/guix.texi | 34 ++++++++-------- guix/docker.scm | 103 ++++++++++++++++++++++++++--------------------- guix/scripts/archive.scm | 31 ++------------ guix/scripts/pack.scm | 95 ++++++++++++++++++++++++++++++++++++++----- 4 files changed, 161 insertions(+), 102 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 3382ac414e..45d171c52d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2435,6 +2435,22 @@ guix pack -S /opt/gnu/bin=bin guile emacs geiser @noindent That way, users can happily type @file{/opt/gnu/bin/guile} and enjoy. +Alternatively, you can produce a pack in the Docker image format, as +described in +@uref{https://github.com/docker/docker/blob/master/image/spec/v1.2.md, +version 1.2 of the specification}. This is what the following command +does: + +@example +guix pack -f docker guile emacs geiser +@end example + +@noindent +The result is a tarball that can be passed to the @command{docker load} +command. See the +@uref{https://docs.docker.com/engine/reference/commandline/load/, Docker +documentation} for more information. + Several command-line options allow you to customize your pack: @table @code @@ -2537,7 +2553,7 @@ what you should use in this case (@pxref{Invoking guix copy}). @cindex nar, archive format @cindex normalized archive (nar) -By default archives are stored in the ``normalized archive'' or ``nar'' format, which is +Archives are stored in the ``normalized archive'' or ``nar'' format, which is comparable in spirit to `tar', but with differences that make it more appropriate for our purposes. First, rather than recording all Unix metadata for each file, the nar format only mentions @@ -2553,9 +2569,6 @@ verifies the signature and rejects the import in case of an invalid signature or if the signing key is not authorized. @c FIXME: Add xref to daemon doc about signatures. -Optionally, archives can be exported as a Docker image in the tar -archive format using @code{--format=docker}. - The main options are: @table @code @@ -2584,19 +2597,6 @@ Read a list of store file names from the standard input, one per line, and write on the standard output the subset of these files missing from the store. -@item -f -@item --format=@var{FMT} -@cindex docker, export -@cindex export format -Specify the export format. Acceptable arguments are @code{nar} and -@code{docker}. The default is the nar format. When the format is -@code{docker}, recursively export the specified store directory as a -Docker image in tar archive format, as specified in -@uref{https://github.com/docker/docker/blob/master/image/spec/v1.2.md, -version 1.2.0 of the Docker Image Specification}. Using -@code{--format=docker} implies @code{--recursive}. The generated -archive can be loaded by Docker using @command{docker load}. - @item --generate-key[=@var{parameters}] @cindex signing, archives Generate a new key pair for the daemon. This is a prerequisite before diff --git a/guix/docker.scm b/guix/docker.scm index 6dabaf25b0..56a0f7ec2b 100644 --- a/guix/docker.scm +++ b/guix/docker.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Ricardo Wurmus +;;; Copyright © 2017 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,17 +19,18 @@ (define-module (guix docker) #:use-module (guix hash) - #:use-module (guix store) #:use-module (guix base16) - #:use-module (guix utils) #:use-module ((guix build utils) #:select (delete-file-recursively with-directory-excursion)) - #:use-module (json) + #:use-module (guix build store-copy) #:use-module (rnrs bytevectors) #:use-module (ice-9 match) #:export (build-docker-image)) +;; Load Guile-JSON at run time to simplify the job of 'imported-modules' & co. +(module-use! (current-module) (resolve-interface '(json))) + ;; Generate a 256-bit identifier in hexadecimal encoding for the Docker image ;; containing the closure at PATH. (define docker-id @@ -81,48 +83,55 @@ (rootfs . ((type . "layers") (diff_ids . (,(layer-diff-id layer))))))) -(define* (build-docker-image path #:key system) - "Generate a Docker image archive from the given store PATH. The image -contains the closure of the given store item." - (let ((id (docker-id path)) +(define* (build-docker-image image path #:key closure compressor) + "Write to IMAGE a Docker image archive from the given store PATH. The image +contains the closure of PATH, as specified in CLOSURE (a file produced by +#:references-graphs). Use COMPRESSOR, a command such as '(\"gzip\" \"-9n\"), +to compress IMAGE." + (let ((directory "/tmp/docker-image") ;temporary working directory + (closure (canonicalize-path closure)) + (id (docker-id path)) (time (strftime "%FT%TZ" (localtime (current-time)))) - (name (string-append (getcwd) - "/docker-image-" (basename path) ".tar")) - (arch (match system - ("x86_64-linux" "amd64") - ("i686-linux" "386") - ("armhf-linux" "arm") - ("mips64el-linux" "mips64le")))) - (and (call-with-temporary-directory - (lambda (directory) - (with-directory-excursion directory - ;; Add symlink from /bin to /gnu/store/.../bin - (symlink (string-append path "/bin") "bin") - - (mkdir id) - (with-directory-excursion id - (with-output-to-file "VERSION" - (lambda () (display schema-version))) - (with-output-to-file "json" - (lambda () (scm->json (image-description id time)))) - - ;; Wrap it up - (let ((items (with-store store - (requisites store (list path))))) - (and (zero? (apply system* "tar" "-cf" "layer.tar" - (cons "../bin" items))) - (delete-file "../bin")))) - - (with-output-to-file "config.json" - (lambda () - (scm->json (config (string-append id "/layer.tar") - time arch)))) - (with-output-to-file "manifest.json" - (lambda () - (scm->json (manifest path id)))) - (with-output-to-file "repositories" - (lambda () - (scm->json (repositories path id))))) - (and (zero? (system* "tar" "-C" directory "-cf" name ".")) - (begin (delete-file-recursively directory) #t)))) - name))) + (arch (match (utsname:machine (uname)) + ("x86_64" "amd64") + ("i686" "386") + ("armv7l" "arm") + ("mips64" "mips64le")))) + ;; Make sure we start with a fresh, empty working directory. + (mkdir directory) + + (and (with-directory-excursion directory + ;; Add symlink from /bin to /gnu/store/.../bin + (symlink (string-append path "/bin") "bin") + + (mkdir id) + (with-directory-excursion id + (with-output-to-file "VERSION" + (lambda () (display schema-version))) + (with-output-to-file "json" + (lambda () (scm->json (image-description id time)))) + + ;; Wrap it up + (let ((items (call-with-input-file closure + read-reference-graph))) + (and (zero? (apply system* "tar" "-cf" "layer.tar" + (cons "../bin" items))) + (delete-file "../bin")))) + + (with-output-to-file "config.json" + (lambda () + (scm->json (config (string-append id "/layer.tar") + time arch)))) + (with-output-to-file "manifest.json" + (lambda () + (scm->json (manifest path id)))) + (with-output-to-file "repositories" + (lambda () + (scm->json (repositories path id))))) + + (and (zero? (apply system* "tar" "-C" directory "-cf" image + `(,@(if compressor + (list "-I" (string-join compressor)) + '()) + "."))) + (begin (delete-file-recursively directory) #t))))) diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index cad279fb50..8137455a9d 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -1,6 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès -;;; Copyright © 2017 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -45,11 +44,6 @@ #:export (guix-archive options->derivations+files)) -;; XXX: Use this hack instead of #:autoload to avoid compilation errors. -;; See . -(module-autoload! (current-module) - '(guix docker) '(build-docker-image)) - ;;; ;;; Command-line options. @@ -57,8 +51,7 @@ (define %default-options ;; Alist of default option values. - `((format . "nar") - (system . ,(%current-system)) + `((system . ,(%current-system)) (substitutes? . #t) (graft? . #t) (max-silent-time . 3600) @@ -69,8 +62,6 @@ Export/import one or more packages from/to the store.\n")) (display (_ " --export export the specified files/packages to stdout")) - (display (_ " - --format=FMT export files/packages in the specified format FMT")) (display (_ " -r, --recursive combined with '--export', include dependencies")) (display (_ " @@ -126,9 +117,6 @@ Export/import one or more packages from/to the store.\n")) (option '("export") #f #f (lambda (opt name arg result) (alist-cons 'export #t result))) - (option '(#\f "format") #t #f - (lambda (opt name arg result . rest) - (alist-cons 'format arg result))) (option '(#\r "recursive") #f #f (lambda (opt name arg result) (alist-cons 'export-recursive? #t result))) @@ -258,21 +246,8 @@ resulting archive to the standard output port." (if (or (assoc-ref opts 'dry-run?) (build-derivations store drv)) - (match (assoc-ref opts 'format) - ("nar" - (export-paths store files (current-output-port) - #:recursive? (assoc-ref opts 'export-recursive?))) - ("docker" - (match files - ((file) - (let ((system (assoc-ref opts 'system))) - (format #t "~a\n" - (build-docker-image file #:system system)))) - (x - ;; TODO: Remove this restriction. - (leave (_ "only a single item can be exported to Docker~%"))))) - (format - (leave (_ "~a: unknown archive format~%") format))) + (export-paths store files (current-output-port) + #:recursive? (assoc-ref opts 'export-recursive?)) (leave (_ "unable to export the given packages~%"))))) (define (generate-key-pair parameters) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index e422b3cdda..c6f2145c5c 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -24,6 +24,7 @@ #:use-module (guix store) #:use-module (guix grafts) #:use-module (guix monads) + #:use-module (guix modules) #:use-module (guix packages) #:use-module (guix profiles) #:use-module (guix derivations) @@ -32,6 +33,8 @@ #:use-module (gnu packages compression) #:autoload (gnu packages base) (tar) #:autoload (gnu packages package-management) (guix) + #:autoload (gnu packages gnupg) (libgcrypt) + #:autoload (gnu packages guile) (guile-json) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-37) @@ -177,6 +180,59 @@ added to the pack." build #:references-graphs `(("profile" ,profile)))) +(define* (docker-image name profile + #:key deduplicate? + (compressor (first %compressors)) + localstatedir? + (symlinks '()) + (tar tar)) + "Return a derivation to construct a Docker image of PROFILE. The +image is a tarball conforming to the Docker Image Specification, compressed +with COMPRESSOR. It can be passed to 'docker load'." + ;; FIXME: Honor SYMLINKS and LOCALSTATEDIR?. + (define not-config? + (match-lambda + (('guix 'config) #f) + (('guix rest ...) #t) + (('gnu rest ...) #t) + (rest #f))) + + (define config + ;; (guix config) module for consumption by (guix gcrypt). + (scheme-file "gcrypt-config.scm" + #~(begin + (define-module (guix config) + #:export (%libgcrypt)) + + ;; XXX: Work around . + (eval-when (expand load eval) + (define %libgcrypt + #+(file-append libgcrypt "/lib/libgcrypt")))))) + + (define build + (with-imported-modules `(,@(source-module-closure '((guix docker)) + #:select? not-config?) + ((guix config) => ,config)) + #~(begin + ;; Guile-JSON is required by (guix docker). + (add-to-load-path + (string-append #$guile-json "/share/guile/site/" + (effective-version))) + + (use-modules (guix docker)) + + (setenv "PATH" + (string-append #$tar "/bin:" + #$(compressor-package compressor) "/bin")) + + (build-docker-image #$output #$profile + #:closure "profile" + #:compressor '#$(compressor-command compressor))))) + + (gexp->derivation (string-append name ".tar." + (compressor-extension compressor)) + build + #:references-graphs `(("profile" ,profile)))) ;;; @@ -185,7 +241,8 @@ added to the pack." (define %default-options ;; Alist of default option values. - `((system . ,(%current-system)) + `((format . tarball) + (system . ,(%current-system)) (substitutes? . #t) (graft? . #t) (max-silent-time . 3600) @@ -193,6 +250,11 @@ added to the pack." (symlinks . ()) (compressor . ,(first %compressors)))) +(define %formats + ;; Supported pack formats. + `((tarball . ,self-contained-tarball) + (docker . ,docker-image))) + (define %options ;; Specifications of the command-line options. (cons* (option '(#\h "help") #f #f @@ -206,6 +268,9 @@ added to the pack." (option '(#\n "dry-run") #f #f (lambda (opt name arg result) (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) + (option '(#\f "format") #t #f + (lambda (opt name arg result) + (alist-cons 'format (string->symbol arg) result))) (option '(#\s "system") #t #f (lambda (opt name arg result) (alist-cons 'system arg @@ -242,6 +307,8 @@ Create a bundle of PACKAGE.\n")) (show-transformation-options-help) (newline) (display (_ " + -f, --format=FORMAT build a pack in the given FORMAT")) + (display (_ " -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) (display (_ " -C, --compression=TOOL compress using TOOL--e.g., \"lzip\"")) @@ -280,8 +347,16 @@ Create a bundle of PACKAGE.\n")) (specification->package+output spec)) list)) specs)) - (compressor (assoc-ref opts 'compressor)) - (symlinks (assoc-ref opts 'symlinks)) + (pack-format (assoc-ref opts 'format)) + (name (string-append (symbol->string pack-format) + "-pack")) + (compressor (assoc-ref opts 'compressor)) + (symlinks (assoc-ref opts 'symlinks)) + (build-image (match (assq-ref %formats pack-format) + ((? procedure? proc) proc) + (#f + (leave (_ "~a: unknown pack format") + format)))) (localstatedir? (assoc-ref opts 'localstatedir?))) (with-store store ;; Set the build options before we do anything else. @@ -290,13 +365,13 @@ Create a bundle of PACKAGE.\n")) (run-with-store store (mlet* %store-monad ((profile (profile-derivation (packages->manifest packages))) - (drv (self-contained-tarball "pack" profile - #:compressor - compressor - #:symlinks - symlinks - #:localstatedir? - localstatedir?))) + (drv (build-image name profile + #:compressor + compressor + #:symlinks + symlinks + #:localstatedir? + localstatedir?))) (mbegin %store-monad (show-what-to-build* (list drv) #:use-substitutes? -- cgit v1.2.3 From 84dda5a9c0772b2507fab3209938ead9da2a3442 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 16 Mar 2017 21:41:38 +0100 Subject: pack: Use a fixed timestamp in Docker images. * guix/docker.scm (build-docker-image): Add #:creation-time parameter. Use SRFI-19 'date->string' instead of 'strftime' et al. * guix/scripts/pack.scm (docker-image)[build]: Pass #:creation-time to 'build-docker-image'. --- guix/docker.scm | 10 +++++++--- guix/scripts/pack.scm | 5 +++-- 2 files changed, 10 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/guix/docker.scm b/guix/docker.scm index 56a0f7ec2b..5614ab2115 100644 --- a/guix/docker.scm +++ b/guix/docker.scm @@ -24,6 +24,7 @@ #:select (delete-file-recursively with-directory-excursion)) #:use-module (guix build store-copy) + #:use-module (srfi srfi-19) #:use-module (rnrs bytevectors) #:use-module (ice-9 match) #:export (build-docker-image)) @@ -83,15 +84,18 @@ (rootfs . ((type . "layers") (diff_ids . (,(layer-diff-id layer))))))) -(define* (build-docker-image image path #:key closure compressor) +(define* (build-docker-image image path + #:key closure compressor + (creation-time (current-time time-utc))) "Write to IMAGE a Docker image archive from the given store PATH. The image contains the closure of PATH, as specified in CLOSURE (a file produced by #:references-graphs). Use COMPRESSOR, a command such as '(\"gzip\" \"-9n\"), -to compress IMAGE." +to compress IMAGE. Use CREATION-TIME, a SRFI-19 time-utc object, as the +creation time in metadata." (let ((directory "/tmp/docker-image") ;temporary working directory (closure (canonicalize-path closure)) (id (docker-id path)) - (time (strftime "%FT%TZ" (localtime (current-time)))) + (time (date->string (time-utc->date creation-time) "~4")) (arch (match (utsname:machine (uname)) ("x86_64" "amd64") ("i686" "386") diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index c6f2145c5c..694b2f2aee 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -219,7 +219,7 @@ with COMPRESSOR. It can be passed to 'docker load'." (string-append #$guile-json "/share/guile/site/" (effective-version))) - (use-modules (guix docker)) + (use-modules (guix docker) (srfi srfi-19)) (setenv "PATH" (string-append #$tar "/bin:" @@ -227,7 +227,8 @@ with COMPRESSOR. It can be passed to 'docker load'." (build-docker-image #$output #$profile #:closure "profile" - #:compressor '#$(compressor-command compressor))))) + #:compressor '#$(compressor-command compressor) + #:creation-time (make-time time-utc 0 1))))) (gexp->derivation (string-append name ".tar." (compressor-extension compressor)) -- cgit v1.2.3 From 54241dc8e62c8616dcd72effe816e6e570607055 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 16 Mar 2017 21:56:10 +0100 Subject: docker: Build images in a reproducible fashion. * guix/docker.scm (%tar-determinism-options): New variable. (build-docker-image): Use it on the two 'tar' invocations. --- guix/docker.scm | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/docker.scm b/guix/docker.scm index 5614ab2115..9b7a28f6f3 100644 --- a/guix/docker.scm +++ b/guix/docker.scm @@ -84,6 +84,11 @@ (rootfs . ((type . "layers") (diff_ids . (,(layer-diff-id layer))))))) +(define %tar-determinism-options + ;; GNU tar options to produce archives deterministically. + '("--sort=name" "--mtime=@1" + "--owner=root:0" "--group=root:0")) + (define* (build-docker-image image path #:key closure compressor (creation-time (current-time time-utc))) @@ -119,7 +124,8 @@ creation time in metadata." (let ((items (call-with-input-file closure read-reference-graph))) (and (zero? (apply system* "tar" "-cf" "layer.tar" - (cons "../bin" items))) + (append %tar-determinism-options + (cons "../bin" items)))) (delete-file "../bin")))) (with-output-to-file "config.json" @@ -134,7 +140,8 @@ creation time in metadata." (scm->json (repositories path id))))) (and (zero? (apply system* "tar" "-C" directory "-cf" image - `(,@(if compressor + `(,@%tar-determinism-options + ,@(if compressor (list "-I" (string-join compressor)) '()) "."))) -- cgit v1.2.3 From 9e84ea3673f77ebe5c5e9ce39fbcdb6d7bc8a06f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 16 Mar 2017 22:40:06 +0100 Subject: pack: Honor symlinks in the Docker back-end. * guix/docker.scm (symlink-source, topmost-component): New procedures. (build-docker-image): Add #:symlinks parameter and honor it. Remove hard-coded /bin symlink. * guix/scripts/pack.scm (docker-image): Pass #:symlinks to 'build-docker-image'. --- guix/docker.scm | 46 ++++++++++++++++++++++++++++++++++++---------- guix/scripts/pack.scm | 3 ++- 2 files changed, 38 insertions(+), 11 deletions(-) (limited to 'guix') diff --git a/guix/docker.scm b/guix/docker.scm index 9b7a28f6f3..290ad3dcf1 100644 --- a/guix/docker.scm +++ b/guix/docker.scm @@ -21,7 +21,8 @@ #:use-module (guix hash) #:use-module (guix base16) #:use-module ((guix build utils) - #:select (delete-file-recursively + #:select (mkdir-p + delete-file-recursively with-directory-excursion)) #:use-module (guix build store-copy) #:use-module (srfi srfi-19) @@ -89,14 +90,30 @@ '("--sort=name" "--mtime=@1" "--owner=root:0" "--group=root:0")) +(define symlink-source + (match-lambda + ((source '-> target) + (string-trim source #\/)))) + +(define (topmost-component file) + "Return the topmost component of FILE. For instance, if FILE is \"/a/b/c\", +return \"a\"." + (match (string-tokenize file (char-set-complement (char-set #\/))) + ((first rest ...) + first))) + (define* (build-docker-image image path #:key closure compressor + (symlinks '()) (creation-time (current-time time-utc))) "Write to IMAGE a Docker image archive from the given store PATH. The image contains the closure of PATH, as specified in CLOSURE (a file produced by -#:references-graphs). Use COMPRESSOR, a command such as '(\"gzip\" \"-9n\"), -to compress IMAGE. Use CREATION-TIME, a SRFI-19 time-utc object, as the -creation time in metadata." +#:references-graphs). SYMLINKS must be a list of (SOURCE -> TARGET) tuples +describing symlinks to be created in the image, where each TARGET is relative +to PATH. + +Use COMPRESSOR, a command such as '(\"gzip\" \"-9n\"), to compress IMAGE. Use +CREATION-TIME, a SRFI-19 time-utc object, as the creation time in metadata." (let ((directory "/tmp/docker-image") ;temporary working directory (closure (canonicalize-path closure)) (id (docker-id path)) @@ -110,9 +127,6 @@ creation time in metadata." (mkdir directory) (and (with-directory-excursion directory - ;; Add symlink from /bin to /gnu/store/.../bin - (symlink (string-append path "/bin") "bin") - (mkdir id) (with-directory-excursion id (with-output-to-file "VERSION" @@ -120,13 +134,25 @@ creation time in metadata." (with-output-to-file "json" (lambda () (scm->json (image-description id time)))) - ;; Wrap it up + ;; Wrap it up. (let ((items (call-with-input-file closure read-reference-graph))) + ;; Create SYMLINKS. + (for-each (match-lambda + ((source '-> target) + (let ((source (string-trim source #\/))) + (mkdir-p (dirname source)) + (symlink (string-append path "/" target) + source)))) + symlinks) + (and (zero? (apply system* "tar" "-cf" "layer.tar" (append %tar-determinism-options - (cons "../bin" items)))) - (delete-file "../bin")))) + items + (map symlink-source symlinks)))) + (for-each delete-file-recursively + (map (compose topmost-component symlink-source) + symlinks))))) (with-output-to-file "config.json" (lambda () diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 694b2f2aee..edeb82fafd 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -189,7 +189,7 @@ added to the pack." "Return a derivation to construct a Docker image of PROFILE. The image is a tarball conforming to the Docker Image Specification, compressed with COMPRESSOR. It can be passed to 'docker load'." - ;; FIXME: Honor SYMLINKS and LOCALSTATEDIR?. + ;; FIXME: Honor LOCALSTATEDIR?. (define not-config? (match-lambda (('guix 'config) #f) @@ -227,6 +227,7 @@ with COMPRESSOR. It can be passed to 'docker load'." (build-docker-image #$output #$profile #:closure "profile" + #:symlinks '#$symlinks #:compressor '#$(compressor-command compressor) #:creation-time (make-time time-utc 0 1))))) -- cgit v1.2.3 From db3f2b61adfe56d69029ec5f6d962462a50a1f33 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 16 Mar 2017 22:46:43 +0100 Subject: pack: Allow for "-S /opt/foo=". Reported by Andy Wingo. * guix/scripts/pack.scm (%options): Use 'string-split' instead of 'string-tokenize'. --- guix/scripts/pack.scm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index edeb82fafd..74d4ee6d4d 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -283,9 +283,10 @@ with COMPRESSOR. It can be passed to 'docker load'." result))) (option '(#\S "symlink") #t #f (lambda (opt name arg result) - (match (string-tokenize arg - (char-set-complement - (char-set #\=))) + ;; Note: Using 'string-split' allows us to handle empty + ;; TARGET (as in "/opt/guile=", meaning that /opt/guile is + ;; a symlink to the profile) correctly. + (match (string-split arg (char-set #\=)) ((source target) (let ((symlinks (assoc-ref result 'symlinks))) (alist-cons 'symlinks -- cgit v1.2.3 From aeb64f3cb295f63ecea772716c5576cfd8223dd8 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Sun, 12 Mar 2017 00:21:39 +0100 Subject: gnu: r: Do not build recommended packages. * gnu/packages/statistics.scm (r)[arguments]: Rename phase "build-recommended-packages-reproducibly" to "build-reproducibly"; add configure flag "--without-recommended-packages". * guix/import/cran.scm (default-r-packages): Remove recommended packages. * gnu/packages/python.scm (python-rpy2)[inputs]: Add r-survival. * gnu/packages/bioinformatics.scm (r-ape)[propagated-inputs]: Add r-lattice and r-nlme. (r-vegan)[propagated-inputs]: Add r-mass. (r-genefilter)[propagated-inputs]: Add r-survival. (r-grohmm)[propagated-inputs]: Add r-mass. (r-bioccheck)[propagated-inputs]: Add r-codetools. (r-summarizedexperiment)[propagated-inputs]: Add r-matrix. (r-topgo)[propagated-inputs]: Add r-lattice. (r-sva)[propagated-inputs]: Add r-mgcv. (r-raremetals2)[propagated-inputs]: Add r-mass. (r-vsn)[propagated-inputs]: Add r-lattice. (r-pcamethods)[propagated-inputs]: Add r-mass. * gnu/packages/bioinformatics.scm (r-ggplot2)[propagated-inputs]: Add r-mass. (r-locfit)[propagated-inputs]: Add r-lattice. (r-coda)[propagated-inputs]: Add r-lattice. (r-irlba)[propagated-inputs]: Add r-matrix. (r-glmnet)[propagated-inputs]: Add r-matrix. (r-e1071)[propagated-inputs]: Add r-class. (r-spams)[propagated-inputs]: Add r-lattice and r-matrix. (r-hmisc)[propagated-inputs]: Add r-cluster, r-foreign, r-lattice, r-nnet, and r-rpart. (r-zoo)[propagated-inputs]: Add r-lattice. (r-mixtools)[propagated-inputs]: Add r-boot and r-mass. (r-flexmix)[propagated-inputs]: Add r-lattice and r-nnet. (r-prabclus)[propagated-inputs]: Add r-mass. (r-fpc)[propagated-inputs]: Add r-class, r-cluster, and r-mass. (r-rcppeigen)[propagated-inputs]: Add r-matrix. (r-matrixmodels)[propagated-inputs]: Add r-matrix. (r-lme4)[propagated-inputs]: Add r-mass and r-nlme. (r-pbkrtest)[propagated-inputs]: Add r-mass and r-matrix. (r-car)[propagated-inputs]: Add r-mass, r-mgcv, and r-nnet. (r-tclust)[propagated-inputs]: Add r-cluster. --- gnu/packages/bioinformatics.scm | 21 +++++++++-- gnu/packages/python.scm | 3 +- gnu/packages/statistics.scm | 83 ++++++++++++++++++++++++++++++----------- guix/import/cran.scm | 18 +-------- 4 files changed, 82 insertions(+), 43 deletions(-) (limited to 'guix') diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm index 077f9b2885..bd3c97b721 100644 --- a/gnu/packages/bioinformatics.scm +++ b/gnu/packages/bioinformatics.scm @@ -108,6 +108,9 @@ (base32 "0959fiiy11rzfzrzaknmgrx64bhszj02l0ycz79k5a6bmpfzanlk")))) (build-system r-build-system) + (propagated-inputs + `(("r-lattice" ,r-lattice) + ("r-nlme" ,r-nlme))) (home-page "http://ape-package.ird.fr/") (synopsis "Analyses of phylogenetics and evolution") (description @@ -5353,6 +5356,7 @@ information as possible.") (propagated-inputs `(("r-cluster" ,r-cluster) ("r-lattice" ,r-lattice) + ("r-mass" ,r-mass) ("r-mgcv" ,r-mgcv) ("r-permute" ,r-permute))) (home-page "https://cran.r-project.org/web/packages/vegan") @@ -5434,7 +5438,8 @@ microarrays.") `(("r-annotate" ,r-annotate) ("r-annotationdbi" ,r-annotationdbi) ("r-biobase" ,r-biobase) - ("r-s4vectors" ,r-s4vectors))) + ("r-s4vectors" ,r-s4vectors) + ("r-survival" ,r-survival))) (home-page "http://bioconductor.org/packages/genefilter") (synopsis "Filter genes from high-throughput experiments") (description @@ -5732,6 +5737,7 @@ annotation infrastructure.") ("r-genomicalignments" ,r-genomicalignments) ("r-genomicranges" ,r-genomicranges) ("r-iranges" ,r-iranges) + ("r-mass" ,r-mass) ("r-rtracklayer" ,r-rtracklayer) ("r-s4vectors" ,r-s4vectors))) (home-page "https://github.com/Kraus-Lab/groHMM") @@ -6131,7 +6137,8 @@ functionality.") (native-inputs `(("which" ,which))) (propagated-inputs - `(("r-graph" ,r-graph) + `(("r-codetools" ,r-codetools) + ("r-graph" ,r-graph) ("r-knitr" ,r-knitr) ("r-httr" ,r-httr) ("r-optparse" ,r-optparse) @@ -6659,6 +6666,7 @@ files.") ("r-genomeinfodb" ,r-genomeinfodb) ("r-genomicranges" ,r-genomicranges) ("r-iranges" ,r-iranges) + ("r-matrix" ,r-matrix) ("r-s4vectors" ,r-s4vectors))) (home-page "http://bioconductor.org/packages/SummarizedExperiment") (synopsis "Container for representing genomic ranges by sample") @@ -6850,8 +6858,9 @@ information about the latest version of the Gene Ontologies.") ("r-biobase" ,r-biobase) ("r-biocgenerics" ,r-biocgenerics) ("r-go-db" ,r-go-db) - ("r-matrixstats" ,r-matrixstats) ("r-graph" ,r-graph) + ("r-lattice" ,r-lattice) + ("r-matrixstats" ,r-matrixstats) ("r-sparsem" ,r-sparsem))) (home-page "http://bioconductor.org/packages/topGO") (synopsis "Enrichment analysis for gene ontology") @@ -8243,7 +8252,8 @@ number detection tools.") "1wc1fjm6dzlsqqagm43y57w8jh8nsh0r0m8z1p6ximcb5gxqh7hn")))) (build-system r-build-system) (propagated-inputs - `(("r-genefilter" ,r-genefilter))) + `(("r-genefilter" ,r-genefilter) + ("r-mgcv" ,r-mgcv))) (home-page "http://bioconductor.org/packages/sva") (synopsis "Surrogate variable analysis") (description @@ -8295,6 +8305,7 @@ data (variant call format, e.g. VCF or BCF) or meta-analysis results in R.") (propagated-inputs `(("r-seqminer" ,r-seqminer) ("r-mvtnorm" ,r-mvtnorm) + ("r-mass" ,r-mass) ("r-compquadform" ,r-compquadform) ("r-getopt" ,r-getopt))) (home-page "http://genome.sph.umich.edu/wiki/RareMETALS2") @@ -8453,6 +8464,7 @@ analysis.") `(("r-affy" ,r-affy) ("r-biobase" ,r-biobase) ("r-ggplot2" ,r-ggplot2) + ("r-lattice" ,r-lattice) ("r-limma" ,r-limma))) (home-page "http://bioconductor.org/packages/release/bioc/html/vsn.html") (synopsis "Variance stabilization and calibration for microarray data") @@ -8516,6 +8528,7 @@ specific parser.") (propagated-inputs `(("r-biobase" ,r-biobase) ("r-biocgenerics" ,r-biocgenerics) + ("r-mass" ,r-mass) ("r-rcpp" ,r-rcpp))) (home-page "https://github.com/hredestig/pcamethods") (synopsis "Collection of PCA methods") diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 5706218f15..ba3c7d4c36 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -4085,7 +4085,8 @@ operators such as union, intersection, and difference.") `(("readline" ,readline) ("icu4c" ,icu4c) ("pcre" ,pcre) - ("r" ,r))) + ("r" ,r) + ("r-survival" ,r-survival))) (native-inputs `(("zlib" ,zlib))) (home-page "http://rpy.sourceforge.net/") diff --git a/gnu/packages/statistics.scm b/gnu/packages/statistics.scm index c836409b61..b8abbf62db 100644 --- a/gnu/packages/statistics.scm +++ b/gnu/packages/statistics.scm @@ -99,6 +99,9 @@ can be imported from spreadsheets, text files and database sources and it can be output in text, PostScript, PDF or HTML.") (license license:gpl3+))) +;; Update this package together with the set of recommended packages: r-boot, +;; r-class, r-cluster, r-codetools, r-foreign, r-kernsmooth, r-lattice, +;; r-mass, r-matrix, r-mgcv, r-nlme, r-nnet, r-rpart, r-spatial, r-survival. (define-public r (package (name "r") @@ -128,12 +131,8 @@ be output in text, PostScript, PDF or HTML.") (substitute* "src/scripts/R.sh.in" (("uname") uname-bin))) #t)) - (add-after 'unpack 'build-recommended-packages-reproducibly + (add-after 'unpack 'build-reproducibly (lambda _ - (substitute* "src/library/Recommended/Makefile.in" - (("INSTALL_OPTS =(.*)" line rest ) - (string-append "INSTALL_OPTS = --built-timestamp=1970-01-01" - rest))) ;; Ensure that gzipped files are reproducible (substitute* '("src/library/grDevices/Makefile.in" "doc/manual/Makefile.in") @@ -162,7 +161,12 @@ be output in text, PostScript, PDF or HTML.") (add-after 'build 'install-info (lambda _ (zero? (system* "make" "install-info"))))) #:configure-flags - '("--with-cairo" + '(;; Do not build the recommended packages. The build system creates + ;; random temporary directories and embeds their names in some + ;; package files. We build these packages with the r-build-system + ;; instead. + "--without-recommended-packages" + "--with-cairo" "--with-blas=-lopenblas" "--with-libpng" "--with-jpeglib" @@ -991,6 +995,7 @@ legends.") ("r-gtable" ,r-gtable) ("r-plyr" ,r-plyr) ("r-lazyeval" ,r-lazyeval) + ("r-mass" ,r-mass) ("r-tibble" ,r-tibble) ("r-reshape2" ,r-reshape2) ("r-scales" ,r-scales) @@ -1611,6 +1616,8 @@ side.") (base32 "0lafrmq1q7x026m92h01hc9cjjiximqqi3v1g2hw7ai9vf7i897m")))) (build-system r-build-system) + (propagated-inputs + `(("r-lattice" ,r-lattice))) (home-page "http://cran.r-project.org/web/packages/locfit") (synopsis "Local regression, likelihood and density estimation") (description @@ -1788,6 +1795,8 @@ inference for statistical models.") (base32 "14a4a8df4ygj05h37chmdn8kzcqs07fpbflxfrq530563mrza7yl")))) (build-system r-build-system) + (propagated-inputs + `(("r-lattice" ,r-lattice))) (home-page "http://cran.r-project.org/web/packages/coda") (synopsis "This is a package for Output Analysis and Diagnostics for MCMC") (description "This package provides functions for summarizing and plotting @@ -2936,6 +2945,8 @@ flexible than the orphaned \"base64\" package.") (base32 "1qbcn0ix85pmk296jhpi419kvh06vxm5cq24yk013ps3g7fyi0si")))) (build-system r-build-system) + (propagated-inputs + `(("r-matrix" ,r-matrix))) (home-page "http://cran.r-project.org/web/packages/irlba") (synopsis "Methods for eigendecomposition of large matrices") (description @@ -2956,10 +2967,11 @@ analysis of large sparse or dense matrices.") (base32 "1cbpzmbv837fvq88rgn6mgzgr9f1wqp9fg8gh2kkmngvr1957a9c")))) (build-system r-build-system) - (inputs - `(("gfortran" ,gfortran))) + (inputs + `(("gfortran" ,gfortran))) (propagated-inputs - `(("r-foreach" ,r-foreach))) + `(("r-foreach" ,r-foreach) + ("r-matrix" ,r-matrix))) (home-page "http://www.jstatsoft.org/v33/i01") (synopsis "Lasso and elastic-net regularized generalized linear models") (description @@ -3077,6 +3089,8 @@ Stochastic Neighbor Embedding using a Barnes-Hut implementation.") (base32 "1069qwj9gsjq6par2cgfah8nn5x2w38830761x1f7mqpmk0gnj3h")))) (build-system r-build-system) + (propagated-inputs + `(("r-class" ,r-class))) (home-page "http://cran.r-project.org/web/packages/e1071") (synopsis "Miscellaneous functions for probability theory") (description @@ -3688,6 +3702,9 @@ from within R.") (("if isnan\\(lambda\\) \\{") "if (isnan(lambda)) {")) #t))))) + (propagated-inputs + `(("r-lattice" ,r-lattice) + ("r-matrix" ,r-matrix))) (home-page "http://spams-devel.gforge.inria.fr") (synopsis "Toolbox for solving sparse estimation problems") (description "SPAMS (SPArse Modeling Software) is an optimization toolbox @@ -3746,17 +3763,20 @@ package instead.") `(("r-acepack" ,r-acepack) ("r-base64" ,r-base64) ("r-base64enc" ,r-base64enc) + ("r-cluster" ,r-cluster) ("r-data-table" ,r-data-table) + ("r-foreign" ,r-foreign) ("r-formula" ,r-formula) ("r-ggplot2" ,r-ggplot2) ("r-gridextra" ,r-gridextra) ("r-gtable" ,r-gtable) - ;; Hmisc needs survival >= 2.40.1, so it cannot use the survival - ;; package that comes with R 3.3.2. - ("r-survival" ,r-survival) + ("r-lattice" ,r-lattice) ("r-latticeextra" ,r-latticeextra) ("r-htmltable" ,r-htmltable) ("r-htmltools" ,r-htmltools) + ("r-nnet" ,r-nnet) + ("r-rpart" ,r-rpart) + ("r-survival" ,r-survival) ("r-viridis" ,r-viridis))) (home-page "http://biostat.mc.vanderbilt.edu/Hmisc") (synopsis "Miscellaneous data analysis and graphics functions") @@ -4041,6 +4061,8 @@ estimation) corresponding to the book: Wand, M.P. and Jones, M.C. (1995) (base32 "167m142rwwfy8b9hnfc3fi28dcsdjk61g1crqhll6sh5xmgnfn28")))) (build-system r-build-system) + (propagated-inputs + `(("r-lattice" ,r-lattice))) (home-page "http://zoo.R-Forge.R-project.org/") (synopsis "S3 infrastructure for regular and irregular time series") (description "This package contains an S3 class with methods for totally @@ -4307,7 +4329,9 @@ letters, as is often required for scientific publications.") "133rr17ywmlhsc6457hs8qxi8ng443ql9ashxpwc8875gjhv1x32")))) (build-system r-build-system) (propagated-inputs - `(("r-segmented" ,r-segmented))) + `(("r-boot" ,r-boot) + ("r-mass" ,r-mass) + ("r-segmented" ,r-segmented))) (home-page "http://cran.r-project.org/web/packages/mixtools") (synopsis "Tools for analyzing finite mixture models") (description @@ -4437,7 +4461,9 @@ to change in the future.") "1i205yw3kkxs27gqcs6zx0c2mh16p332a2p06wq6fdzb20bazg3z")))) (build-system r-build-system) (propagated-inputs - `(("r-modeltools" ,r-modeltools))) + `(("r-lattice" ,r-lattice) + ("r-modeltools" ,r-modeltools) + ("r-nnet" ,r-nnet))) (home-page "http://cran.r-project.org/web/packages/flexmix") (synopsis "Flexible mixture modeling") (description @@ -4484,7 +4510,8 @@ and resampling-based inference.") "0qjsxrx6yv338bxm4ki0w9h8hind1l98abdrz828588bwj02jya1")))) (build-system r-build-system) (propagated-inputs - `(("r-mclust" ,r-mclust))) + `(("r-mass" ,r-mass) + ("r-mclust" ,r-mclust))) (home-page "https://cran.r-project.org/web/packages/prabclus") (synopsis "Parametric bootstrap tests for spatial neighborhood clustering") (description @@ -4573,9 +4600,12 @@ of the points.") "15m0p9l9w2v7sl0cnzyg81i2fmx3hrhvr3371544mwn3fpsca5sx")))) (build-system r-build-system) (propagated-inputs - `(("r-diptest" ,r-diptest) + `(("r-class" ,r-class) + ("r-cluster" ,r-cluster) + ("r-diptest" ,r-diptest) ("r-flexmix" ,r-flexmix) ("r-kernlab" ,r-kernlab) + ("r-mass" ,r-mass) ("r-mclust" ,r-mclust) ("r-mvtnorm" ,r-mvtnorm) ("r-prabclus" ,r-prabclus) @@ -4694,7 +4724,8 @@ based on an interface to Fortran implementations by M. J. D. Powell.") (properties `((upstream-name . "RcppEigen"))) (build-system r-build-system) (propagated-inputs - `(("r-rcpp" ,r-rcpp))) + `(("r-rcpp" ,r-rcpp) + ("r-matrix" ,r-matrix))) (home-page "http://eigen.tuxfamily.org") (synopsis "Rcpp integration for the Eigen templated linear algebra library") (description @@ -4739,6 +4770,8 @@ metrics for evaluating models.") "0cyfvhci2p1vr2x52ymkyqqs63x1qchn856dh2j94yb93r08x1zy")))) (properties `((upstream-name . "MatrixModels"))) (build-system r-build-system) + (propagated-inputs + `(("r-matrix" ,r-matrix))) (home-page "https://cran.r-project.org/web/packages/MatrixModels") (synopsis "Modelling with sparse and dense matrices") (description @@ -4816,7 +4849,9 @@ algorithms.") ("r-rcppeigen" ,r-rcppeigen))) (propagated-inputs `(("r-minqa" ,r-minqa) - ("r-nloptr" ,r-nloptr))) + ("r-nloptr" ,r-nloptr) + ("r-mass" ,r-mass) + ("r-nlme" ,r-nlme))) (home-page "http://cran.r-project.org/web/packages/lme4") (synopsis "Linear mixed-effects models using eigen and S4") (description @@ -4839,7 +4874,9 @@ C++ library for numerical linear algebra and RcppEigen glue.") "00cw18q7wvddzjrbxz917wkix6r7672vi2wmsp4gwgzady8vha4x")))) (build-system r-build-system) (propagated-inputs - `(("r-lme4" ,r-lme4))) + `(("r-lme4" ,r-lme4) + ("r-mass" ,r-mass) + ("r-matrix" ,r-matrix))) (home-page "http://people.math.aau.dk/~sorenh/software/pbkrtest/") (synopsis "Methods for linear mixed model comparison") (description @@ -4861,7 +4898,10 @@ bootstrap test for generalized linear mixed models.") "0a6v7rsd1xsdyapnfqy37m7c4kx9wslkzsizc9k0lmnba0bwyfgx")))) (build-system r-build-system) (propagated-inputs - `(("r-pbkrtest" ,r-pbkrtest) + `(("r-mass" ,r-mass) + ("r-mgcv" ,r-mgcv) + ("r-nnet" ,r-nnet) + ("r-pbkrtest" ,r-pbkrtest) ("r-quantreg" ,r-quantreg))) (home-page "https://r-forge.r-project.org/projects/car/") (synopsis "Companion to applied regression") @@ -5000,7 +5040,8 @@ multivariate case.") "0a1b7yp4l9wf6ic5czizyl2cnxrc1virj0icr8i6m1vv23jd8jfp")))) (build-system r-build-system) (propagated-inputs - `(("r-mclust" ,r-mclust) + `(("r-cluster" ,r-cluster) + ("r-mclust" ,r-mclust) ("r-mvtnorm" ,r-mvtnorm) ("r-sn" ,r-sn))) (home-page "http://cran.r-project.org/web/packages/tclust") diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 40cdea029b..7521a39bc9 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -164,32 +164,16 @@ empty list when the FIELD cannot be found." (map string-trim-both items)))))) (define default-r-packages - (list "KernSmooth" - "MASS" - "Matrix" - "base" - "boot" - "class" - "cluster" - "codetools" + (list "base" "compiler" - "datasets" - "foreign" "grDevices" "graphics" "grid" - "lattice" "methods" - "mgcv" - "nlme" - "nnet" "parallel" - "rpart" - "spatial" "splines" "stats" "stats4" - "survival" "tcltk" "tools" "translations" -- cgit v1.2.3 From 2d7c4ae3ee83841ef827a160b0d23c1d10d2570d Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 17 Mar 2017 09:42:22 +0100 Subject: gnu: r: Rename to r-minimal. * gnu/packages/statistics.scm (r): Rename to... (r-minimal): ...this new variable. (r-with-recommended-packages): Rename to... (r): ...this. * guix/build-system/r.scm (default-r): Reference r-minimal. * gnu/packages/emacs.scm (emacs-ess)[inputs], gnu/packages/machine-learning.scm (shogun)[inputs], gnu/packages/python.scm (python-rpy2)[inputs], gnu/packages/bioinformatics.scm (ribotaper)[inputs], (couger)[propagated-inputs], (roary)[inputs], (rsem)[inputs], (rcas-web)[inputs]: Change "r" to "r-minimal". --- gnu/packages/bioinformatics.scm | 10 +++++----- gnu/packages/emacs.scm | 2 +- gnu/packages/machine-learning.scm | 2 +- gnu/packages/python.scm | 2 +- gnu/packages/statistics.scm | 12 ++++++------ guix/build-system/r.scm | 2 +- 6 files changed, 15 insertions(+), 15 deletions(-) (limited to 'guix') diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm index bd3c97b721..ccde01b119 100644 --- a/gnu/packages/bioinformatics.scm +++ b/gnu/packages/bioinformatics.scm @@ -478,7 +478,7 @@ BED, GFF/GTF, VCF.") (inputs `(("bedtools" ,bedtools-2.18) ("samtools" ,samtools-0.1) - ("r" ,r) + ("r-minimal" ,r-minimal) ("r-foreach" ,r-foreach) ("r-xnomial" ,r-xnomial) ("r-domc" ,r-domc) @@ -1728,7 +1728,7 @@ gene predictor designed to work with assembled, aligned RNA-seq transcripts.") ("python2-scipy" ,python2-scipy) ("python2-matplotlib" ,python2-matplotlib))) (propagated-inputs - `(("r" ,r) + `(("r-minimal" ,r-minimal) ("libsvm" ,libsvm) ("randomjungle" ,randomjungle))) (native-inputs @@ -4004,7 +4004,7 @@ partial genes, and identifies translation initiation sites.") ("grep" ,grep) ("sed" ,sed) ("gawk" ,gawk) - ("r" ,r) + ("r-minimal" ,r-minimal) ("r-ggplot2" ,r-ggplot2) ("coreutils" ,coreutils))) (home-page "http://sanger-pathogens.github.io/Roary") @@ -4119,7 +4119,7 @@ phylogenies.") (inputs `(("boost" ,boost) ("ncurses" ,ncurses) - ("r" ,r) + ("r-minimal" ,r-minimal) ("perl" ,perl) ("samtools" ,samtools-0.1) ("zlib" ,zlib))) @@ -7636,7 +7636,7 @@ library implementing most of the pipeline's features.") `("R_LIBS_SITE" ":" = (,(getenv "R_LIBS_SITE"))))) #t))))) (inputs - `(("r" ,r) + `(("r-minimal" ,r-minimal) ("r-rcas" ,r-rcas) ("guile-next" ,guile-next) ("guile-json" ,guile2.2-json) diff --git a/gnu/packages/emacs.scm b/gnu/packages/emacs.scm index c6e62acb7a..18d25b743b 100644 --- a/gnu/packages/emacs.scm +++ b/gnu/packages/emacs.scm @@ -2924,7 +2924,7 @@ E-Prime forbids the use of the \"to be\" form to strengthen your writing.") (string-append "SHELL = " (which "sh"))))))))) (inputs `(("emacs" ,emacs-minimal) - ("r" ,r))) + ("r-minimal" ,r-minimal))) (native-inputs `(("perl" ,perl) ("texinfo" ,texinfo) diff --git a/gnu/packages/machine-learning.scm b/gnu/packages/machine-learning.scm index 73c78744f8..5379893b76 100644 --- a/gnu/packages/machine-learning.scm +++ b/gnu/packages/machine-learning.scm @@ -402,7 +402,7 @@ sample proximities between pairs of cases.") (inputs `(("python" ,python) ("numpy" ,python-numpy) - ("r" ,r) + ("r-minimal" ,r-minimal) ("octave" ,octave) ("swig" ,swig) ("hdf5" ,hdf5) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index ba3c7d4c36..6c91401e22 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -4085,7 +4085,7 @@ operators such as union, intersection, and difference.") `(("readline" ,readline) ("icu4c" ,icu4c) ("pcre" ,pcre) - ("r" ,r) + ("r-minimal" ,r-minimal) ("r-survival" ,r-survival))) (native-inputs `(("zlib" ,zlib))) diff --git a/gnu/packages/statistics.scm b/gnu/packages/statistics.scm index 656895273f..3a26e23053 100644 --- a/gnu/packages/statistics.scm +++ b/gnu/packages/statistics.scm @@ -103,9 +103,9 @@ be output in text, PostScript, PDF or HTML.") ;; Update this package together with the set of recommended packages: r-boot, ;; r-class, r-cluster, r-codetools, r-foreign, r-kernsmooth, r-lattice, ;; r-mass, r-matrix, r-mgcv, r-nlme, r-nnet, r-rpart, r-spatial, r-survival. -(define-public r +(define-public r-minimal (package - (name "r") + (name "r-minimal") (version "3.3.3") (source (origin (method url-fetch) @@ -538,14 +538,14 @@ definition of Surv objects, Kaplan-Meier and Aalen-Johansen (multi-state) curves, Cox models, and parametric accelerated failure time models.") (license license:lgpl2.0+))) -(define-public r-with-recommended-packages - (package (inherit r) - (name "r-with-recommended-packages") +(define-public r + (package (inherit r-minimal) + (name "r") (source #f) (build-system trivial-build-system) (arguments '(#:builder (mkdir %output))) (propagated-inputs - `(("r" ,r) + `(("r-minimal" ,r-minimal) ("r-boot" ,r-boot) ("r-class" ,r-class) ("r-cluster" ,r-cluster) diff --git a/guix/build-system/r.scm b/guix/build-system/r.scm index e8269fdeb1..c649036210 100644 --- a/guix/build-system/r.scm +++ b/guix/build-system/r.scm @@ -62,7 +62,7 @@ release corresponding to NAME and VERSION." "Return the default R package." ;; Lazily resolve the binding to avoid a circular dependency. (let ((r-mod (resolve-interface '(gnu packages statistics)))) - (module-ref r-mod 'r))) + (module-ref r-mod 'r-minimal))) (define* (lower name #:key source inputs native-inputs outputs system target -- cgit v1.2.3 From 25fb58a3bee583b0ed4e0ad32fb28f420d8099cd Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Fri, 3 Mar 2017 18:17:28 +0100 Subject: build-system/cargo (cargo-build): Add cargo-build-flags, remove configure-flags. * guix/build-system/cargo.scm (cargo-build): Add cargo-build-flags, remove configure-flags. --- guix/build-system/cargo.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm index 578c4446a4..c637fbb162 100644 --- a/guix/build-system/cargo.scm +++ b/guix/build-system/cargo.scm @@ -64,7 +64,7 @@ to NAME and VERSION." #:key (tests? #t) (test-target #f) - (configure-flags #f) + (cargo-build-flags ''("--release")) (phases '(@ (guix build cargo-build-system) %standard-phases)) (outputs '("out")) @@ -89,6 +89,7 @@ to NAME and VERSION." source)) #:system ,system #:test-target ,test-target + #:cargo-build-flags ,cargo-build-flags #:tests? ,tests? #:phases ,phases #:outputs %outputs -- cgit v1.2.3 From 4ed64c534a3084bdb50346fcb13f38bda465f701 Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Fri, 3 Mar 2017 20:50:47 +0100 Subject: build/cargo-build-system: Make cargo-build-system install working packages. * guix/build/cargo-build-system.scm (configure): Remove proprietary dependencies. Add rust dependencies and configure Cargo to find them. (build): Also build libraries, not just applications. (file-sha256): New variable. (generate-checksums): New variable. Export it. (touch): New variable. (install): Generate checksums so Cargo accepts the package. --- guix/build/cargo-build-system.scm | 116 +++++++++++++++++++++++++++++++------- 1 file changed, 95 insertions(+), 21 deletions(-) (limited to 'guix') diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm index 7d656a8d58..f11d858749 100644 --- a/guix/build/cargo-build-system.scm +++ b/guix/build/cargo-build-system.scm @@ -19,13 +19,16 @@ (define-module (guix build cargo-build-system) #:use-module ((guix build gnu-build-system) #:prefix gnu:) #:use-module (guix build utils) + #:use-module (ice-9 popen) + #:use-module (ice-9 rdelim) #:use-module (ice-9 ftw) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (%standard-phases - cargo-build)) + cargo-build + generate-checksums)) ;; Commentary: ;; @@ -45,27 +48,57 @@ "Replace Cargo.toml [dependencies] section with guix inputs." ;; Make sure Cargo.toml is writeable when the crate uses git-fetch. (chmod "Cargo.toml" #o644) - (let ((port (open-file "Cargo.toml" "a" #:encoding "utf-8"))) - (format port "~%[replace]~%") - (for-each - (match-lambda - ((name . path) - (let ((crate (package-name->crate-name name))) - (when (and crate path) - (match (string-split (basename path) #\-) - ((_ ... version) - (format port "\"~a:~a\" = { path = \"~a/share/rust-source\" }~%" - crate version path))))))) - inputs) - (close-port port)) + (chmod "." #o755) + (if (not (file-exists? "vendor")) + (if (not (file-exists? "Cargo.lock")) + (begin + (substitute* "Cargo.toml" + ((".*32-sys.*") " +") + ((".*winapi.*") " +") + ((".*core-foundation.*") " +")) + ;; Prepare one new directory with all the required dependencies. + ;; It's necessary to do this (instead of just using /gnu/store as the + ;; directory) because we want to hide the libraries in subdirectories + ;; share/rust-source/... instead of polluting the user's profile root. + (mkdir "vendor") + (for-each + (match-lambda + ((name . path) + (let ((crate (package-name->crate-name name))) + (when (and crate path) + (match (string-split (basename path) #\-) + ((_ ... version) + (symlink (string-append path "/share/rust-source") + (string-append "vendor/" (basename path))))))))) + inputs) + ;; Configure cargo to actually use this new directory. + (mkdir-p ".cargo") + (let ((port (open-file ".cargo/config" "w" #:encoding "utf-8"))) + (display " +[source.crates-io] +registry = 'https://github.com/rust-lang/crates.io-index' +replace-with = 'vendored-sources' + +[source.vendored-sources] +directory = '" port) + (display (getcwd) port) + (display "/vendor" port) + (display "' +" port) + (close-port port))))) + (setenv "CC" (string-append (assoc-ref inputs "gcc") "/bin/gcc")) + + ;(setenv "CARGO_HOME" "/gnu/store") + ; (setenv "CMAKE_C_COMPILER" cc) #t) -(define* (build #:key (cargo-build-flags '("--release" "--frozen")) +(define* (build #:key (cargo-build-flags '("--release")) #:allow-other-keys) "Build a given Cargo package." - (if (file-exists? "Cargo.lock") - (zero? (apply system* `("cargo" "build" ,@cargo-build-flags))) - #t)) + (zero? (apply system* `("cargo" "build" ,@cargo-build-flags)))) (define* (check #:key tests? #:allow-other-keys) "Run tests for a given Cargo package." @@ -73,6 +106,44 @@ (zero? (system* "cargo" "test")) #t)) +(define (file-sha256 file-name) + "Calculate the hexdigest of the sha256 checksum of FILE-NAME and return it." + (let ((port (open-pipe* OPEN_READ + "sha256sum" + "--" + file-name))) + (let ((result (read-delimited " " port))) + (close-pipe port) + result))) + +;; Example dir-name: "/gnu/store/hwlr49riz3la33m6in2n898ly045ylld-rust-rand-0.3.15". +(define (generate-checksums dir-name src-name) + "Given DIR-NAME, checksum all the files in it one by one and put the + result into the file \".cargo-checksum.json\" in the same directory. + Also includes the checksum of an extra file SRC-NAME as if it was + part of the directory DIR-NAME with name \"package\"." + (let* ((file-names (find-files dir-name ".")) + (dir-prefix-name (string-append dir-name "/")) + (dir-prefix-name-len (string-length dir-prefix-name)) + (checksums-file-name (string-append dir-name "/.cargo-checksum.json"))) + (call-with-output-file checksums-file-name + (lambda (port) + (display "{\"files\":{" port) + (let ((sep "")) + (for-each (lambda (file-name) + (let ((file-relative-name (string-drop file-name dir-prefix-name-len))) + (display sep port) + (set! sep ",") + (write file-relative-name port) + (display ":" port) + (write (file-sha256 file-name) port))) file-names)) + (display "},\"package\":" port) + (write (file-sha256 src-name) port) + (display "}" port))))) + +(define (touch file-name) + (call-with-output-file file-name (const #t))) + (define* (install #:key inputs outputs #:allow-other-keys) "Install a given Cargo package." (let* ((out (assoc-ref outputs "out")) @@ -86,16 +157,19 @@ ;; distributing crates as source and replacing ;; references in Cargo.toml with store paths. (copy-recursively "src" (string-append rsrc "/src")) + (touch (string-append rsrc "/.cargo-ok")) + (generate-checksums rsrc src) (install-file "Cargo.toml" rsrc) ;; When the package includes executables we install ;; it using cargo install. This fails when the crate ;; doesn't contain an executable. (if (file-exists? "Cargo.lock") - (system* "cargo" "install" "--root" out) - (mkdir out)))) + (zero? (system* "cargo" "install" "--root" out)) + (begin + (mkdir out) + #t)))) (define %standard-phases - ;; 'configure' phase is not needed. (modify-phases gnu:%standard-phases (replace 'configure configure) (replace 'build build) -- cgit v1.2.3 From 48b444304e206c35cf2c8e0d87a4711f1aac4fd4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 17 Mar 2017 17:37:00 +0100 Subject: pack: Move absolute file name to . * guix/scripts/pack.scm ()[package]: Remove. [command]: Document as being a gexp with an absolute file name. (%compressors): Adjust accordingly. (self-contained-tarball): Simplify PATH expression. Move 'string-join' for the compressor command on the build side. (docker-image): Simplify PATH expression. * tests/pack.scm (%gzip-compressor): Adjust accordingly. --- guix/scripts/pack.scm | 31 ++++++++++++++++--------------- tests/pack.scm | 3 ++- 2 files changed, 18 insertions(+), 16 deletions(-) (limited to 'guix') diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 74d4ee6d4d..ce7613e4a0 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -46,19 +46,22 @@ ;; Type of a compression tool. (define-record-type - (compressor name package extension command) + (compressor name extension command) compressor? - (name compressor-name) ;string (e.g., "gzip") - (package compressor-package) ;package - (extension compressor-extension) ;string (e.g., "lz") - (command compressor-command)) ;list (e.g., '("gzip" "-9n")) + (name compressor-name) ;string (e.g., "gzip") + (extension compressor-extension) ;string (e.g., "lz") + (command compressor-command)) ;gexp (e.g., #~("/gnu/store/…/gzip" "-9n")) (define %compressors ;; Available compression tools. - (list (compressor "gzip" gzip "gz" '("gzip" "-9n")) - (compressor "lzip" lzip "lz" '("lzip" "-9")) - (compressor "xz" xz "xz" '("xz" "-e")) - (compressor "bzip2" bzip2 "bz2" '("bzip2" "-9")))) + (list (compressor "gzip" "gz" + #~(#+(file-append gzip "/bin/gzip") "-9n")) + (compressor "lzip" "lz" + #~(#+(file-append lzip "/bin/lzip") "-9")) + (compressor "xz" "xz" + #~(#+(file-append xz "/bin/xz") "-e")) + (compressor "bzip2" "bz2" + #~(#+(file-append bzip2 "/bin/bzip2") "-9")))) (define (lookup-compressor name) "Return the compressor object called NAME. Error out if it could not be @@ -121,8 +124,7 @@ added to the pack." (string-append #$(if localstatedir? (file-append guix "/sbin:") "") - #$tar "/bin:" - #$(compressor-package compressor) "/bin")) + #$tar "/bin")) ;; Note: there is not much to gain here with deduplication and ;; there is the overhead of the '.links' directory, so turn it @@ -142,7 +144,8 @@ added to the pack." (with-directory-excursion %root (exit (zero? (apply system* "tar" - "-I" #$(string-join (compressor-command compressor)) + "-I" + (string-join '#+(compressor-command compressor)) "--format=gnu" ;; Avoid non-determinism in the archive. Use @@ -221,9 +224,7 @@ with COMPRESSOR. It can be passed to 'docker load'." (use-modules (guix docker) (srfi srfi-19)) - (setenv "PATH" - (string-append #$tar "/bin:" - #$(compressor-package compressor) "/bin")) + (setenv "PATH" (string-append #$tar "/bin")) (build-docker-image #$output #$profile #:closure "profile" diff --git a/tests/pack.scm b/tests/pack.scm index de9ef8e6ab..eb643c3229 100644 --- a/tests/pack.scm +++ b/tests/pack.scm @@ -42,7 +42,8 @@ (define %gzip-compressor ;; Compressor that uses the bootstrap 'gzip'. ((@ (guix scripts pack) compressor) "gzip" - %bootstrap-coreutils&co "gz" '("gzip" "-6n"))) + "gz" + #~(#+(file-append %bootstrap-coreutils&co "/bin/gzip") "-6n"))) (define %tar-bootstrap %bootstrap-coreutils&co) -- cgit v1.2.3 From 176febe3776b272dffbe757414225702d08c3bdf Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 17 Mar 2017 21:48:40 +0100 Subject: profiles: Packages in a profile can be cross-compiled. * guix/profiles.scm (profile-derivation): Add #:target parameter; pass it to 'gexp->derivation'. * tests/profiles.scm ("profile-derivation, cross-compilation"): New test. --- guix/profiles.scm | 10 +++++++--- tests/profiles.scm | 31 ++++++++++++++++++++++++++++++- 2 files changed, 37 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/profiles.scm b/guix/profiles.scm index de82eae348..a62a076f64 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2014, 2016 Alex Kost ;;; Copyright © 2015 Mark H Weaver @@ -933,13 +933,16 @@ files for the truetype fonts of the @var{manifest} entries." #:key (hooks %default-profile-hooks) (locales? #t) - system) + system target) "Return a derivation that builds a profile (aka. 'user environment') with the given MANIFEST. The profile includes additional derivations returned by the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc. When LOCALES? is true, the build is performed under a UTF-8 locale; this adds -a dependency on the 'glibc-utf8-locales' package." +a dependency on the 'glibc-utf8-locales' package. + +When TARGET is true, it must be a GNU triplet, and the packages in MANIFEST +are cross-built for TARGET." (mlet %store-monad ((system (if system (return system) (current-system))) @@ -1000,6 +1003,7 @@ a dependency on the 'glibc-utf8-locales' package." (gexp->derivation "profile" builder #:system system + #:target target ;; Not worth offloading. #:local-build? #t diff --git a/tests/profiles.scm b/tests/profiles.scm index 5536364889..d0b1e14a86 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès ;;; Copyright © 2014 Alex Kost ;;; ;;; This file is part of GNU Guix. @@ -212,6 +212,35 @@ #:locales? #f))) (return (derivation-inputs drv)))) +(test-assertm "profile-derivation, cross-compilation" + (mlet* %store-monad + ((manifest -> (packages->manifest (list packages:sed packages:grep))) + (target -> "arm-linux-gnueabihf") + (grep (package->cross-derivation packages:grep target)) + (sed (package->cross-derivation packages:sed target)) + (locales (package->derivation packages:glibc-utf8-locales)) + (drv (profile-derivation manifest + #:hooks '() + #:locales? #t + #:target target))) + (define (find-input name) + (let ((name (string-append name ".drv"))) + (any (lambda (input) + (let ((input (derivation-input-path input))) + (and (string-suffix? name input) input))) + (derivation-inputs drv)))) + + ;; The inputs for grep and sed should be cross-build derivations, but that + ;; for the glibc-utf8-locales should be a native build. + (return (and (string=? (derivation-system drv) (%current-system)) + (string=? (find-input (package-full-name packages:grep)) + (derivation-file-name grep)) + (string=? (find-input (package-full-name packages:sed)) + (derivation-file-name sed)) + (string=? (find-input + (package-full-name packages:glibc-utf8-locales)) + (derivation-file-name locales)))))) + (test-assert "package->manifest-entry defaults to \"out\"" (let ((outputs (package-outputs packages:glibc))) (equal? (manifest-entry-output -- cgit v1.2.3 From 5461115e8fd9a3181506307b6090716a0d5c202c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 17 Mar 2017 22:45:32 +0100 Subject: pack: Add '--target'. * guix/scripts/pack.scm (self-contained-tarball): Add #:target. (docker-image): Add #:target. [build]: Pass it to 'build-docker-image'. (%options, show-help): Add '--target'. (guix-pack): Pass TARGET to 'profile-derivation' and to 'build-image'. * guix/docker.scm (build-docker-image): Add #:system parameter and honor it. * doc/guix.texi (Invoking guix pack): Document '--target'. (Additional Build Options): Refer to the Autoconf manual instead of the obsolete 'configure.info' for cross-compilation. --- doc/guix.texi | 10 ++++++++-- guix/docker.scm | 21 +++++++++++++++------ guix/scripts/pack.scm | 23 +++++++++++++++++++---- 3 files changed, 42 insertions(+), 12 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 3db6dad5f3..0a09bba06f 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2476,6 +2476,12 @@ Docker Image Specification}. Attempt to build for @var{system}---e.g., @code{i686-linux}---instead of the system type of the build host. +@item --target=@var{triplet} +@cindex cross-compilation +Cross-build for @var{triplet}, which must be a valid GNU triplet, such +as @code{"mips64el-linux-gnu"} (@pxref{Specifying target triplets, GNU +configuration triplets,, autoconf, Autoconf}). + @item --compression=@var{tool} @itemx -C @var{tool} Compress the resulting tarball using @var{tool}---one of @code{gzip}, @@ -5063,8 +5069,8 @@ to build packages in a complete 32-bit environment. @item --target=@var{triplet} @cindex cross-compilation Cross-build for @var{triplet}, which must be a valid GNU triplet, such -as @code{"mips64el-linux-gnu"} (@pxref{Configuration Names, GNU -configuration triplets,, configure, GNU Configure and Build System}). +as @code{"mips64el-linux-gnu"} (@pxref{Specifying target triplets, GNU +configuration triplets,, autoconf, Autoconf}). @anchor{build-check} @item --check diff --git a/guix/docker.scm b/guix/docker.scm index 290ad3dcf1..060232148e 100644 --- a/guix/docker.scm +++ b/guix/docker.scm @@ -105,12 +105,14 @@ return \"a\"." (define* (build-docker-image image path #:key closure compressor (symlinks '()) + (system (utsname:machine (uname))) (creation-time (current-time time-utc))) "Write to IMAGE a Docker image archive from the given store PATH. The image contains the closure of PATH, as specified in CLOSURE (a file produced by #:references-graphs). SYMLINKS must be a list of (SOURCE -> TARGET) tuples describing symlinks to be created in the image, where each TARGET is relative -to PATH. +to PATH. SYSTEM is a GNU triplet (or prefix thereof) of the system the +binaries at PATH are for; it is used to produce metadata in the image. Use COMPRESSOR, a command such as '(\"gzip\" \"-9n\"), to compress IMAGE. Use CREATION-TIME, a SRFI-19 time-utc object, as the creation time in metadata." @@ -118,11 +120,18 @@ CREATION-TIME, a SRFI-19 time-utc object, as the creation time in metadata." (closure (canonicalize-path closure)) (id (docker-id path)) (time (date->string (time-utc->date creation-time) "~4")) - (arch (match (utsname:machine (uname)) - ("x86_64" "amd64") - ("i686" "386") - ("armv7l" "arm") - ("mips64" "mips64le")))) + (arch (let-syntax ((cond* (syntax-rules () + ((_ (pattern clause) ...) + (cond ((string-prefix? pattern system) + clause) + ... + (else + (error "unsupported system" + system))))))) + (cond* ("x86_64" "amd64") + ("i686" "386") + ("arm" "arm") + ("mips64" "mips64le"))))) ;; Make sure we start with a fresh, empty working directory. (mkdir directory) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index ce7613e4a0..626c592e1c 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -73,7 +73,8 @@ found." (leave (_ "~a: compressor not found~%") name))) (define* (self-contained-tarball name profile - #:key deduplicate? + #:key target + deduplicate? (compressor (first %compressors)) localstatedir? (symlinks '()) @@ -184,14 +185,17 @@ added to the pack." #:references-graphs `(("profile" ,profile)))) (define* (docker-image name profile - #:key deduplicate? + #:key target + deduplicate? (compressor (first %compressors)) localstatedir? (symlinks '()) (tar tar)) "Return a derivation to construct a Docker image of PROFILE. The image is a tarball conforming to the Docker Image Specification, compressed -with COMPRESSOR. It can be passed to 'docker load'." +with COMPRESSOR. It can be passed to 'docker load'. If TARGET is true, it +must a be a GNU triplet and it is used to derive the architecture metadata in +the image." ;; FIXME: Honor LOCALSTATEDIR?. (define not-config? (match-lambda @@ -227,6 +231,7 @@ with COMPRESSOR. It can be passed to 'docker load'." (setenv "PATH" (string-append #$tar "/bin")) (build-docker-image #$output #$profile + #:system (or #$target (utsname:machine (uname))) #:closure "profile" #:symlinks '#$symlinks #:compressor '#$(compressor-command compressor) @@ -278,6 +283,10 @@ with COMPRESSOR. It can be passed to 'docker load'." (lambda (opt name arg result) (alist-cons 'system arg (alist-delete 'system result eq?)))) + (option '("target") #t #f + (lambda (opt name arg result) + (alist-cons 'target arg + (alist-delete 'target result eq?)))) (option '(#\C "compression") #t #f (lambda (opt name arg result) (alist-cons 'compressor (lookup-compressor arg) @@ -314,6 +323,8 @@ Create a bundle of PACKAGE.\n")) -f, --format=FORMAT build a pack in the given FORMAT")) (display (_ " -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) + (display (_ " + --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"")) (display (_ " -C, --compression=TOOL compress using TOOL--e.g., \"lzip\"")) (display (_ " @@ -354,6 +365,7 @@ Create a bundle of PACKAGE.\n")) (pack-format (assoc-ref opts 'format)) (name (string-append (symbol->string pack-format) "-pack")) + (target (assoc-ref opts 'target)) (compressor (assoc-ref opts 'compressor)) (symlinks (assoc-ref opts 'symlinks)) (build-image (match (assq-ref %formats pack-format) @@ -368,8 +380,11 @@ Create a bundle of PACKAGE.\n")) (run-with-store store (mlet* %store-monad ((profile (profile-derivation - (packages->manifest packages))) + (packages->manifest packages) + #:target target)) (drv (build-image name profile + #:target + target #:compressor compressor #:symlinks -- cgit v1.2.3 From 36626c556ed75219bce196ac93d148f6b9af984c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 17 Mar 2017 23:07:01 +0100 Subject: build: Require Guile >= 2.0.9. * configure.ac: Bump requirement to 2.0.9. * doc/guix.texi (Requirements): Adjust accordingly. * README (Requirements): Likewise. * build-aux/download.scm: Remove workaround for . * guix/build/download.scm: Likewise. (http-fetch)[post-2.0.7?]: Remove. Remove conditional code for not POST-2.0.7?. * guix/http-client.scm: Remove workaround for . (http-fetch)[post-2.0.7?]: Remove. Remove conditional code for not POST-2.0.7?. * guix/serialization.scm (read-latin1-string): Remove mention of 2.0.9. * tests/nar.scm: Use (ice-9 control). (let/ec): Remove. --- README | 2 +- build-aux/download.scm | 5 ----- configure.ac | 2 +- doc/guix.texi | 2 +- guix/build/download.scm | 29 +++-------------------------- guix/http-client.scm | 15 +++------------ guix/serialization.scm | 3 +-- tests/nar.scm | 12 +----------- 8 files changed, 11 insertions(+), 59 deletions(-) (limited to 'guix') diff --git a/README b/README index 5829320dc7..4921f255da 100644 --- a/README +++ b/README @@ -20,7 +20,7 @@ Guix is based on the [[http://nixos.org/nix/][Nix]] package manager. GNU Guix currently depends on the following packages: - - [[http://gnu.org/software/guile/][GNU Guile 2.0.x]], version 2.0.7 or later + - [[http://gnu.org/software/guile/][GNU Guile 2.2.x or 2.0.x]], version 2.0.9 or later - [[http://gnupg.org/][GNU libgcrypt]] - [[http://www.gnu.org/software/make/][GNU Make]] - optionally [[http://savannah.nongnu.org/projects/guile-json/][Guile-JSON]], for the 'guix import pypi' command diff --git a/build-aux/download.scm b/build-aux/download.scm index 8f41f33b14..18b820a153 100644 --- a/build-aux/download.scm +++ b/build-aux/download.scm @@ -36,11 +36,6 @@ ;;"http://www.fdn.fr/~lcourtes/software/guix/packages" ) -;; XXX: Work around , present in Guile -;; up to 2.0.7. -(module-define! (resolve-module '(web client)) - 'shutdown (const #f)) - (define (file-name->uri file) "Return the URI for FILE." (match (string-tokenize file (char-set-complement (char-set #\/))) diff --git a/configure.ac b/configure.ac index 3bf2bf1610..76f52e0ec3 100644 --- a/configure.ac +++ b/configure.ac @@ -82,7 +82,7 @@ if test "x$GUILD" = "x"; then fi if test "x$GUILE_EFFECTIVE_VERSION" = "x2.0"; then - PKG_CHECK_MODULES([GUILE], [guile-2.0 >= 2.0.7]) + PKG_CHECK_MODULES([GUILE], [guile-2.0 >= 2.0.9]) fi dnl Installation directory for .scm and .go files. diff --git a/doc/guix.texi b/doc/guix.texi index 0a09bba06f..944e1fad1b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -552,7 +552,7 @@ in the Guix source tree for additional details. GNU Guix depends on the following packages: @itemize -@item @url{http://gnu.org/software/guile/, GNU Guile}, version 2.0.7 or +@item @url{http://gnu.org/software/guile/, GNU Guile}, version 2.0.9 or later, including 2.2.x; @item @url{http://gnupg.org/, GNU libgcrypt}; @item diff --git a/guix/build/download.scm b/guix/build/download.scm index e7a7afecd1..d956a9f33e 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -512,12 +512,6 @@ port if PORT is a TLS session record port." 'set-port-encoding! (lambda (p e) #f)) -;; XXX: Work around , present in Guile -;; up to 2.0.7. -(module-define! (resolve-module '(web client)) - 'shutdown (const #f)) - - ;; XXX: Work around , fixed in Guile commit ;; 16050431f29d56f80c4a8253506fc851b8441840. Guile's date validation ;; procedure rejects dates in which the hour is not padded with a zero but @@ -682,12 +676,6 @@ the connection could not be established in less than TIMEOUT seconds. Return FILE on success. When VERIFY-CERTIFICATE? is true, verify HTTPS certificates; otherwise simply ignore them." - (define post-2.0.7? - (or (> (string->number (major-version)) 2) - (> (string->number (minor-version)) 0) - (> (string->number (micro-version)) 7) - (string>? (version) "2.0.7"))) - (define headers `(;; Some web sites, such as http://dist.schmorp.de, would block you if ;; there's no 'User-Agent' header, presumably on the assumption that @@ -712,20 +700,9 @@ certificates; otherwise simply ignore them." #:verify-certificate? verify-certificate?)) ((resp bv-or-port) - ;; XXX: `http-get*' was introduced in 2.0.7, and replaced by - ;; #:streaming? in 2.0.8. We know we're using it within the - ;; chroot, but `guix-download' might be using a different - ;; version. So keep this compatibility hack for now. - (if post-2.0.7? - (http-get uri #:port connection #:decode-body? #f - #:streaming? #t - #:headers headers) - (if (module-defined? (resolve-interface '(web client)) - 'http-get*) - (http-get* uri #:port connection #:decode-body? #f - #:headers headers) - (http-get uri #:port connection #:decode-body? #f - #:extra-headers headers)))) + (http-get uri #:port connection #:decode-body? #f + #:streaming? #t + #:headers headers)) ((code) (response-code resp)) ((size) diff --git a/guix/http-client.scm b/guix/http-client.scm index 78d39a0208..855ae95a43 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -217,10 +217,6 @@ or if EOF is reached." (when (module-variable %web-http 'read-line*) (module-set! %web-http 'read-line* read-header-line)))) -;; XXX: Work around , present in Guile -;; up to 2.0.7. -(module-define! (resolve-module '(web client)) - 'shutdown (const #f)) (define* (http-fetch uri #:key port (text? #f) (buffered? #t) keep-alive? (verify-certificate? #t) @@ -252,14 +248,9 @@ Raise an '&http-get-error' condition if downloading fails." (unless (or buffered? (not (file-port? port))) (setvbuf port _IONBF)) (let*-values (((resp data) - ;; Try hard to use the API du jour to get an input port. - (if (guile-version>? "2.0.7") - (http-get uri #:streaming? #t #:port port - #:keep-alive? #t - #:headers headers) ; 2.0.9+ - (http-get* uri #:decode-body? text? ; 2.0.7 - #:keep-alive? #t - #:port port #:headers headers))) + (http-get uri #:streaming? #t #:port port + #:keep-alive? #t + #:headers headers)) ((code) (response-code resp))) (case code diff --git a/guix/serialization.scm b/guix/serialization.scm index 4cab5910f7..4a8cd2086e 100644 --- a/guix/serialization.scm +++ b/guix/serialization.scm @@ -130,8 +130,7 @@ ;; . See for ;; a discussion. (let ((bv (read-byte-string p))) - ;; XXX: Rewrite using (ice-9 iconv) when the minimum requirement is - ;; upgraded to Guile >= 2.0.9. + ;; XXX: Rewrite using (ice-9 iconv). (list->string (map integer->char (bytevector->u8-list bv))))) (define (read-maybe-utf8-string p) diff --git a/tests/nar.scm b/tests/nar.scm index 28ead8b783..61646db964 100644 --- a/tests/nar.scm +++ b/tests/nar.scm @@ -35,6 +35,7 @@ #:use-module (srfi srfi-64) #:use-module (ice-9 ftw) #:use-module (ice-9 regex) + #:use-module ((ice-9 control) #:select (let/ec)) #:use-module (ice-9 match)) ;; Test the (guix nar) module. @@ -148,17 +149,6 @@ (string-append (dirname (search-path %load-path "pre-inst-env")) "/test-nar-" (number->string (getpid)))) -(define-syntax-rule (let/ec k exp...) - ;; This one appeared in Guile 2.0.9, so provide a copy here. - (let ((tag (make-prompt-tag))) - (call-with-prompt tag - (lambda () - (let ((k (lambda args - (apply abort-to-prompt tag args)))) - exp...)) - (lambda (_ . args) - (apply values args))))) - (test-begin "nar") -- cgit v1.2.3 From 4fd06a4dd1d4a894b96e586cef594270f8bbb88f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 17 Mar 2017 23:41:37 +0100 Subject: http-client: Avoid name clash with 'open-connection-for-uri' in 2.2.0. * guix/build/download.scm (open-connection-for-uri): Add note about same-named binding in Guile 2.2.0. * guix/http-client.scm: Use 'guix:open-connection-for-uri' for the procedure coming from (guix build download). * guix/scripts/lint.scm: Likewise. * guix/scripts/substitute.scm: Likewise. --- guix/build/download.scm | 3 +++ guix/http-client.scm | 10 ++++++---- guix/scripts/lint.scm | 6 ++++-- guix/scripts/substitute.scm | 23 +++++++++++++---------- 4 files changed, 26 insertions(+), 16 deletions(-) (limited to 'guix') diff --git a/guix/build/download.scm b/guix/build/download.scm index d956a9f33e..36c815c167 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -464,6 +464,9 @@ ETIMEDOUT error is raised." "Like 'open-socket-for-uri', but also handle HTTPS connections. The resulting port must be closed with 'close-connection'. When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates." + ;; Note: Guile 2.2.0's (web client) has a same-named export that's actually + ;; undefined. See Guile commit 011669af3b428e5626f7bbf66b11d57d9768c047. + (define https? (eq? 'https (uri-scheme uri))) diff --git a/guix/http-client.scm b/guix/http-client.scm index 855ae95a43..6874c51db6 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -38,7 +38,9 @@ #:select (mkdir-p dump-port)) #:use-module ((guix build download) #:select (open-socket-for-uri - open-connection-for-uri resolve-uri-reference)) + (open-connection-for-uri + . guix:open-connection-for-uri) + resolve-uri-reference)) #:re-export (open-socket-for-uri) #:export (&http-get-error http-get-error? @@ -234,9 +236,9 @@ Raise an '&http-get-error' condition if downloading fails." (let loop ((uri (if (string? uri) (string->uri uri) uri))) - (let ((port (or port (open-connection-for-uri uri - #:verify-certificate? - verify-certificate?))) + (let ((port (or port (guix:open-connection-for-uri uri + #:verify-certificate? + verify-certificate?))) (headers (match (uri-userinfo uri) ((? string? str) (cons (cons 'Authorization diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 776e7332c5..66c82f0409 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -44,7 +44,8 @@ #:use-module (web uri) #:use-module ((guix build download) #:select (maybe-expand-mirrors - open-connection-for-uri + (open-connection-for-uri + . guix:open-connection-for-uri) close-connection)) #:use-module (web request) #:use-module (web response) @@ -377,7 +378,8 @@ for connections to complete; when TIMEOUT is #f, wait as long as needed." ((or 'http 'https) (catch #t (lambda () - (let ((port (open-connection-for-uri uri #:timeout timeout)) + (let ((port (guix:open-connection-for-uri + uri #:timeout timeout)) (request (build-request uri #:headers headers))) (define response (dynamic-wind diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 524b019a31..faeb019120 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès ;;; Copyright © 2014 Nikita Karetnikov ;;; ;;; This file is part of GNU Guix. @@ -34,7 +34,8 @@ #:use-module ((guix build download) #:select (current-terminal-columns progress-proc uri-abbreviation nar-uri-abbreviation - open-connection-for-uri + (open-connection-for-uri + . guix:open-connection-for-uri) close-connection store-path-abbreviation byte-count->string)) #:use-module (ice-9 rdelim) @@ -210,8 +211,8 @@ provide." (close-connection port)))) (begin (when (or (not port) (port-closed? port)) - (set! port (open-connection-for-uri uri - #:verify-certificate? #f)) + (set! port (guix:open-connection-for-uri + uri #:verify-certificate? #f)) (unless (or buffered? (not (file-port? port))) (setvbuf port _IONBF))) (http-fetch uri #:text? #f #:port port @@ -247,9 +248,10 @@ failure, return #f and #f." read-cache-info) #f)) ((http https) - (let ((port (open-connection-for-uri uri - #:verify-certificate? #f - #:timeout %fetch-timeout))) + (let ((port (guix:open-connection-for-uri + uri + #:verify-certificate? #f + #:timeout %fetch-timeout))) (guard (c ((http-get-error? c) (warning (_ "while fetching '~a': ~a (~s)~%") (uri->string (http-get-error-uri c)) @@ -533,9 +535,10 @@ initial connection on which HTTP requests are sent." (result seed)) ;; (format (current-error-port) "connecting (~a requests left)..." ;; (length requests)) - (let ((p (or port (open-connection-for-uri base-uri - #:verify-certificate? - verify-certificate?)))) + (let ((p (or port (guix:open-connection-for-uri + base-uri + #:verify-certificate? + verify-certificate?)))) ;; For HTTPS, P is not a file port and does not support 'setvbuf'. (when (file-port? p) (setvbuf p _IOFBF (expt 2 16))) -- cgit v1.2.3