From 1ae16033f34cebe802023922436883867010850f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 23 Mar 2018 18:21:28 +0100 Subject: gexp: 'gexp->script' and 'gexp->file' have a new #:module-path parameter. * guix/gexp.scm (load-path-expression): Add 'path' optional parameter. (gexp->script): Add #:module-path and honor it. (gexp->file): Likewise. * tests/gexp.scm ("gexp->script #:module-path"): New test. * doc/guix.texi (G-Expressions): Update accordingly. --- guix/gexp.scm | 35 +++++++++++++++++++++++------------ 1 file changed, 23 insertions(+), 12 deletions(-) (limited to 'guix') diff --git a/guix/gexp.scm b/guix/gexp.scm index 8dea022e04..4a2e5a682e 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2018 Clément Lassieur ;;; ;;; This file is part of GNU Guix. @@ -1116,11 +1116,14 @@ they can refer to each other." (module-ref (resolve-interface '(gnu packages guile)) 'guile-2.2)) -(define (load-path-expression modules) +(define* (load-path-expression modules #:optional (path %load-path)) "Return as a monadic value a gexp that sets '%load-path' and -'%load-compiled-path' to point to MODULES, a list of module names." - (mlet %store-monad ((modules (imported-modules modules)) - (compiled (compiled-modules modules))) +'%load-compiled-path' to point to MODULES, a list of module names. MODULES +are searched for in PATH." + (mlet %store-monad ((modules (imported-modules modules + #:module-path path)) + (compiled (compiled-modules modules + #:module-path path))) (return (gexp (eval-when (expand load eval) (set! %load-path (cons (ungexp modules) %load-path)) @@ -1129,11 +1132,13 @@ they can refer to each other." %load-compiled-path))))))) (define* (gexp->script name exp - #:key (guile (default-guile))) + #:key (guile (default-guile)) + (module-path %load-path)) "Return an executable script NAME that runs EXP using GUILE, with EXP's -imported modules in its search path." +imported modules in its search path. Look up EXP's modules in MODULE-PATH." (mlet %store-monad ((set-load-path - (load-path-expression (gexp-modules exp)))) + (load-path-expression (gexp-modules exp) + module-path))) (gexp->derivation name (gexp (call-with-output-file (ungexp output) @@ -1148,12 +1153,16 @@ imported modules in its search path." (write '(ungexp set-load-path) port) (write '(ungexp exp) port) - (chmod port #o555))))))) + (chmod port #o555)))) + #:module-path module-path))) -(define* (gexp->file name exp #:key (set-load-path? #t)) +(define* (gexp->file name exp #:key + (set-load-path? #t) + (module-path %load-path)) "Return a derivation that builds a file NAME containing EXP. When SET-LOAD-PATH? is true, emit code in the resulting file to set '%load-path' -and '%load-compiled-path' to honor EXP's imported modules." +and '%load-compiled-path' to honor EXP's imported modules. Lookup EXP's +modules in MODULE-PATH." (match (if set-load-path? (gexp-modules exp) '()) (() ;zero modules (gexp->derivation name @@ -1164,13 +1173,15 @@ and '%load-compiled-path' to honor EXP's imported modules." #:local-build? #t #:substitutable? #f)) ((modules ...) - (mlet %store-monad ((set-load-path (load-path-expression modules))) + (mlet %store-monad ((set-load-path (load-path-expression modules + module-path))) (gexp->derivation name (gexp (call-with-output-file (ungexp output) (lambda (port) (write '(ungexp set-load-path) port) (write '(ungexp exp) port)))) + #:module-path module-path #:local-build? #t #:substitutable? #f))))) -- cgit v1.2.3 From 427ec19e8887b8036690734564a86496000e12a6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 23 Mar 2018 18:35:32 +0100 Subject: gexp: 'program-file' has a new #:module-path parameter. * guix/gexp.scm (): Add 'path' field. (program-file): Add #:module-path parameter and honor it. (program-file-compiler): Honor the 'path' field. * tests/gexp.scm ("program-file #:module-path"): New test. * doc/guix.texi (G-Expressions): Update. --- doc/guix.texi | 4 ++-- guix/gexp.scm | 16 ++++++++++------ tests/gexp.scm | 27 +++++++++++++++++++++++++++ 3 files changed, 39 insertions(+), 8 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index b765bcd112..7304d589d4 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5179,10 +5179,10 @@ executable file @file{/gnu/store/@dots{}-list-files} along these lines: @end deffn @deffn {Scheme Procedure} program-file @var{name} @var{exp} @ - [#:guile #f] + [#:guile #f] [#:module-path %load-path] Return an object representing the executable store item @var{name} that runs @var{gexp}. @var{guile} is the Guile package used to execute that -script. +script. Imported modules of @var{gexp} are looked up in @var{module-path}. This is the declarative counterpart of @code{gexp->script}. @end deffn diff --git a/guix/gexp.scm b/guix/gexp.scm index 4a2e5a682e..b47965d9eb 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -60,6 +60,7 @@ program-file-name program-file-gexp program-file-guile + program-file-module-path scheme-file scheme-file? @@ -380,25 +381,28 @@ This is the declarative counterpart of 'gexp->derivation'." (apply gexp->derivation name gexp options))))) (define-record-type - (%program-file name gexp guile) + (%program-file name gexp guile path) program-file? (name program-file-name) ;string (gexp program-file-gexp) ;gexp - (guile program-file-guile)) ;package + (guile program-file-guile) ;package + (path program-file-module-path)) ;list of strings -(define* (program-file name gexp #:key (guile #f)) +(define* (program-file name gexp #:key (guile #f) (module-path %load-path)) "Return an object representing the executable store item NAME that runs -GEXP. GUILE is the Guile package used to execute that script. +GEXP. GUILE is the Guile package used to execute that script. Imported +modules of GEXP are looked up in MODULE-PATH. This is the declarative counterpart of 'gexp->script'." - (%program-file name gexp guile)) + (%program-file name gexp guile module-path)) (define-gexp-compiler (program-file-compiler (file ) system target) ;; Compile FILE by returning a derivation that builds the script. (match file - (($ name gexp guile) + (($ name gexp guile module-path) (gexp->script name gexp + #:module-path module-path #:guile (or guile (default-guile)))))) (define-record-type diff --git a/tests/gexp.scm b/tests/gexp.scm index a0198b13a0..2f8940e2c6 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -902,6 +902,33 @@ (return (and (zero? (close-pipe pipe)) (= n (string->number str))))))))) +(test-assertm "program-file #:module-path" + (call-with-temporary-directory + (lambda (directory) + (define text (random-text)) + + (call-with-output-file (string-append directory "/stupid-module.scm") + (lambda (port) + (write `(begin (define-module (stupid-module)) + (define-public %stupid-thing ,text)) + port))) + + (let* ((exp (with-imported-modules '((stupid-module)) + (gexp (begin + (use-modules (stupid-module)) + (display %stupid-thing))))) + (file (program-file "program" exp + #:guile %bootstrap-guile + #:module-path (list directory)))) + (mlet* %store-monad ((drv (lower-object file)) + (out -> (derivation->output-path drv))) + (mbegin %store-monad + (built-derivations (list drv)) + (let* ((pipe (open-input-pipe out)) + (str (get-string-all pipe))) + (return (and (zero? (close-pipe pipe)) + (string=? text str)))))))))) + (test-assertm "scheme-file" (let* ((text (plain-file "foo" "Hello, world!")) (scheme (scheme-file "bar" #~(list "foo" #$text)))) -- cgit v1.2.3 From 272c07096251ea3dae237fd016fc5d66fe25e147 Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Sun, 11 Mar 2018 01:13:01 +0100 Subject: tests: Add tests for "guix pack". * guix/scripts/pack.scm (bootstrap-xz): New variable. (%options) <--bootstrap>: New option. (show-help): Document the new --bootstrap option. (guix-pack): When --bootstrap is specified, use the bootstrap Guile, tar, and xz to build the pack, and do not use any profile hooks or locales. * doc/guix.texi (Invoking guix pull): Document the new --bootstrap option. * tests/guix-pack.sh: New file. * Makefile.am (SH_TESTS): Add guix-pack.sh. * gnu/packages/package-management.scm (guix) : Add util-linux. --- Makefile.am | 1 + doc/guix.texi | 6 ++- gnu/packages/package-management.scm | 2 + guix/scripts/pack.scm | 64 ++++++++++++++++++++-------- tests/guix-pack.sh | 83 +++++++++++++++++++++++++++++++++++++ 5 files changed, 138 insertions(+), 18 deletions(-) create mode 100644 tests/guix-pack.sh (limited to 'guix') diff --git a/Makefile.am b/Makefile.am index 0c653b54e4..feb99490d3 100644 --- a/Makefile.am +++ b/Makefile.am @@ -374,6 +374,7 @@ SH_TESTS = \ tests/guix-download.sh \ tests/guix-gc.sh \ tests/guix-hash.sh \ + tests/guix-pack.sh \ tests/guix-package.sh \ tests/guix-package-net.sh \ tests/guix-system.sh \ diff --git a/doc/guix.texi b/doc/guix.texi index 482fa463cf..9744704ea7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -23,7 +23,7 @@ Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@* Copyright @copyright{} 2015, 2016, 2017 Leo Famulari@* Copyright @copyright{} 2015, 2016, 2017, 2018 Ricardo Wurmus@* Copyright @copyright{} 2016 Ben Woodcroft@* -Copyright @copyright{} 2016, 2017 Chris Marusich@* +Copyright @copyright{} 2016, 2017, 2018 Chris Marusich@* Copyright @copyright{} 2016, 2017, 2018 Efraim Flashner@* Copyright @copyright{} 2016 John Darrington@* Copyright @copyright{} 2016, 2017 Nils Gillmann@* @@ -2899,6 +2899,10 @@ added to it or removed from it after extraction of the pack. One use case for this is the Guix self-contained binary tarball (@pxref{Binary Installation}). + +@item --bootstrap +Use the bootstrap binaries to build the pack. This option is only +useful to Guix developers. @end table In addition, @command{guix pack} supports all the common build options diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index 709cdfd0f7..a90ba7a21a 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -257,6 +257,8 @@ ;; Many tests rely on the 'guile-bootstrap' package, which is why we ;; have it here. ("boot-guile" ,(bootstrap-guile-origin (%current-system))) + ;; Some of the tests use "unshare" when it is available. + ("util-linux" ,util-linux) ,@(if (and (not (%current-target-system)) (string=? (%current-system) "x86_64-linux")) `(("boot-guile/i686" ,(bootstrap-guile-origin "i686-linux"))) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 59dd117edb..0ec1ef4d24 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2017 Efraim Flashner ;;; Copyright © 2017 Ricardo Wurmus ;;; Copyright © 2018 Konrad Hinsen +;;; Copyright © 2018 Chris Marusich ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,7 +34,9 @@ #:use-module (guix derivations) #:use-module (guix scripts build) #:use-module (gnu packages) + #:use-module (gnu packages bootstrap) #:use-module (gnu packages compression) + #:use-module (gnu packages guile) #:autoload (gnu packages base) (tar) #:autoload (gnu packages package-management) (guix) #:autoload (gnu packages gnupg) (libgcrypt) @@ -67,6 +70,11 @@ #~(#+(file-append bzip2 "/bin/bzip2") "-9")) (compressor "none" "" #f))) +;; This one is only for use in this module, so don't put it in %compressors. +(define bootstrap-xz + (compressor "bootstrap-xz" ".xz" + #~(#+(file-append %bootstrap-coreutils&co "/bin/xz") "-e -T0"))) + (define (lookup-compressor name) "Return the compressor object called NAME. Error out if it could not be found." @@ -325,6 +333,9 @@ the image." (option '("localstatedir") #f #f (lambda (opt name arg result) (alist-cons 'localstatedir? #t result))) + (option '("bootstrap") #f #f + (lambda (opt name arg result) + (alist-cons 'bootstrap? #t result))) (append %transformation-options %standard-build-options))) @@ -352,6 +363,8 @@ Create a bundle of PACKAGE.\n")) -m, --manifest=FILE create a pack with the manifest from FILE")) (display (G_ " --localstatedir include /var/guix in the resulting pack")) + (display (G_ " + --bootstrap use the bootstrap binaries to build the pack")) (newline) (display (G_ " -h, --help display this help and exit")) @@ -393,28 +406,43 @@ Create a bundle of PACKAGE.\n")) (else (packages->manifest packages))))) (with-error-handling - (parameterize ((%graft? (assoc-ref opts 'graft?))) - (let* ((dry-run? (assoc-ref opts 'dry-run?)) - (manifest (manifest-from-args opts)) - (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) - ((? procedure? proc) proc) - (#f - (leave (G_ "~a: unknown pack format") - format)))) - (localstatedir? (assoc-ref opts 'localstatedir?))) - (with-store store + (let* ((dry-run? (assoc-ref opts 'dry-run?)) + (manifest (manifest-from-args opts)) + (pack-format (assoc-ref opts 'format)) + (name (string-append (symbol->string pack-format) + "-pack")) + (target (assoc-ref opts 'target)) + (bootstrap? (assoc-ref opts 'bootstrap?)) + (compressor (if bootstrap? + bootstrap-xz + (assoc-ref opts 'compressor))) + (tar (if bootstrap? + %bootstrap-coreutils&co + tar)) + (symlinks (assoc-ref opts 'symlinks)) + (build-image (match (assq-ref %formats pack-format) + ((? procedure? proc) proc) + (#f + (leave (G_ "~a: unknown pack format") + format)))) + (localstatedir? (assoc-ref opts 'localstatedir?))) + (with-store store + (parameterize ((%graft? (assoc-ref opts 'graft?)) + (%guile-for-build (package-derivation + store + (if (assoc-ref opts 'bootstrap?) + %bootstrap-guile + (canonical-package guile-2.2))))) ;; 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 manifest + #:hooks (if bootstrap? + '() + %default-profile-hooks) + #:locales? (not bootstrap?) #:target target)) (drv (build-image name profile #:target @@ -424,7 +452,9 @@ Create a bundle of PACKAGE.\n")) #:symlinks symlinks #:localstatedir? - localstatedir?))) + localstatedir? + #:tar + tar))) (mbegin %store-monad (show-what-to-build* (list drv) #:use-substitutes? diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh new file mode 100644 index 0000000000..1b63b957be --- /dev/null +++ b/tests/guix-pack.sh @@ -0,0 +1,83 @@ +# GNU Guix --- Functional package management for GNU +# Copyright © 2018 Chris Marusich +# +# 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 . + +# +# Test the `guix pack' command-line utility. +# + +# A network connection is required to build %bootstrap-coreutils&co, +# which is required to run these tests with the --bootstrap option. +if ! guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null; then + exit 77 +fi + +guix pack --version + +# Use --no-substitutes because we need to verify we can do this ourselves. +GUIX_BUILD_OPTIONS="--no-substitutes" +export GUIX_BUILD_OPTIONS + +# Build a tarball with no compression. +guix pack --compression=none --bootstrap guile-bootstrap + +# Build a tarball (with compression). +guix pack --bootstrap guile-bootstrap + +# Build a tarball with a symlink. +the_pack="`guix pack --bootstrap -S /opt/gnu/bin=bin guile-bootstrap`" + +# Try to extract it. +test_directory="`mktemp -d`" +trap 'rm -rf "$test_directory"' EXIT +cd "$test_directory" +tar -xf "$the_pack" +test -x opt/gnu/bin/guile + +is_available () { + # Use the "type" shell builtin to see if the program is on PATH. + type "$1" > /dev/null +} + +if is_available chroot && is_available unshare; then + # Verify we can use what we built. + unshare -r chroot . /opt/gnu/bin/guile --version + cd - +else + echo "warning: skipped some verification because chroot or unshare is unavailable" >&2 +fi + +# For the tests that build Docker images below, we currently have to use +# --dry-run because if we don't, there are only two possible cases: +# +# Case 1: We do not use --bootstrap, and the build takes hours to finish +# because it needs to build tar etc. +# +# Case 2: We use --bootstrap, and the build fails because the bootstrap +# Guile cannot dlopen shared libraries. Not to mention the fact +# that we would still have to build many non-bootstrap inputs +# (e.g., guile-json) in order to create the Docker image. + +# Build a Docker image. +guix pack --dry-run --bootstrap -f docker guile-bootstrap + +# Build a Docker image with a symlink. +guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap + +# Build a tarball pack of cross-compiled software. Use coreutils because +# guile-bootstrap is not intended to be cross-compiled. +guix pack --dry-run --bootstrap --target=arm-unknown-linux-gnueabihf coreutils -- cgit v1.2.3 From 1c2ac6b482ea20419e57fd54b0cd1d4d3972776b Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Thu, 15 Mar 2018 05:09:13 +0100 Subject: guix: Rewrite build-docker-image to allow more paths. * guix/docker.scm (build-docker-image): Rename "path" argument to "prefix" to reflect the fact that it is used as a prefix for the symlink targets. Add the "paths" argument, and remove the "closure" argument, since it is now redundant. Add a "transformations" argument. * guix/scripts/pack.scm (docker-image): Read the profile's reference graph and provide its paths to build-docker-image via the new "paths" argument. --- guix/docker.scm | 200 ++++++++++++++++++++++++++++++-------------------- guix/scripts/pack.scm | 9 ++- 2 files changed, 128 insertions(+), 81 deletions(-) (limited to 'guix') diff --git a/guix/docker.scm b/guix/docker.scm index 060232148e..a75534c33b 100644 --- a/guix/docker.scm +++ b/guix/docker.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Ricardo Wurmus ;;; Copyright © 2017 Ludovic Courtès +;;; Copyright © 2018 Chris Marusich ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,9 +24,12 @@ #:use-module ((guix build utils) #:select (mkdir-p delete-file-recursively - with-directory-excursion)) - #:use-module (guix build store-copy) + with-directory-excursion + invoke)) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) + #:use-module ((texinfo string-utils) + #:select (escape-special-chars)) #:use-module (rnrs bytevectors) #:use-module (ice-9 match) #:export (build-docker-image)) @@ -33,8 +37,7 @@ ;; 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. +;; Generate a 256-bit identifier in hexadecimal encoding for the Docker image. (define docker-id (compose bytevector->base16-string sha256 string->utf8)) @@ -102,82 +105,123 @@ return \"a\"." ((first rest ...) first))) -(define* (build-docker-image image path - #:key closure compressor +(define* (build-docker-image image paths prefix + #:key (symlinks '()) + (transformations '()) (system (utsname:machine (uname))) + 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). SYMLINKS must be a list of (SOURCE -> TARGET) tuples -describing symlinks to be created in the image, where each TARGET is relative -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." - (let ((directory "/tmp/docker-image") ;temporary working directory - (closure (canonicalize-path closure)) - (id (docker-id path)) - (time (date->string (time-utc->date creation-time) "~4")) - (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"))))) + "Write to IMAGE a Docker image archive containing the given PATHS. PREFIX +must be a store path that is a prefix of any store paths in PATHS. + +SYMLINKS must be a list of (SOURCE -> TARGET) tuples describing symlinks to be +created in the image, where each TARGET is relative to PREFIX. +TRANSFORMATIONS must be a list of (OLD -> NEW) tuples describing how to +transform the PATHS. Any path in PATHS that begins with OLD will be rewritten +in the Docker image so that it begins with NEW instead. If a path is a +non-empty directory, then its contents will be recursively added, as well. + +SYSTEM is a GNU triplet (or prefix thereof) of the system the binaries in +PATHS 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." + (define (sanitize path-fragment) + (escape-special-chars + ;; GNU tar strips the leading slash off of absolute paths before applying + ;; the transformations, so we need to do the same, or else our + ;; replacements won't match any paths. + (string-trim path-fragment #\/) + ;; Escape the basic regexp special characters (see: "(sed) BRE syntax"). + ;; We also need to escape "/" because we use it as a delimiter. + "/*.^$[]\\" + #\\)) + (define transformation->replacement + (match-lambda + ((old '-> new) + ;; See "(tar) transform" for details on the expression syntax. + (string-append "s/^" (sanitize old) "/" (sanitize new) "/")))) + (define (transformations->expression transformations) + (let ((replacements (map transformation->replacement transformations))) + (string-append + ;; Avoid transforming link targets, since that would break some links + ;; (e.g., symlinks that point to an absolute store path). + "flags=rSH;" + (string-join replacements ";") + ;; Some paths might still have a leading path delimiter even after tar + ;; transforms them (e.g., "/a/b" might be transformed into "/b"), so + ;; strip any leading path delimiters that remain. + ";s,^//*,,"))) + (define transformation-options + (if (eq? '() transformations) + '() + `("--transform" ,(transformations->expression transformations)))) + (let* ((directory "/tmp/docker-image") ;temporary working directory + (id (docker-id prefix)) + (time (date->string (time-utc->date creation-time) "~4")) + (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) - - (and (with-directory-excursion directory - (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))) - ;; 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 - items - (map symlink-source symlinks)))) - (for-each delete-file-recursively - (map (compose topmost-component symlink-source) - symlinks))))) - - (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 - `(,@%tar-determinism-options - ,@(if compressor - (list "-I" (string-join compressor)) - '()) - "."))) - (begin (delete-file-recursively directory) #t))))) + (with-directory-excursion directory + (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)))) + + ;; Create SYMLINKS. + (for-each (match-lambda + ((source '-> target) + (let ((source (string-trim source #\/))) + (mkdir-p (dirname source)) + (symlink (string-append prefix "/" target) + source)))) + symlinks) + + (apply invoke "tar" "-cf" "layer.tar" + `(,@transformation-options + ,@%tar-determinism-options + ,@paths + ,@(map symlink-source symlinks))) + ;; It is possible for "/" to show up in the archive, especially when + ;; applying transformations. For example, the transformation + ;; "s,^/a,," will (perhaps surprisingly) cause GNU tar to transform + ;; the path "/a" into "/". The presence of "/" in the archive is + ;; probably benign, but it is definitely safe to remove it, so let's + ;; do that. This fails when "/" is not in the archive, so use system* + ;; instead of invoke to avoid an exception in that case. + (system* "tar" "--delete" "/" "-f" "layer.tar") + (for-each delete-file-recursively + (map (compose topmost-component symlink-source) + symlinks))) + + (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 prefix id)))) + (with-output-to-file "repositories" + (lambda () + (scm->json (repositories prefix id))))) + + (apply invoke "tar" "-cf" image "-C" directory + `(,@%tar-determinism-options + ,@(if compressor + (list "-I" (string-join compressor)) + '()) + ".")) + (delete-file-recursively directory))) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 0ec1ef4d24..488638adc5 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -238,6 +238,7 @@ the image." (define build (with-imported-modules `(,@(source-module-closure '((guix docker)) #:select? not-config?) + (guix build store-copy) ((guix config) => ,config)) #~(begin ;; Guile-JSON is required by (guix docker). @@ -245,13 +246,15 @@ the image." (string-append #+json "/share/guile/site/" (effective-version))) - (use-modules (guix docker) (srfi srfi-19)) + (use-modules (guix docker) (srfi srfi-19) (guix build store-copy)) (setenv "PATH" (string-append #$tar "/bin")) - (build-docker-image #$output #$profile + (build-docker-image #$output + (call-with-input-file "profile" + read-reference-graph) + #$profile #:system (or #$target (utsname:machine (uname))) - #:closure "profile" #:symlinks '#$symlinks #:compressor '#$(compressor-command compressor) #:creation-time (make-time time-utc 0 1))))) -- cgit v1.2.3 From a335f6fcc9aac1afb49a562968107abf7c87e631 Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Mon, 19 Feb 2018 05:45:03 +0100 Subject: system: Add "guix system docker-image" command. * gnu/system/vm.scm (system-docker-image): New procedure. * guix/scripts/system.scm (system-derivation-for-action): Add a case for docker-image, and in that case, call system-docker-image. (show-help): Document docker-image. (guix-system): Parse arguments for docker-image. * doc/guix.texi (Invoking guix system): Document "guix system docker-image". * gnu/system/examples/docker-image.tmpl: New file. --- doc/guix.texi | 36 ++++++++++-- gnu/system/examples/docker-image.tmpl | 47 +++++++++++++++ gnu/system/vm.scm | 105 ++++++++++++++++++++++++++++++++++ guix/scripts/system.scm | 12 ++-- 4 files changed, 192 insertions(+), 8 deletions(-) create mode 100644 gnu/system/examples/docker-image.tmpl (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 9744704ea7..a090b2cad3 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -20385,12 +20385,18 @@ containing at least the kernel, initrd, and bootloader data files must be created. The @code{--image-size} option can be used to specify the size of the image. +@cindex System images, creation in various formats +@cindex Creating system images in various formats @item vm-image @itemx disk-image -Return a virtual machine or disk image of the operating system declared -in @var{file} that stands alone. By default, @command{guix system} -estimates the size of the image needed to store the system, but you can -use the @option{--image-size} option to specify a value. +@itemx docker-image +Return a virtual machine, disk image, or Docker image of the operating +system declared in @var{file} that stands alone. By default, +@command{guix system} estimates the size of the image needed to store +the system, but you can use the @option{--image-size} option to specify +a value. Docker images are built to contain exactly what they need, so +the @option{--image-size} option is ignored in the case of +@code{docker-image}. You can specify the root file system type by using the @option{--file-system-type} option. It defaults to @code{ext4}. @@ -20408,6 +20414,28 @@ using the following command: # dd if=$(guix system disk-image my-os.scm) of=/dev/sdc @end example +When using @code{docker-image}, a Docker image is produced. Guix builds +the image from scratch, not from a pre-existing Docker base image. As a +result, it contains @emph{exactly} what you define in the operating +system configuration file. You can then load the image and launch a +Docker container using commands like the following: + +@example +image_id="$(docker load < guixsd-docker-image.tar.gz)" +docker run -e GUIX_NEW_SYSTEM=/var/guix/profiles/system \\ + --entrypoint /var/guix/profiles/system/profile/bin/guile \\ + $image_id /var/guix/profiles/system/boot +@end example + +This command starts a new Docker container from the specified image. It +will boot the GuixSD system in the usual manner, which means it will +start any services you have defined in the operating system +configuration. Depending on what you run in the Docker container, it +may be necessary to give the container additional permissions. For +example, if you intend to build software using Guix inside of the Docker +container, you may need to pass the @option{--privileged} option to +@code{docker run}. + @item container Return a script to run the operating system declared in @var{file} within a container. Containers are a set of lightweight isolation diff --git a/gnu/system/examples/docker-image.tmpl b/gnu/system/examples/docker-image.tmpl new file mode 100644 index 0000000000..d73187398f --- /dev/null +++ b/gnu/system/examples/docker-image.tmpl @@ -0,0 +1,47 @@ +;; This is an operating system configuration template for a "Docker image" +;; setup, so it has barely any services at all. + +(use-modules (gnu)) + +(operating-system + (host-name "komputilo") + (timezone "Europe/Berlin") + (locale "en_US.utf8") + + ;; This is where user accounts are specified. The "root" account is + ;; implicit, and is initially created with the empty password. + (users (cons (user-account + (name "alice") + (comment "Bob's sister") + (group "users") + (supplementary-groups '("wheel" + "audio" "video")) + (home-directory "/home/alice")) + %base-user-accounts)) + + ;; Globally-installed packages. + (packages %base-packages) + + ;; Because the system will run in a Docker container, we may omit many + ;; things that would normally be required in an operating system + ;; configuration file. These things include: + ;; + ;; * bootloader + ;; * file-systems + ;; * services such as mingetty, udevd, slim, networking, dhcp + ;; + ;; Either these things are simply not required, or Docker provides + ;; similar services for us. + + ;; This will be ignored. + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (target "does-not-matter"))) + ;; This will be ignored, too. + (file-systems (list (file-system + (device "does-not-matter") + (mount-point "/") + (type "does-not-matter")))) + + ;; Guix is all you need! + (services (list (guix-service)))) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 9d9eafc094..09a11af863 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -23,6 +23,7 @@ (define-module (gnu system vm) #:use-module (guix config) + #:use-module (guix docker) #:use-module (guix store) #:use-module (guix gexp) #:use-module (guix derivations) @@ -30,6 +31,7 @@ #:use-module (guix monads) #:use-module (guix records) #:use-module (guix modules) + #:use-module (guix scripts pack) #:use-module (guix utils) #:use-module (guix hash) #:use-module (guix base32) @@ -39,7 +41,9 @@ #:use-module (gnu packages base) #:use-module (gnu packages bootloaders) #:use-module (gnu packages cdrom) + #:use-module (gnu packages compression) #:use-module (gnu packages guile) + #:autoload (gnu packages gnupg) (libgcrypt) #:use-module (gnu packages gawk) #:use-module (gnu packages bash) #:use-module (gnu packages less) @@ -76,6 +80,7 @@ system-qemu-image/shared-store system-qemu-image/shared-store-script system-disk-image + system-docker-image virtual-machine virtual-machine?)) @@ -377,6 +382,106 @@ the image." #:disk-image-format disk-image-format #:references-graphs inputs)) +(define* (system-docker-image os + #:key + (name "guixsd-docker-image") + register-closures?) + "Build a docker image. OS is the desired . NAME is the +base name to use for the output file. When REGISTER-CLOSURES? is not #f, +register the closure of OS with Guix in the resulting Docker image. This only +makes sense when you want to build a GuixSD Docker image that has Guix +installed inside of it. If you don't need Guix (e.g., your GuixSD Docker +image just contains a web server that is started by the Shepherd), then you +should set REGISTER-CLOSURES? to #f." + (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")))))) + (mlet %store-monad ((os-drv (operating-system-derivation os #:container? #t)) + (name -> (string-append name ".tar.gz")) + (graph -> "system-graph")) + (define build + (with-imported-modules `(,@(source-module-closure '((guix docker) + (guix build utils) + (gnu build vm)) + #:select? not-config?) + (guix build store-copy) + ((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) + (guix build utils) + (gnu build vm) + (srfi srfi-19) + (guix build store-copy)) + + (let* ((inputs '#$(append (list tar) + (if register-closures? + (list guix) + '()))) + ;; This initializer requires elevated privileges that are + ;; not normally available in the build environment (e.g., + ;; it needs to create device nodes). In order to obtain + ;; such privileges, we run it as root in a VM. + (initialize (root-partition-initializer + #:closures '(#$graph) + #:register-closures? #$register-closures? + #:system-directory #$os-drv + ;; De-duplication would fail due to + ;; cross-device link errors, so don't do it. + #:deduplicate? #f)) + ;; Even as root in a VM, the initializer would fail due to + ;; lack of privileges if we use a root-directory that is on + ;; a file system that is shared with the host (e.g., /tmp). + (root-directory "/guixsd-system-root")) + (set-path-environment-variable "PATH" '("bin" "sbin") inputs) + (mkdir root-directory) + (initialize root-directory) + (build-docker-image + (string-append "/xchg/" #$name) ;; The output file. + (cons* root-directory + (call-with-input-file (string-append "/xchg/" #$graph) + read-reference-graph)) + #$os-drv + #:compressor '(#+(file-append gzip "/bin/gzip") "-9n") + #:creation-time (make-time time-utc 0 1) + #:transformations `((,root-directory -> ""))))))) + (expression->derivation-in-linux-vm + name + ;; The VM's initrd Guile doesn't support dlopen, but our "build" gexp + ;; needs to be run by a Guile that can dlopen libgcrypt. The following + ;; hack works around that problem by putting the "build" gexp into an + ;; executable script (created by program-file) which, when executed, will + ;; run using a Guile that supports dlopen. That way, the VM's initrd + ;; Guile can just execute it via invoke, without using dlopen. See: + ;; https://lists.gnu.org/archive/html/guix-devel/2017-10/msg00233.html + (with-imported-modules `((guix build utils)) + #~(begin + (use-modules (guix build utils)) + ;; If we use execl instead of invoke here, the VM will crash with a + ;; kernel panic. + (invoke #$(program-file "build-docker-image" build)))) + #:make-disk-image? #f + #:single-file-output? #t + #:references-graphs `((,graph ,os-drv))))) + ;;; ;;; VM and disk images. diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index f0c4a2ba1b..b50cabcd1a 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2016 Alex Kost -;;; Copyright © 2016, 2017 Chris Marusich +;;; Copyright © 2016, 2017, 2018 Chris Marusich ;;; Copyright © 2017 Mathieu Othacehe ;;; ;;; This file is part of GNU Guix. @@ -701,7 +701,9 @@ checking this by themselves in their 'check' procedure." ("iso9660" "image.iso") (_ "disk-image")) #:disk-image-size image-size - #:file-system-type file-system-type)))) + #:file-system-type file-system-type)) + ((docker-image) + (system-docker-image os #:register-closures? #t)))) (define (maybe-suggest-running-guix-pull) "Suggest running 'guix pull' if this has never been done before." @@ -904,6 +906,8 @@ Some ACTIONS support additional ARGS.\n")) vm-image build a freestanding virtual machine image\n")) (display (G_ "\ disk-image build a disk image, suitable for a USB stick\n")) + (display (G_ "\ + docker-image build a Docker image\n")) (display (G_ "\ init initialize a root file system to run GNU\n")) (display (G_ "\ @@ -1142,7 +1146,7 @@ argument list and OPTS is the option alist." (case action ((build container vm vm-image disk-image reconfigure init extension-graph shepherd-graph list-generations roll-back - switch-generation search) + switch-generation search docker-image) (alist-cons 'action action result)) (else (leave (G_ "~a: unknown action~%") action)))))) @@ -1171,7 +1175,7 @@ argument list and OPTS is the option alist." (exit 1)) (case action - ((build container vm vm-image disk-image reconfigure) + ((build container vm vm-image disk-image docker-image reconfigure) (unless (or (= count 1) (and expr (= count 0))) (fail))) -- cgit v1.2.3 From dfca24180c96342fac05d665ea8b03c02e61204c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 26 Mar 2018 00:12:52 +0200 Subject: git: 'latest-repository-commit' calls 'repository-close!'. * guix/git.scm (latest-repository-commit): Call 'repository-close!' when it exists. --- guix/git.scm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'guix') diff --git a/guix/git.scm b/guix/git.scm index d31c35f64f..103749d0e2 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -147,6 +147,13 @@ Git repositories are kept in the cache directory specified by (when cache-exists? (remote-fetch (remote-lookup repository "origin"))) (switch-to-ref repository ref) + + ;; Reclaim file descriptors and memory mappings associated with + ;; REPOSITORY as soon as possible. + (when (module-defined? (resolve-interface '(git repository)) + 'repository-close!) + (repository-close! repository)) + (copy-to-store store cache-dir #:url url #:repository repository)))) -- cgit v1.2.3 From 7d85fcde2343e59bd2eb5ba5d08123877a38da6c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 26 Mar 2018 10:05:54 +0200 Subject: guix build: 'guix build --log-file' gracefully reports certificate errors. Previously 'guix build --log-file' would print a backtrace upon X.509 certificate verification errors. * guix/scripts/build.scm (log-url): Catch 'tls-certificate-error' in addition to 'getaddrinfo-error'. --- guix/scripts/build.scm | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 57f2d82c5c..401087e830 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2013 Mark H Weaver ;;; ;;; This file is part of GNU Guix. @@ -69,13 +69,21 @@ found. Return #f if no build log was found." (define (valid-url? url) ;; Probe URL and return #t if it is accessible. - (catch 'getaddrinfo-error + (catch #t (lambda () (guard (c ((http-get-error? c) #f)) (close-port (http-fetch url #:buffered? #f)) #t)) - (lambda _ - #f))) + (match-lambda* + (('getaddrinfo-error . _) + #f) + (('tls-certificate-error args ...) + (report-error (G_ "cannot access build log at '~a':~%") url) + (print-exception (current-error-port) #f + 'tls-certificate-error args) + (exit 1)) + ((key . args) + (apply throw key args))))) (define (find-url file) (let ((base (basename file))) -- cgit v1.2.3 From b06a70e05dc6252a3ecb28db5898de7ebc110973 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 27 Mar 2018 14:00:48 +0200 Subject: graph: Add "module" node type. * guix/scripts/graph.scm (module-from-package) (source-module-dependencies*): New procedures. (%module-node-type): New variable. (%node-types): Add it. * guix/modules.scm (source-module-dependencies): Export. * tests/graph.scm ("module graph"): New test. * doc/guix.texi (Invoking guix graph): Document it. --- doc/guix.texi | 9 +++++++++ guix/modules.scm | 3 ++- guix/scripts/graph.scm | 38 ++++++++++++++++++++++++++++++++++++-- tests/graph.scm | 20 +++++++++++++++++++- 4 files changed, 66 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 49b3dd10d7..2204285516 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6997,6 +6997,15 @@ name instead of a package name, as in: @example guix graph -t derivation `guix system build -d my-config.scm` @end example + +@item module +This is the graph of @dfn{package modules} (@pxref{Package Modules}). +For example, the following command shows the graph for the package +module that defines the @code{guile} package: + +@example +guix graph -t module guile | dot -Tpdf > module-graph.pdf +@end example @end table All the types above correspond to @emph{build-time dependencies}. The diff --git a/guix/modules.scm b/guix/modules.scm index 6c602eda48..bf656bb241 100644 --- a/guix/modules.scm +++ b/guix/modules.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017 Ludovic Courtès +;;; Copyright © 2016, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,6 +29,7 @@ file-name->module-name module-name->file-name + source-module-dependencies source-module-closure live-module-closure guix-module-name?)) diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 78f09f181b..346ca4ea88 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,9 +27,11 @@ #:use-module (guix gexp) #:use-module (guix derivations) #:use-module (guix memoization) + #:use-module (guix modules) #:use-module ((guix build-system gnu) #:select (standard-packages)) #:use-module (gnu packages) #:use-module (guix sets) + #:use-module ((guix utils) #:select (location-file)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) @@ -44,6 +46,7 @@ %derivation-node-type %reference-node-type %referrer-node-type + %module-node-type %node-types guix-graph)) @@ -330,6 +333,36 @@ substitutes." (label store-path-package-name) (edges non-derivation-referrers))) + +;;; +;;; Scheme modules. +;;; + +(define (module-from-package package) + (file-name->module-name (location-file (package-location package)))) + +(define (source-module-dependencies* module) + "Like 'source-module-dependencies' but filter out modules that are not +package modules, while attempting to retain user package modules." + (remove (match-lambda + (('guix _ ...) #t) + (('system _ ...) #t) + (('language _ ...) #t) + (('ice-9 _ ...) #t) + (('srfi _ ...) #t) + (_ #f)) + (source-module-dependencies module))) + +(define %module-node-type + ;; Show the graph of package modules. + (node-type + (name "module") + (description "the graph of package modules") + (convert (lift1 (compose list module-from-package) %store-monad)) + (identifier (lift1 identity %store-monad)) + (label object->string) + (edges (lift1 source-module-dependencies* %store-monad)))) + ;;; ;;; List of node types. @@ -344,7 +377,8 @@ substitutes." %bag-emerged-node-type %derivation-node-type %reference-node-type - %referrer-node-type)) + %referrer-node-type + %module-node-type)) (define (lookup-node-type name) "Return the node type called NAME. Raise an error if it is not found." diff --git a/tests/graph.scm b/tests/graph.scm index 00fd37243c..5faa19298a 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -271,6 +271,24 @@ edges." (list txt out)) (equal? edges `((,txt ,out))))))))))) +(test-assert "module graph" + (let-values (((backend nodes+edges) (make-recording-backend))) + (run-with-store %store + (export-graph '((gnu packages guile)) 'port + #:node-type %module-node-type + #:backend backend)) + + (let-values (((nodes edges) (nodes+edges))) + (and (member '(gnu packages guile) + (match nodes + (((ids labels) ...) ids))) + (->bool (and (member (list '(gnu packages guile) + '(gnu packages libunistring)) + edges) + (member (list '(gnu packages guile) + '(gnu packages bdw-gc)) + edges))))))) + (test-assert "node-edges" (run-with-store %store (let ((packages (fold-packages cons '()))) -- cgit v1.2.3 From 8980eea5ab6f89e7649d9abf0be2a9d49156f7d2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 27 Mar 2018 14:16:19 +0200 Subject: guix gc: Add '--derivers'. * guix/scripts/gc.scm (show-help, %options): Add '--derivers'. (guix-gc): Handle 'list-derivers'. * tests/guix-gc.sh: Add test. * doc/guix.texi (Invoking guix gc): Document it. --- doc/guix.texi | 18 ++++++++++++++++++ guix/scripts/gc.scm | 10 +++++++++- tests/guix-gc.sh | 5 ++++- 3 files changed, 31 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 2204285516..c37a87d5a1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2642,6 +2642,24 @@ of these, recursively. In other words, the returned list is the of an element. @xref{Invoking guix graph}, for a tool to visualize the graph of references. +@item --derivers +@cindex derivation +Return the derivation(s) leading to the given store items +(@pxref{Derivations}). + +For example, this command: + +@example +guix gc --derivers `guix package -I ^emacs$ | cut -f4` +@end example + +@noindent +returns the @file{.drv} file(s) leading to the @code{emacs} package +installed in your profile. + +Note that there may be zero matching @file{.drv} files, for instance +because these files have been garbage-collected. There can also be more +than one matching @file{.drv} due to fixed-output derivations. @end table Lastly, the following options allow you to check the integrity of the diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index a31d2236b0..e4ed7227ff 100644 --- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2012, 2013, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -61,6 +61,8 @@ Invoke the garbage collector.\n")) -R, --requisites list the requisites of PATHS")) (display (G_ " --referrers list the referrers of PATHS")) + (display (G_ " + --derivers list the derivers of PATHS")) (newline) (display (G_ " --verify[=OPTS] verify the integrity of the store; OPTS is a @@ -153,6 +155,10 @@ Invoke the garbage collector.\n")) (lambda (opt name arg result) (alist-cons 'action 'list-referrers (alist-delete 'action result)))) + (option '("derivers") #f #f + (lambda (opt name arg result) + (alist-cons 'action 'list-derivers + (alist-delete 'action result)))) (option '("list-failures") #f #f (lambda (opt name arg result) (alist-cons 'action 'list-failures @@ -241,6 +247,8 @@ Invoke the garbage collector.\n")) (requisites store (list item))))) ((list-referrers) (list-relatives referrers)) + ((list-derivers) + (list-relatives valid-derivers)) ((optimize) (assert-no-extra-arguments) (optimize-store store)) diff --git a/tests/guix-gc.sh b/tests/guix-gc.sh index efbc7e759c..ef2d9543b7 100644 --- a/tests/guix-gc.sh +++ b/tests/guix-gc.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2013, 2015, 2017 Ludovic Courtès +# Copyright © 2013, 2015, 2017, 2018 Ludovic Courtès # # This file is part of GNU Guix. # @@ -54,6 +54,9 @@ guix gc --references "$out/bin/guile" if guix gc --references /dev/null; then false; else true; fi +# Check derivers. +guix gc --derivers "$out" | grep "$drv" + # Add then reclaim a .drv file. drv="`guix build idutils -d`" test -f "$drv" -- cgit v1.2.3 From 6fcb90eebd5e21a042ed9746fcbaa2040706ea71 Mon Sep 17 00:00:00 2001 From: Konrad Hinsen Date: Mon, 26 Mar 2018 16:29:24 +0200 Subject: guix environment: load manifest files like "guix package" does MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/scripts/environment.scm (options/resolve-packages): When loading manifest files, use the same module environment as in "guix package". Signed-off-by: Ludovic Courtès --- guix/scripts/environment.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 4f88c513c0..f8a9702b30 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -332,7 +332,7 @@ packages." (let ((module (make-user-module '()))) (packages->outputs (load* file module) mode))) (('manifest . file) - (let ((module (make-user-module '()))) + (let ((module (make-user-module '((guix profiles) (gnu))))) (manifest->outputs (load* file module)))) (_ '(#f))) opts))) -- cgit v1.2.3 From b3517f3f9f5815686600fb45a4e2350e168c0d54 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 28 Mar 2018 15:44:29 +0200 Subject: Add (guix ci). * guix/ci.scm: New file. * Makefile.am (MODULES): Add it. --- Makefile.am | 1 + guix/ci.scm | 78 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 79 insertions(+) create mode 100644 guix/ci.scm (limited to 'guix') diff --git a/Makefile.am b/Makefile.am index feb99490d3..e50d8430e5 100644 --- a/Makefile.am +++ b/Makefile.am @@ -115,6 +115,7 @@ MODULES = \ guix/build-system/trivial.scm \ guix/ftp-client.scm \ guix/http-client.scm \ + guix/ci.scm \ guix/gnupg.scm \ guix/elf.scm \ guix/profiling.scm \ diff --git a/guix/ci.scm b/guix/ci.scm new file mode 100644 index 0000000000..881f3d3927 --- /dev/null +++ b/guix/ci.scm @@ -0,0 +1,78 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 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 ci) + #:use-module (guix http-client) + #:autoload (json parser) (json->scm) + #:use-module (srfi srfi-9) + #:export (build? + build-id + build-derivation + build-system + build-status + build-timestamp + + %query-limit + queued-builds + latest-builds)) + +;;; Commentary: +;;; +;;; This module provides a client to the HTTP interface of the Hydra and +;;; Cuirass continuous integration (CI) tools. +;;; +;;; Code: + +(define-record-type + (make-build id derivation system status timestamp) + build? + (id build-id) ;integer + (derivation build-derivation) ;string | #f + (system build-system) ;string + (status build-status) ;integer + (timestamp build-timestamp)) ;integer + +(define %query-limit + ;; Max number of builds requested in queries. + 1000) + +(define (json-fetch url) + (let* ((port (http-fetch url)) + (json (json->scm port))) + (close-port port) + json)) + +(define (json->build json) + (make-build (hash-ref json "id") + (hash-ref json "derivation") + (hash-ref json "system") + (hash-ref json "buildstatus") + (hash-ref json "timestamp"))) + +(define* (queued-builds url #:optional (limit %query-limit)) + "Return the list of queued derivations on URL." + (let ((queue (json-fetch (string-append url "/api/queue?nr=" + (number->string limit))))) + (map json->build queue))) + +(define* (latest-builds url #:optional (limit %query-limit)) + (let ((latest (json-fetch (string-append url "/api/latestbuilds?nr=" + (number->string limit))))) + ;; Note: Hydra does not provide a "derivation" field for entries in + ;; 'latestbuilds', but Cuirass does. + (map json->build latest))) -- cgit v1.2.3 From 183445a6ed1cbac929ecb65303246945c8ccf39d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 28 Mar 2018 15:49:11 +0200 Subject: weather: Report continuous integration stats. * guix/scripts/weather.scm (histogram, throughput, queued-subset): New procedures. (report-server-coverage): Report CI information. * doc/guix.texi (Invoking guix weather): Document it. --- doc/guix.texi | 14 +++++- guix/scripts/weather.scm | 109 ++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 120 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index c37a87d5a1..d112b373c1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -7912,15 +7912,27 @@ https://guix.example.org 19,824.2 MiB on disk (uncompressed) 0.030 seconds per request (182.9 seconds in total) 33.5 requests per second + + 9.8% (342 out of 3,470) of the missing items are queued + 867 queued builds + x86_64-linux: 518 (59.7%) + i686-linux: 221 (25.5%) + aarch64-linux: 128 (14.8%) + build rate: 23.41 builds per hour + x86_64-linux: 11.16 builds per hour + i686-linux: 6.03 builds per hour + aarch64-linux: 6.41 builds per hour @end example +@cindex continuous integration, statistics As you can see, it reports the fraction of all the packages for which substitutes are available on the server---regardless of whether substitutes are enabled, and regardless of whether this server's signing key is authorized. It also reports the size of the compressed archives (``nars'') provided by the server, the size the corresponding store items occupy in the store (assuming deduplication is turned off), and -the server's throughput. +the server's throughput. The second part gives continuous integration +(CI) statistics, if the server supports it. To achieve that, @command{guix weather} queries over HTTP(S) meta-data (@dfn{narinfos}) for all the relevant store items. Like @command{guix diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm index 2e782e36ce..5c934abaef 100644 --- a/guix/scripts/weather.scm +++ b/guix/scripts/weather.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Ludovic Courtès +;;; Copyright © 2017, 2018 Ludovic Courtès ;;; Copyright © 2017 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. @@ -29,11 +29,14 @@ #:use-module (guix grafts) #:use-module ((guix build syscalls) #:select (terminal-columns)) #:use-module (guix scripts substitute) + #:use-module (guix http-client) + #:use-module (guix ci) #:use-module (gnu packages) #:use-module (web uri) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) #:use-module (ice-9 match) #:use-module (ice-9 format) @@ -100,6 +103,57 @@ values." (define-syntax-rule (let/time ((time result exp)) body ...) (call-with-time (lambda () exp) (lambda (time result) body ...))) +(define (histogram field proc seed lst) + "Return an alist giving a histogram of all the values of FIELD for elements +of LST. FIELD must be a one element procedure that returns a field's value. +For each FIELD value, call PROC with the previous field-specific result. +Example: + + (histogram car (lambda (x n) (+ 1 n)) 0 '((a . x)(b . y)(a . z))) + => ((a . 2) (b . 1)) + +meaning that we have two a's and one b." + (let loop ((lst lst) + (result '())) + (match lst + (() + result) + ((head . tail) + (let ((value (field head))) + (loop tail + (match (assoc-ref result value) + (#f + `((,value . ,(proc head seed)) ,@result)) + (previous + `((,value . ,(proc head previous)) + ,@(alist-delete value result)))))))))) + +(define (throughput lst timestamp) + "Return the throughput, in items per second, given the elements of LST, +calling TIMESTAMP to get the \"timestamp\" of each item." + (let ((oldest (reduce min +inf.0 (map build-timestamp lst))) + (now (time-second (current-time time-utc)))) + (/ (length lst) (- now oldest) 1.))) + +(define (queued-subset queue items) + "Return the subset of ITEMS, a list of store file names, that appears in +QUEUE, a list of builds. Return #f if elements in QUEUE lack information +about the derivations queued, as is the case with Hydra." + (define queued + (append-map (lambda (build) + (match (false-if-exception + (read-derivation-from-file (build-derivation build))) + (#f + '()) + (drv + (match (derivation->output-paths drv) + (((names . items) ...) items))))) + queue)) + + (if (any (negate build-derivation) queue) + #f ;no derivation information + (lset-intersection string=? queued items))) + (define (report-server-coverage server items) "Report the subset of ITEMS available as substitutes on SERVER." (define MiB (* (expt 2 20) 1.)) @@ -111,6 +165,8 @@ values." (format #t "~a~%" server) (let ((obtained (length narinfos)) (requested (length items)) + (missing (lset-difference string=? + items (map narinfo-path narinfos))) (sizes (filter-map narinfo-file-size narinfos)) (time (+ (time-second time) (/ (time-nanosecond time) 1e9)))) @@ -131,7 +187,56 @@ values." (format #t (G_ " ~,3h seconds per request (~,1h seconds in total)~%") (/ time requested 1.) time) (format #t (G_ " ~,1h requests per second~%") - (/ requested time 1.))))) + (/ requested time 1.)) + + (guard (c ((http-get-error? c) + (if (= 404 (http-get-error-code c)) + (format (current-error-port) + (G_ " (continuous integration information \ +unavailable)~%")) + (format (current-error-port) + (G_ " '~a' returned ~a (~s)~%") + (uri->string (http-get-error-uri c)) + (http-get-error-code c) + (http-get-error-reason c))))) + (let* ((max %query-limit) + (queue (queued-builds server max)) + (len (length queue)) + (histo (histogram build-system + (lambda (build count) + (+ 1 count)) + 0 queue))) + (newline) + (unless (null? missing) + (let ((missing (length missing))) + (match (queued-subset queue missing) + (#f #f) + ((= length queued) + (format #t (G_ " ~,1f% (~h out of ~h) of the missing items \ +are queued~%") + (* 100. (/ queued missing)) + queued missing))))) + + (if (>= len max) + (format #t (G_ " at least ~h queued builds~%") len) + (format #t (G_ " ~h queued builds~%") len)) + (for-each (match-lambda + ((system . count) + (format #t (G_ " ~a: ~a (~0,1f%)~%") + system count (* 100. (/ count len))))) + histo)) + + (let* ((latest (latest-builds server)) + (builds/sec (throughput latest build-timestamp))) + (format #t (G_ " build rate: ~1,2f builds per hour~%") + (* builds/sec 3600.)) + (for-each (match-lambda + ((system . builds) + (format #t (G_ " ~a: ~,2f builds per hour~%") + system + (* (throughput builds build-timestamp) + 3600.)))) + (histogram build-system cons '() latest))))))) ;;; -- cgit v1.2.3 From f342bb58fef34d2b1364a9fac1d882ffcd329904 Mon Sep 17 00:00:00 2001 From: Nikolai Merinov Date: Wed, 14 Mar 2018 00:06:53 +0500 Subject: gnu: rust: Update rust to 1.24.1. * gnu/packages/rust.scm (rust-bootstrap): Freeze bootstrap version to 1.22.1. Reorganize bootstrap binaries to match new "rust" package structure with two ouputs "out" with Rust compiler and "cargo" with Cargo package manager. Replace all "system*" by "invoke". (rust-1.23): Rename "rustc" to "rust". Update sha256 for tarball. Add cargo related dependencies. Install "cargo" as separate "rust" output. Remove substitutes for parts that were fixed in "rustc" source code. Install documentation to separate "doc" output. Update configuration according to changes in "rustc" source code. Replace all "system*" by "invoke". (rust): Create package for 1.24.1 rust release based on rust-1.23 release. * guix/build-system/cargo.scm (default-rust): Replace "default-cargo" and "default-rustc" functions with "default-rust" function. (cargo-build-system): Take only one package as "rust" source. Use "rustc" of default output of "rust" package, use "cargo" as "cargo" output of "rust" package. --- gnu/packages/rust.scm | 1374 ++++--------------------------------------- guix/build-system/cargo.scm | 21 +- 2 files changed, 127 insertions(+), 1268 deletions(-) (limited to 'guix') diff --git a/gnu/packages/rust.scm b/gnu/packages/rust.scm index 7d0eb70875..70140579b6 100644 --- a/gnu/packages/rust.scm +++ b/gnu/packages/rust.scm @@ -3,7 +3,7 @@ ;;; Copyright © 2016 Eric Le Bihan ;;; Copyright © 2016 Nils Gillmann ;;; Copyright © 2017 Ben Woodcroft -;;; Copyright © 2017 Nikolai Merinov +;;; Copyright © 2017, 2018 Nikolai Merinov ;;; Copyright © 2017 Efraim Flashner ;;; Copyright © 2018 Tobias Geerinckx-Rice ;;; @@ -46,71 +46,48 @@ #:use-module (guix build-system gnu) #:use-module (guix build-system trivial) #:use-module (guix download) - #:use-module (guix base16) ;for generated "cargo" native-inputs #:use-module ((guix licenses) #:prefix license:) #:use-module (guix packages) + #:use-module ((guix build utils) #:select (alist-replace)) + #:use-module (guix utils) #:use-module (ice-9 match) #:use-module (srfi srfi-26)) -;; Should be one less than the current released version. -(define %rust-bootstrap-binaries-version "1.21.0") - -(define %rust-bootstrap-binaries - (origin - (method url-fetch) - (uri (string-append - "https://static.rust-lang.org/dist/" - "rust-" %rust-bootstrap-binaries-version - "-" %host-type ".tar.gz")) - (sha256 - (base32 - (match %host-type - ("i686-unknown-linux-gnu" - "1vnvqwz30hvyjcfr1f602lg43v2vlqjr3yhb5vr8xnrcc07yvjmp") - ("x86_64-unknown-linux-gnu" - "1s0866qcy0645bqhsbs3pvk2hi52ps8jzs7x096w0as033h707ml") - ("armv7-unknown-linux-gnueabihf" - "1ml8fjq2b6j2vn1j314w93pf4wjl97n1mbz609h3i7md0zqscvs1") - ("aarch64-unknown-linux-gnu" - "1hv4m2m7xjcph39r6baryfg23hjcr4sbsrfnd1lh0wn67k2fc7j9") - ("mips64el-unknown-linux-gnuabi64" - "0p7fzkfcqg5yvj86v434z351dp7s7pgns8nzxj0fz3hmbfbvlvn9") - (_ "")))))) ; Catch-all for other systems. - (define %cargo-reference-project-file "/dev/null") (define %cargo-reference-hash "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855") -(define (increment-rust-version rust-version major patch) - (match (string-split rust-version #\.) - (("1" minor _) - (string-append (number->string major) "." - (number->string (+ (string->number minor) 1)) "." - (number->string patch))))) - -(define* (cargo-version rustc-version #:optional (patch 0)) - ;; Computes the cargo version that matches the rustc version. - ;; This has so far continued to follow a predictable pattern: - ;; https://github.com/rust-lang/cargo/blob/50a46f47/README.md#releases - (increment-rust-version rustc-version 0 patch)) - -(define* (rustc-version bootstrap-version #:optional (patch 0)) - ;; Computes the rustc version that can be compiled from a given - ;; other rustc version. The patch argument is for selecting - ;; a stability or security fix. 1.11.0 -> 1.12.1 -> 1.13.0 - (increment-rust-version bootstrap-version 1 patch)) - -(define rustc-bootstrap +(define rust-bootstrap (package - (name "rustc-bootstrap") - (version %rust-bootstrap-binaries-version) - (source %rust-bootstrap-binaries) + (name "rust-bootstrap") + (version "1.22.1") + (source (origin + (method url-fetch) + (uri (string-append + "https://static.rust-lang.org/dist/" + "rust-" version "-" %host-type ".tar.gz")) + (sha256 + (base32 + (match %host-type + ("i686-unknown-linux-gnu" + "15zqbx86nm13d5vq2gm69b7av4vg479f74b5by64hs3bcwwm08pr") + ("x86_64-unknown-linux-gnu" + "1yll78x6b3abnvgjf2b66gvp6mmcb9y9jdiqcwhmgc0z0i0fix4c") + ("armv7-unknown-linux-gnueabihf" + "138a8l528kzp5wyk1mgjaxs304ac5ms8vlpq0ggjaznm6bn2j7a5") + ("aarch64-unknown-linux-gnu" + "0z6m9m1rx4d96nvybbfmpscq4dv616m615ijy16d5wh2vx0p4na8") + ("mips64el-unknown-linux-gnuabi64" + "07k4pcv7jvfa48cscdj8752lby7m7xdl88v3a6na1vs675lhgja2") + (_ "")))))) (build-system gnu-build-system) (native-inputs `(("patchelf" ,patchelf))) (inputs - `(("gcc:lib" ,(canonical-package gcc) "lib") + `(("gcc" ,(canonical-package gcc)) + ("gcc:lib" ,(canonical-package gcc) "lib") ("zlib" ,zlib))) + (outputs '("out" "cargo")) (arguments `(#:tests? #f #:strip-binaries? #f @@ -121,115 +98,63 @@ (replace 'install (lambda* (#:key inputs outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) + (cargo-out (assoc-ref outputs "cargo")) (gcc:lib (assoc-ref inputs "gcc:lib")) (libc (assoc-ref inputs "libc")) (zlib (assoc-ref inputs "zlib")) (ld-so (string-append libc ,(glibc-dynamic-linker))) (rpath (string-append out "/lib:" zlib "/lib:" libc "/lib:" gcc:lib "/lib")) + (cargo-rpath (string-append cargo-out "/lib:" libc "/lib:" + gcc:lib "/lib")) (rustc (string-append out "/bin/rustc")) - (rustdoc (string-append out "/bin/rustdoc"))) - (system* "bash" "install.sh" + (rustdoc (string-append out "/bin/rustdoc")) + (cargo (string-append cargo-out "/bin/cargo")) + (gcc (assoc-ref inputs "gcc"))) + ;; Install rustc/rustdoc + (invoke "bash" "install.sh" (string-append "--prefix=" out) (string-append "--components=rustc," "rust-std-" %host-type)) + ;; Instal cargo + (invoke "bash" "install.sh" + (string-append "--prefix=" cargo-out) + (string-append "--components=cargo")) (for-each (lambda (file) - (system* "patchelf" "--set-rpath" rpath file)) + (invoke "patchelf" "--set-rpath" rpath file)) (cons* rustc rustdoc (find-files out "\\.so$"))) + (invoke "patchelf" "--set-rpath" cargo-rpath cargo) (for-each (lambda (file) - (system* "patchelf" "--set-interpreter" ld-so file)) - (list rustc rustdoc)))))))) - (home-page "https://www.rust-lang.org") - (synopsis "Prebuilt rust compiler") - (description "This package provides a pre-built @command{rustc} compiler, -which can in turn be used to build the final Rust compiler.") - (license license:asl2.0))) - -(define cargo-bootstrap - (package - (name "cargo-bootstrap") - (version (cargo-version %rust-bootstrap-binaries-version 1)) - (source %rust-bootstrap-binaries) - (build-system gnu-build-system) - (native-inputs - `(("patchelf" ,patchelf))) - (inputs - `(("gcc:lib" ,(canonical-package gcc) "lib"))) - (arguments - `(#:tests? #f - #:strip-binaries? #f - #:phases - (modify-phases %standard-phases - (delete 'configure) - (delete 'build) - (replace 'install - (lambda* (#:key inputs outputs #:allow-other-keys) - (let* ((out (assoc-ref outputs "out")) - (gcc:lib (assoc-ref inputs "gcc:lib")) - (libc (assoc-ref inputs "libc")) - (ld-so (string-append libc ,(glibc-dynamic-linker))) - (rpath (string-append out "/lib:" libc "/lib:" - gcc:lib "/lib")) - (cargo (string-append out "/bin/cargo"))) - (system* "bash" "install.sh" - (string-append "--prefix=" out) - "--components=cargo") - (system* "patchelf" - "--set-interpreter" ld-so - "--set-rpath" rpath - cargo))))))) + (invoke "patchelf" "--set-interpreter" ld-so file)) + (list rustc rustdoc cargo)) + ;; Rust requires a C toolchain for linking. The prebuilt + ;; binaries expect a compiler called cc. Thus symlink gcc + ;; to cc. + (symlink (string-append gcc "/bin/gcc") + (string-append out "/bin/cc")) + #t)))))) (home-page "https://www.rust-lang.org") - (synopsis "Prebuilt cargo package manager") - (description "This package provides a pre-built @command{cargo} package -manager, which is required to build itself.") + (synopsis "Prebuilt rust compiler and cargo package manager") + (description "This package provides a pre-built @command{rustc} compiler +and a pre-built @command{cargo} package manaer, which can +in turn be used to build the final Rust.") (license license:asl2.0))) -(define rust-bootstrap - (package - (name "rust-bootstrap") - (version %rust-bootstrap-binaries-version) - (source #f) - (build-system trivial-build-system) - (propagated-inputs - `(("rustc-bootstrap" ,rustc-bootstrap) - ("cargo-bootstrap" ,cargo-bootstrap) - ("gcc" ,(canonical-package gcc)))) - (arguments - `(#:modules ((guix build utils)) - #:builder - (begin - (use-modules (guix build utils)) - (let ((out (assoc-ref %outputs "out")) - (gcc (assoc-ref %build-inputs "gcc"))) - (mkdir-p (string-append out "/bin")) - ;; Rust requires a C toolchain for linking. The prebuilt - ;; binaries expect a compiler called cc. Thus symlink gcc - ;; to cc. - (symlink (string-append gcc "/bin/gcc") - (string-append out "/bin/cc")))))) - (home-page "https://www.rust-lang.org") - (synopsis "Rust bootstrapping meta package") - (description "Meta package for a rust environment. Provides pre-compiled -rustc-bootstrap and cargo-bootstrap packages.") - (license license:asl2.0))) -(define-public rustc +(define (rust-source version hash) + (origin + (method url-fetch) + (uri (string-append "https://static.rust-lang.org/dist/" + "rustc-" version "-src.tar.gz")) + (sha256 (base32 hash)) + (modules '((guix build utils))) + (snippet '(begin (delete-file-recursively "src/llvm") #t)))) + +(define-public rust-1.23 (package - (name "rustc") - (version (rustc-version %rust-bootstrap-binaries-version 1)) - (source (origin - (method url-fetch) - (uri (string-append - "https://static.rust-lang.org/dist/" - "rustc-" version "-src.tar.gz")) - (sha256 - (base32 - "1lrzzp0nh7s61wgfs2h6ilaqi6iq89f1pd1yaf65l87bssyl4ylb")) - (modules '((guix build utils))) - (snippet - `(begin - (delete-file-recursively "src/llvm") - #t)))) + (name "rust") + (version "1.23.0") + (source (rust-source version "14fb8vhjzsxlbi6yrn1r6fl5dlbdd1m92dn5zj5gmzfwf4w9ar3l")) (build-system gnu-build-system) (native-inputs `(("bison" ,bison) ; For the tests @@ -239,11 +164,16 @@ rustc-bootstrap and cargo-bootstrap packages.") ("git" ,git) ("procps" ,procps) ; For the tests ("python-2" ,python-2) - ("rust-bootstrap" ,rust-bootstrap) + ("rustc-bootstrap" ,rust-bootstrap) + ("cargo-bootstrap" ,rust-bootstrap "cargo") + ("pkg-config" ,pkg-config) ; For "cargo" ("which" ,which))) (inputs `(("jemalloc" ,jemalloc-4.5.0) - ("llvm" ,llvm-3.9.1))) + ("llvm" ,llvm-3.9.1) + ("openssl" ,openssl) + ("libcurl" ,curl))) ; For "cargo" + (outputs '("out" "doc" "cargo")) (arguments `(#:imported-modules ,%cargo-build-system-modules ;for `generate-checksums' #:phases @@ -258,9 +188,6 @@ rustc-bootstrap and cargo-bootstrap packages.") (add-after 'unpack 'patch-tests (lambda* (#:key inputs #:allow-other-keys) (let ((bash (assoc-ref inputs "bash"))) - (substitute* "src/build_helper/lib.rs" - ;; In same folder as gcc there is only "gcc-ar" utility - (("file\\.push_str\\(\"ar\"\\);") "file.push_str(\"gcc-ar\");")) (substitute* "src/libstd/process.rs" ;; The newline is intentional. ;; There's a line length "tidy" check in Rust which would @@ -276,15 +203,18 @@ rustc-bootstrap and cargo-bootstrap packages.") ;; Our ld-wrapper cannot process non-UTF8 bytes in LIBRARY_PATH. ;; (delete-file-recursively "src/test/run-make/linker-output-non-utf8") - (substitute* "src/build_helper/lib.rs" - ;; Bug in Rust code. - ;; Current implementation assume that if dst not exist then it's mtime - ;; is 0, but in same time "src" have 0 mtime in guix build! - (("let threshold = mtime\\(dst\\);") - "if !dst.exists() {\nreturn false\n}\n let threshold = mtime(dst);")) #t))) + (add-after 'patch-tests 'fix-mtime-bug + (lambda* _ + (substitute* "src/build_helper/lib.rs" + ;; Bug in Rust code. + ;; Current implementation assume that if dst not exist then it's mtime + ;; is 0, but in same time "src" have 0 mtime in guix build! + (("let threshold = mtime\\(dst\\);") + "if !dst.exists() {\nreturn false\n}\n let threshold = mtime(dst);")) + #t)) (add-after 'patch-source-shebangs 'patch-cargo-checksums - (lambda* (#:key inputs #:allow-other-keys) + (lambda* _ (substitute* "src/Cargo.lock" (("(\"checksum .* = )\".*\"" all name) (string-append name "\"" ,%cargo-reference-hash "\""))) @@ -302,6 +232,7 @@ rustc-bootstrap and cargo-bootstrap packages.") (replace 'configure (lambda* (#:key inputs outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) + (doc (assoc-ref outputs "doc")) (gcc (assoc-ref inputs "gcc")) (gdb (assoc-ref inputs "gdb")) (binutils (assoc-ref inputs "binutils")) @@ -317,15 +248,18 @@ rustc-bootstrap and cargo-bootstrap packages.") [build] cargo = \"" cargo "/bin/cargo" "\" rustc = \"" rustc "/bin/rustc" "\" +docs = true python = \"" python "/bin/python2" "\" gdb = \"" gdb "/bin/gdb" "\" vendor = true submodules = false [install] prefix = \"" out "\" +docdir = \"" doc "/share/doc/rust" "\" +sysconfdir = \"etc\" +localstatedir = \"var/lib\" [rust] default-linker = \"" gcc "/bin/gcc" "\" -default-ar = \"" binutils "/bin/ar" "\" channel = \"stable\" rpath = true # There is 2 failed codegen tests: @@ -336,12 +270,13 @@ codegen-tests = false llvm-config = \"" llvm "/bin/llvm-config" "\" cc = \"" gcc "/bin/gcc" "\" cxx = \"" gcc "/bin/g++" "\" +ar = \"" binutils "/bin/ar" "\" jemalloc = \"" jemalloc "/lib/libjemalloc_pic.a" "\" [dist] ") port))) #t))) (add-before 'build 'reset-timestamps-after-changes - (lambda* (#:key inputs outputs #:allow-other-keys) + (lambda* _ (define ref (stat "README.md")) (for-each (lambda (filename) @@ -349,14 +284,21 @@ jemalloc = \"" jemalloc "/lib/libjemalloc_pic.a" "\" (find-files "." #:directories? #t)) #t)) (replace 'build - (lambda* (#:key inputs outputs #:allow-other-keys) - (zero? (system* "./x.py" "build")))) + (lambda* _ + (invoke "./x.py" "build") + (invoke "./x.py" "build" "src/tools/cargo"))) (replace 'check - (lambda* (#:key inputs outputs #:allow-other-keys) - (zero? (system* "./x.py" "test")))) + (lambda* _ + (invoke "./x.py" "test"))) (replace 'install - (lambda* (#:key inputs outputs #:allow-other-keys) - (zero? (system* "./x.py" "install")))) + (lambda* (#:key outputs #:allow-other-keys) + (invoke "./x.py" "install") + (substitute* "config.toml" + ;; replace prefix to specific output + (("prefix = \"[^\"]*\"") + (string-append "prefix = \"" (assoc-ref outputs "cargo") "\""))) + (invoke "./x.py" "install" "cargo") + #t)) (add-after 'install 'wrap-rustc (lambda* (#:key inputs outputs #:allow-other-keys) (let ((out (assoc-ref outputs "out")) @@ -376,1095 +318,19 @@ safety and thread safety guarantees.") ;; Dual licensed. (license (list license:asl2.0 license:expat)))) -;; This tries very hard not to get into a cyclic dependency like this: -;; cargo <- cargo-build-system <- cargo. -(define-public cargo - (package - (name "cargo") - (version (cargo-version (rustc-version %rust-bootstrap-binaries-version) 0)) - (source (origin - (method url-fetch) - (uri (string-append "https://github.com/rust-lang/cargo/archive/" - version ".tar.gz")) - (file-name (string-append name "-" version ".tar.gz")) - (sha256 - (base32 - "0kr7rml7v2bm7zl8jcb3056h63zpyy9m08s212i8vfwxf6lf5fzl")))) - (build-system cargo-build-system) - (propagated-inputs - `(("cmake" ,cmake) - ("pkg-config" ,pkg-config))) - (inputs - `(("curl" ,curl) - ("libgit2" ,libgit2) - ("libssh2" ,libssh2) - ("openssl" ,openssl) - ("python-2" ,python-2) - ("zlib" ,zlib))) - (native-inputs - `(("git" ,git) ; required for tests - ;; Next dependencies generated with next command: - ;; cat Cargo.lock | awk ' - ;; /^"checksum/ - ;; { oname=name=$2; vers=$3; hash=$6; - ;; if (ns[name] != 1) { ns[name]=1; } else { name = name "-" vers; } - ;; print " (\"rust-" name "\""; - ;; print " ,(origin"; - ;; print " (method url-fetch)"; - ;; print " (uri (crate-uri \"" oname "\" \"" vers "\"))"; - ;; print " (file-name \"rust-" oname "\-\" vers "\") - ;; print " (sha256"; - ;; print " (base16-string->bytevector"; - ;; print " " hash "))))" - ;; }' - ("rust-advapi32-sys" - ,(origin - (method url-fetch) - (uri (crate-uri "advapi32-sys" "0.2.0")) - (file-name "rust-advapi32-sys-0.2.0") - (sha256 - (base16-string->bytevector - "e06588080cb19d0acb6739808aafa5f26bfb2ca015b2b6370028b44cf7cb8a9a")))) - ("rust-aho-corasick" - ,(origin - (method url-fetch) - (uri (crate-uri "aho-corasick" "0.5.3")) - (file-name "rust-aho-corasick-0.5.3") - (sha256 - (base16-string->bytevector - "ca972c2ea5f742bfce5687b9aef75506a764f61d37f8f649047846a9686ddb66")))) - ("rust-aho-corasick-0.6.3" - ,(origin - (method url-fetch) - (uri (crate-uri "aho-corasick" "0.6.3")) - (file-name "rust-aho-corasick-0.6.3") - (sha256 - (base16-string->bytevector - "500909c4f87a9e52355b26626d890833e9e1d53ac566db76c36faa984b889699")))) - ("rust-atty" - ,(origin - (method url-fetch) - (uri (crate-uri "atty" "0.2.3")) - (file-name "rust-atty-0.2.3") - (sha256 - (base16-string->bytevector - "21e50800ec991574876040fff8ee46b136a53e985286fbe6a3bdfe6421b78860")))) - ("rust-backtrace" - ,(origin - (method url-fetch) - (uri (crate-uri "backtrace" "0.3.3")) - (file-name "rust-backtrace-0.3.3") - (sha256 - (base16-string->bytevector - "99f2ce94e22b8e664d95c57fff45b98a966c2252b60691d0b7aeeccd88d70983")))) - ("rust-backtrace-sys" - ,(origin - (method url-fetch) - (uri (crate-uri "backtrace-sys" "0.1.14")) - (file-name "rust-backtrace-sys-0.1.14") - (sha256 - (base16-string->bytevector - "c63ea141ef8fdb10409d0f5daf30ac51f84ef43bff66f16627773d2a292cd189")))) - ("rust-bitflags" - ,(origin - (method url-fetch) - (uri (crate-uri "bitflags" "0.7.0")) - (file-name "rust-bitflags-0.7.0") - (sha256 - (base16-string->bytevector - "aad18937a628ec6abcd26d1489012cc0e18c21798210f491af69ded9b881106d")))) - ("rust-bitflags-0.9.1" - ,(origin - (method url-fetch) - (uri (crate-uri "bitflags" "0.9.1")) - (file-name "rust-bitflags-0.9.1") - (sha256 - (base16-string->bytevector - "4efd02e230a02e18f92fc2735f44597385ed02ad8f831e7c1c1156ee5e1ab3a5")))) - ("rust-bufstream" - ,(origin - (method url-fetch) - (uri (crate-uri "bufstream" "0.1.3")) - (file-name "rust-bufstream-0.1.3") - (sha256 - (base16-string->bytevector - "f2f382711e76b9de6c744cc00d0497baba02fb00a787f088c879f01d09468e32")))) - ("rust-cc" - ,(origin - (method url-fetch) - (uri (crate-uri "cc" "1.0.0")) - (file-name "rust-cc-1.0.0") - (sha256 - (base16-string->bytevector - "7db2f146208d7e0fbee761b09cd65a7f51ccc38705d4e7262dad4d73b12a76b1")))) - ("rust-cfg-if" - ,(origin - (method url-fetch) - (uri (crate-uri "cfg-if" "0.1.2")) - (file-name "rust-cfg-if-0.1.2") - (sha256 - (base16-string->bytevector - "d4c819a1287eb618df47cc647173c5c4c66ba19d888a6e50d605672aed3140de")))) - ("rust-cmake" - ,(origin - (method url-fetch) - (uri (crate-uri "cmake" "0.1.26")) - (file-name "rust-cmake-0.1.26") - (sha256 - (base16-string->bytevector - "357c07e7a1fc95732793c1edb5901e1a1f305cfcf63a90eb12dbd22bdb6b789d")))) - ("rust-commoncrypto" - ,(origin - (method url-fetch) - (uri (crate-uri "commoncrypto" "0.2.0")) - (file-name "rust-commoncrypto-0.2.0") - (sha256 - (base16-string->bytevector - "d056a8586ba25a1e4d61cb090900e495952c7886786fc55f909ab2f819b69007")))) - ("rust-commoncrypto-sys" - ,(origin - (method url-fetch) - (uri (crate-uri "commoncrypto-sys" "0.2.0")) - (file-name "rust-commoncrypto-sys-0.2.0") - (sha256 - (base16-string->bytevector - "1fed34f46747aa73dfaa578069fd8279d2818ade2b55f38f22a9401c7f4083e2")))) - ("rust-conv" - ,(origin - (method url-fetch) - (uri (crate-uri "conv" "0.3.3")) - (file-name "rust-conv-0.3.3") - (sha256 - (base16-string->bytevector - "78ff10625fd0ac447827aa30ea8b861fead473bb60aeb73af6c1c58caf0d1299")))) - ("rust-core-foundation" - ,(origin - (method url-fetch) - (uri (crate-uri "core-foundation" "0.4.4")) - (file-name "rust-core-foundation-0.4.4") - (sha256 - (base16-string->bytevector - "5909502e547762013619f4c4e01cc7393c20fe2d52d7fa471c1210adb2320dc7")))) - ("rust-core-foundation-sys" - ,(origin - (method url-fetch) - (uri (crate-uri "core-foundation-sys" "0.4.4")) - (file-name "rust-core-foundation-sys-0.4.4") - (sha256 - (base16-string->bytevector - "bc9fb3d6cb663e6fd7cf1c63f9b144ee2b1e4a78595a0451dd34bff85b9a3387")))) - ("rust-crossbeam" - ,(origin - (method url-fetch) - (uri (crate-uri "crossbeam" "0.2.10")) - (file-name "rust-crossbeam-0.2.10") - (sha256 - (base16-string->bytevector - "0c5ea215664ca264da8a9d9c3be80d2eaf30923c259d03e870388eb927508f97")))) - ("rust-crossbeam-0.3.0" - ,(origin - (method url-fetch) - (uri (crate-uri "crossbeam" "0.3.0")) - (file-name "rust-crossbeam-0.3.0") - (sha256 - (base16-string->bytevector - "8837ab96533202c5b610ed44bc7f4183e7957c1c8f56e8cc78bb098593c8ba0a")))) - ("rust-crypto-hash" - ,(origin - (method url-fetch) - (uri (crate-uri "crypto-hash" "0.3.0")) - (file-name "rust-crypto-hash-0.3.0") - (sha256 - (base16-string->bytevector - "34903878eec1694faf53cae8473a088df333181de421d4d3d48061d6559fe602")))) - ("rust-curl" - ,(origin - (method url-fetch) - (uri (crate-uri "curl" "0.4.8")) - (file-name "rust-curl-0.4.8") - (sha256 - (base16-string->bytevector - "7034c534a1d7d22f7971d6088aa9d281d219ef724026c3428092500f41ae9c2c")))) - ("rust-curl-sys" - ,(origin - (method url-fetch) - (uri (crate-uri "curl-sys" "0.3.15")) - (file-name "rust-curl-sys-0.3.15") - (sha256 - (base16-string->bytevector - "4bee31aa3a079d5f3ff9579ea4dcfb1b1a17a40886f5f467436d383e78134b55")))) - ("rust-custom_derive" - ,(origin - (method url-fetch) - (uri (crate-uri "custom_derive" "0.1.7")) - (file-name "rust-custom_derive-0.1.7") - (sha256 - (base16-string->bytevector - "ef8ae57c4978a2acd8b869ce6b9ca1dfe817bff704c220209fdef2c0b75a01b9")))) - ("rust-dbghelp-sys" - ,(origin - (method url-fetch) - (uri (crate-uri "dbghelp-sys" "0.2.0")) - (file-name "rust-dbghelp-sys-0.2.0") - (sha256 - (base16-string->bytevector - "97590ba53bcb8ac28279161ca943a924d1fd4a8fb3fa63302591647c4fc5b850")))) - ("rust-docopt" - ,(origin - (method url-fetch) - (uri (crate-uri "docopt" "0.8.1")) - (file-name "rust-docopt-0.8.1") - (sha256 - (base16-string->bytevector - "3b5b93718f8b3e5544fcc914c43de828ca6c6ace23e0332c6080a2977b49787a")))) - ("rust-dtoa" - ,(origin - (method url-fetch) - (uri (crate-uri "dtoa" "0.4.2")) - (file-name "rust-dtoa-0.4.2") - (sha256 - (base16-string->bytevector - "09c3753c3db574d215cba4ea76018483895d7bff25a31b49ba45db21c48e50ab")))) - ("rust-env_logger" - ,(origin - (method url-fetch) - (uri (crate-uri "env_logger" "0.4.3")) - (file-name "rust-env_logger-0.4.3") - (sha256 - (base16-string->bytevector - "3ddf21e73e016298f5cb37d6ef8e8da8e39f91f9ec8b0df44b7deb16a9f8cd5b")))) - ("rust-error-chain" - ,(origin - (method url-fetch) - (uri (crate-uri "error-chain" "0.11.0")) - (file-name "rust-error-chain-0.11.0") - (sha256 - (base16-string->bytevector - "ff511d5dc435d703f4971bc399647c9bc38e20cb41452e3b9feb4765419ed3f3")))) - ("rust-filetime" - ,(origin - (method url-fetch) - (uri (crate-uri "filetime" "0.1.12")) - (file-name "rust-filetime-0.1.12") - (sha256 - (base16-string->bytevector - "6ab199bf38537c6f38792669e081e0bb278b9b7405bba2642e4e5d15bf732c0e")))) - ("rust-flate2" - ,(origin - (method url-fetch) - (uri (crate-uri "flate2" "0.2.20")) - (file-name "rust-flate2-0.2.20") - (sha256 - (base16-string->bytevector - "e6234dd4468ae5d1e2dbb06fe2b058696fdc50a339c68a393aefbf00bc81e423")))) - ("rust-fnv" - ,(origin - (method url-fetch) - (uri (crate-uri "fnv" "1.0.5")) - (file-name "rust-fnv-1.0.5") - (sha256 - (base16-string->bytevector - "6cc484842f1e2884faf56f529f960cc12ad8c71ce96cc7abba0a067c98fee344")))) - ("rust-foreign-types" - ,(origin - (method url-fetch) - (uri (crate-uri "foreign-types" "0.2.0")) - (file-name "rust-foreign-types-0.2.0") - (sha256 - (base16-string->bytevector - "3e4056b9bd47f8ac5ba12be771f77a0dae796d1bbaaf5fd0b9c2d38b69b8a29d")))) - ("rust-fs2" - ,(origin - (method url-fetch) - (uri (crate-uri "fs2" "0.4.2")) - (file-name "rust-fs2-0.4.2") - (sha256 - (base16-string->bytevector - "9ab76cfd2aaa59b7bf6688ad9ba15bbae64bff97f04ea02144cfd3443e5c2866")))) - ("rust-git2" - ,(origin - (method url-fetch) - (uri (crate-uri "git2" "0.6.8")) - (file-name "rust-git2-0.6.8") - (sha256 - (base16-string->bytevector - "0c1c0203d653f4140241da0c1375a404f0a397249ec818cd2076c6280c50f6fa")))) - ("rust-git2-curl" - ,(origin - (method url-fetch) - (uri (crate-uri "git2-curl" "0.7.0")) - (file-name "rust-git2-curl-0.7.0") - (sha256 - (base16-string->bytevector - "68676bc784bf0bef83278898929bf64a251e87c0340723d0b93fa096c9c5bf8e")))) - ("rust-glob" - ,(origin - (method url-fetch) - (uri (crate-uri "glob" "0.2.11")) - (file-name "rust-glob-0.2.11") - (sha256 - (base16-string->bytevector - "8be18de09a56b60ed0edf84bc9df007e30040691af7acd1c41874faac5895bfb")))) - ("rust-globset" - ,(origin - (method url-fetch) - (uri (crate-uri "globset" "0.2.0")) - (file-name "rust-globset-0.2.0") - (sha256 - (base16-string->bytevector - "feeb1b6840809ef5efcf7a4a990bc4e1b7ee3df8cf9e2379a75aeb2ba42ac9c3")))) - ("rust-hamcrest" - ,(origin - (method url-fetch) - (uri (crate-uri "hamcrest" "0.1.1")) - (file-name "rust-hamcrest-0.1.1") - (sha256 - (base16-string->bytevector - "bf088f042a467089e9baa4972f57f9247e42a0cc549ba264c7a04fbb8ecb89d4")))) - ("rust-hex" - ,(origin - (method url-fetch) - (uri (crate-uri "hex" "0.2.0")) - (file-name "rust-hex-0.2.0") - (sha256 - (base16-string->bytevector - "d6a22814455d41612f41161581c2883c0c6a1c41852729b17d5ed88f01e153aa")))) - ("rust-home" - ,(origin - (method url-fetch) - (uri (crate-uri "home" "0.3.0")) - (file-name "rust-home-0.3.0") - (sha256 - (base16-string->bytevector - "9f25ae61099d8f3fee8b483df0bd4ecccf4b2731897aad40d50eca1b641fe6db")))) - ("rust-idna" - ,(origin - (method url-fetch) - (uri (crate-uri "idna" "0.1.4")) - (file-name "rust-idna-0.1.4") - (sha256 - (base16-string->bytevector - "014b298351066f1512874135335d62a789ffe78a9974f94b43ed5621951eaf7d")))) - ("rust-ignore" - ,(origin - (method url-fetch) - (uri (crate-uri "ignore" "0.2.2")) - (file-name "rust-ignore-0.2.2") - (sha256 - (base16-string->bytevector - "b3fcaf2365eb14b28ec7603c98c06cc531f19de9eb283d89a3dff8417c8c99f5")))) - ("rust-itoa" - ,(origin - (method url-fetch) - (uri (crate-uri "itoa" "0.3.4")) - (file-name "rust-itoa-0.3.4") - (sha256 - (base16-string->bytevector - "8324a32baf01e2ae060e9de58ed0bc2320c9a2833491ee36cd3b4c414de4db8c")))) - ("rust-jobserver" - ,(origin - (method url-fetch) - (uri (crate-uri "jobserver" "0.1.6")) - (file-name "rust-jobserver-0.1.6") - (sha256 - (base16-string->bytevector - "443ae8bc0af6c106e6e8b77e04684faecc1a5ce94e058f4c2b0a037b0ea1b133")))) - ("rust-kernel32-sys" - ,(origin - (method url-fetch) - (uri (crate-uri "kernel32-sys" "0.2.2")) - (file-name "rust-kernel32-sys-0.2.2") - (sha256 - (base16-string->bytevector - "7507624b29483431c0ba2d82aece8ca6cdba9382bff4ddd0f7490560c056098d")))) - ("rust-lazy_static" - ,(origin - (method url-fetch) - (uri (crate-uri "lazy_static" "0.2.9")) - (file-name "rust-lazy_static-0.2.9") - (sha256 - (base16-string->bytevector - "c9e5e58fa1a4c3b915a561a78a22ee0cac6ab97dca2504428bc1cb074375f8d5")))) - ("rust-libc" - ,(origin - (method url-fetch) - (uri (crate-uri "libc" "0.2.31")) - (file-name "rust-libc-0.2.31") - (sha256 - (base16-string->bytevector - "d1419b2939a0bc44b77feb34661583c7546b532b192feab36249ab584b86856c")))) - ("rust-libgit2-sys" - ,(origin - (method url-fetch) - (uri (crate-uri "libgit2-sys" "0.6.16")) - (file-name "rust-libgit2-sys-0.6.16") - (sha256 - (base16-string->bytevector - "6f74b4959cef96898f5123148724fc7dee043b9a6b99f219d948851bfbe53cb2")))) - ("rust-libssh2-sys" - ,(origin - (method url-fetch) - (uri (crate-uri "libssh2-sys" "0.2.6")) - (file-name "rust-libssh2-sys-0.2.6") - (sha256 - (base16-string->bytevector - "0db4ec23611747ef772db1c4d650f8bd762f07b461727ec998f953c614024b75")))) - ("rust-libz-sys" - ,(origin - (method url-fetch) - (uri (crate-uri "libz-sys" "1.0.17")) - (file-name "rust-libz-sys-1.0.17") - (sha256 - (base16-string->bytevector - "44ebbc760fd2d2f4d93de09a0e13d97e057612052e871da9985cedcb451e6bd5")))) - ("rust-log" - ,(origin - (method url-fetch) - (uri (crate-uri "log" "0.3.8")) - (file-name "rust-log-0.3.8") - (sha256 - (base16-string->bytevector - "880f77541efa6e5cc74e76910c9884d9859683118839d6a1dc3b11e63512565b")))) - ("rust-magenta" - ,(origin - (method url-fetch) - (uri (crate-uri "magenta" "0.1.1")) - (file-name "rust-magenta-0.1.1") - (sha256 - (base16-string->bytevector - "4bf0336886480e671965f794bc9b6fce88503563013d1bfb7a502c81fe3ac527")))) - ("rust-magenta-sys" - ,(origin - (method url-fetch) - (uri (crate-uri "magenta-sys" "0.1.1")) - (file-name "rust-magenta-sys-0.1.1") - (sha256 - (base16-string->bytevector - "40d014c7011ac470ae28e2f76a02bfea4a8480f73e701353b49ad7a8d75f4699")))) - ("rust-matches" - ,(origin - (method url-fetch) - (uri (crate-uri "matches" "0.1.6")) - (file-name "rust-matches-0.1.6") - (sha256 - (base16-string->bytevector - "100aabe6b8ff4e4a7e32c1c13523379802df0772b82466207ac25b013f193376")))) - ("rust-memchr" - ,(origin - (method url-fetch) - (uri (crate-uri "memchr" "0.1.11")) - (file-name "rust-memchr-0.1.11") - (sha256 - (base16-string->bytevector - "d8b629fb514376c675b98c1421e80b151d3817ac42d7c667717d282761418d20")))) - ("rust-memchr-1.0.1" - ,(origin - (method url-fetch) - (uri (crate-uri "memchr" "1.0.1")) - (file-name "rust-memchr-1.0.1") - (sha256 - (base16-string->bytevector - "1dbccc0e46f1ea47b9f17e6d67c5a96bd27030519c519c9c91327e31275a47b4")))) - ("rust-miniz-sys" - ,(origin - (method url-fetch) - (uri (crate-uri "miniz-sys" "0.1.10")) - (file-name "rust-miniz-sys-0.1.10") - (sha256 - (base16-string->bytevector - "609ce024854aeb19a0ef7567d348aaa5a746b32fb72e336df7fcc16869d7e2b4")))) - ("rust-miow" - ,(origin - (method url-fetch) - (uri (crate-uri "miow" "0.2.1")) - (file-name "rust-miow-0.2.1") - (sha256 - (base16-string->bytevector - "8c1f2f3b1cf331de6896aabf6e9d55dca90356cc9960cca7eaaf408a355ae919")))) - ("rust-net2" - ,(origin - (method url-fetch) - (uri (crate-uri "net2" "0.2.31")) - (file-name "rust-net2-0.2.31") - (sha256 - (base16-string->bytevector - "3a80f842784ef6c9a958b68b7516bc7e35883c614004dd94959a4dca1b716c09")))) - ("rust-num" - ,(origin - (method url-fetch) - (uri (crate-uri "num" "0.1.40")) - (file-name "rust-num-0.1.40") - (sha256 - (base16-string->bytevector - "a311b77ebdc5dd4cf6449d81e4135d9f0e3b153839ac90e648a8ef538f923525")))) - ("rust-num-bigint" - ,(origin - (method url-fetch) - (uri (crate-uri "num-bigint" "0.1.40")) - (file-name "rust-num-bigint-0.1.40") - (sha256 - (base16-string->bytevector - "8fd0f8dbb4c0960998958a796281d88c16fbe68d87b1baa6f31e2979e81fd0bd")))) - ("rust-num-complex" - ,(origin - (method url-fetch) - (uri (crate-uri "num-complex" "0.1.40")) - (file-name "rust-num-complex-0.1.40") - (sha256 - (base16-string->bytevector - "503e668405c5492d67cf662a81e05be40efe2e6bcf10f7794a07bd9865e704e6")))) - ("rust-num-integer" - ,(origin - (method url-fetch) - (uri (crate-uri "num-integer" "0.1.35")) - (file-name "rust-num-integer-0.1.35") - (sha256 - (base16-string->bytevector - "d1452e8b06e448a07f0e6ebb0bb1d92b8890eea63288c0b627331d53514d0fba")))) - ("rust-num-iter" - ,(origin - (method url-fetch) - (uri (crate-uri "num-iter" "0.1.34")) - (file-name "rust-num-iter-0.1.34") - (sha256 - (base16-string->bytevector - "7485fcc84f85b4ecd0ea527b14189281cf27d60e583ae65ebc9c088b13dffe01")))) - ("rust-num-rational" - ,(origin - (method url-fetch) - (uri (crate-uri "num-rational" "0.1.39")) - (file-name "rust-num-rational-0.1.39") - (sha256 - (base16-string->bytevector - "288629c76fac4b33556f4b7ab57ba21ae202da65ba8b77466e6d598e31990790")))) - ("rust-num-traits" - ,(origin - (method url-fetch) - (uri (crate-uri "num-traits" "0.1.40")) - (file-name "rust-num-traits-0.1.40") - (sha256 - (base16-string->bytevector - "99843c856d68d8b4313b03a17e33c4bb42ae8f6610ea81b28abe076ac721b9b0")))) - ("rust-num_cpus" - ,(origin - (method url-fetch) - (uri (crate-uri "num_cpus" "1.7.0")) - (file-name "rust-num_cpus-1.7.0") - (sha256 - (base16-string->bytevector - "514f0d73e64be53ff320680ca671b64fe3fb91da01e1ae2ddc99eb51d453b20d")))) - ("rust-openssl" - ,(origin - (method url-fetch) - (uri (crate-uri "openssl" "0.9.19")) - (file-name "rust-openssl-0.9.19") - (sha256 - (base16-string->bytevector - "816914b22eb15671d62c73442a51978f311e911d6a6f6cbdafa6abce1b5038fc")))) - ("rust-openssl-probe" - ,(origin - (method url-fetch) - (uri (crate-uri "openssl-probe" "0.1.1")) - (file-name "rust-openssl-probe-0.1.1") - (sha256 - (base16-string->bytevector - "d98df0270d404ccd3c050a41d579c52d1db15375168bb3471e04ec0f5f378daf")))) - ("rust-openssl-sys" - ,(origin - (method url-fetch) - (uri (crate-uri "openssl-sys" "0.9.19")) - (file-name "rust-openssl-sys-0.9.19") - (sha256 - (base16-string->bytevector - "1e4c63a7d559c1e5afa6d6a9e6fa34bbc5f800ffc9ae08b72c605420b0c4f5e8")))) - ("rust-percent-encoding" - ,(origin - (method url-fetch) - (uri (crate-uri "percent-encoding" "1.0.0")) - (file-name "rust-precent-encoding-1.0.0") - (sha256 - (base16-string->bytevector - "de154f638187706bde41d9b4738748933d64e6b37bdbffc0b47a97d16a6ae356")))) - ("rust-pkg-config" - ,(origin - (method url-fetch) - (uri (crate-uri "pkg-config" "0.3.9")) - (file-name "rust-pkg-config-0.3.9") - (sha256 - (base16-string->bytevector - "3a8b4c6b8165cd1a1cd4b9b120978131389f64bdaf456435caa41e630edba903")))) - ("rust-psapi-sys" - ,(origin - (method url-fetch) - (uri (crate-uri "psapi-sys" "0.1.0")) - (file-name "rust-psapi-sys-0.1.0") - (sha256 - (base16-string->bytevector - "abcd5d1a07d360e29727f757a9decb3ce8bc6e0efa8969cfaad669a8317a2478")))) - ("rust-quote" - ,(origin - (method url-fetch) - (uri (crate-uri "quote" "0.3.15")) - (file-name "rust-quote-0.3.15") - (sha256 - (base16-string->bytevector - "7a6e920b65c65f10b2ae65c831a81a073a89edd28c7cce89475bff467ab4167a")))) - ("rust-rand" - ,(origin - (method url-fetch) - (uri (crate-uri "rand" "0.3.16")) - (file-name "rust-rand-0.3.16") - (sha256 - (base16-string->bytevector - "eb250fd207a4729c976794d03db689c9be1d634ab5a1c9da9492a13d8fecbcdf")))) - ("rust-redox_syscall" - ,(origin - (method url-fetch) - (uri (crate-uri "redox_syscall" "0.1.31")) - (file-name "rust-redox_syscall-0.1.31") - (sha256 - (base16-string->bytevector - "8dde11f18c108289bef24469638a04dce49da56084f2d50618b226e47eb04509")))) - ("rust-redox_termios" - ,(origin - (method url-fetch) - (uri (crate-uri "redox_termios" "0.1.1")) - (file-name "rust-redox_termios-0.1.1") - (sha256 - (base16-string->bytevector - "7e891cfe48e9100a70a3b6eb652fef28920c117d366339687bd5576160db0f76")))) - ("rust-regex" - ,(origin - (method url-fetch) - (uri (crate-uri "regex" "0.1.80")) - (file-name "rust-regex-0.1.80") - (sha256 - (base16-string->bytevector - "4fd4ace6a8cf7860714a2c2280d6c1f7e6a413486c13298bbc86fd3da019402f")))) - ("rust-regex-0.2.2" - ,(origin - (method url-fetch) - (uri (crate-uri "regex" "0.2.2")) - (file-name "rust-regex-0.2.2") - (sha256 - (base16-string->bytevector - "1731164734096285ec2a5ec7fea5248ae2f5485b3feeb0115af4fda2183b2d1b")))) - ("rust-regex-syntax" - ,(origin - (method url-fetch) - (uri (crate-uri "regex-syntax" "0.3.9")) - (file-name "rust-regex-syntax-0.3.9") - (sha256 - (base16-string->bytevector - "f9ec002c35e86791825ed294b50008eea9ddfc8def4420124fbc6b08db834957")))) - ("rust-regex-syntax-0.4.1" - ,(origin - (method url-fetch) - (uri (crate-uri "regex-syntax" "0.4.1")) - (file-name "rust-regex-syntax-0.4.1") - (sha256 - (base16-string->bytevector - "ad890a5eef7953f55427c50575c680c42841653abd2b028b68cd223d157f62db")))) - ("rust-rustc-demangle" - ,(origin - (method url-fetch) - (uri (crate-uri "rustc-demangle" "0.1.5")) - (file-name "rust-rustc-demangle-0.1.5") - (sha256 - (base16-string->bytevector - "aee45432acc62f7b9a108cc054142dac51f979e69e71ddce7d6fc7adf29e817e")))) - ("rust-rustc-serialize" - ,(origin - (method url-fetch) - (uri (crate-uri "rustc-serialize" "0.3.24")) - (file-name "rust-rustc-serialize-0.3.24") - (sha256 - (base16-string->bytevector - "dcf128d1287d2ea9d80910b5f1120d0b8eede3fbf1abe91c40d39ea7d51e6fda")))) - ("rust-same-file" - ,(origin - (method url-fetch) - (uri (crate-uri "same-file" "0.1.3")) - (file-name "rust-same-file-0.1.3") - (sha256 - (base16-string->bytevector - "d931a44fdaa43b8637009e7632a02adc4f2b2e0733c08caa4cf00e8da4a117a7")))) - ("rust-scoped-tls" - ,(origin - (method url-fetch) - (uri (crate-uri "scoped-tls" "0.1.0")) - (file-name "rust-scoped-tls-0.1.0") - (sha256 - (base16-string->bytevector - "f417c22df063e9450888a7561788e9bd46d3bb3c1466435b4eccb903807f147d")))) - ("rust-scopeguard" - ,(origin - (method url-fetch) - (uri (crate-uri "scopeguard" "0.1.2")) - (file-name "rust-scopeguard-0.1.2") - (sha256 - (base16-string->bytevector - "59a076157c1e2dc561d8de585151ee6965d910dd4dcb5dabb7ae3e83981a6c57")))) - ("rust-semver" - ,(origin - (method url-fetch) - (uri (crate-uri "semver" "0.8.0")) - (file-name "rust-semver-0.8.0") - (sha256 - (base16-string->bytevector - "bee2bc909ab2d8d60dab26e8cad85b25d795b14603a0dcb627b78b9d30b6454b")))) - ("rust-semver-parser" - ,(origin - (method url-fetch) - (uri (crate-uri "semver-parser" "0.7.0")) - (file-name "rust-semver-parser-0.7.0") - (sha256 - (base16-string->bytevector - "388a1df253eca08550bef6c72392cfe7c30914bf41df5269b68cbd6ff8f570a3")))) - ("rust-serde" - ,(origin - (method url-fetch) - (uri (crate-uri "serde" "1.0.15")) - (file-name "rust-serde-1.0.15") - (sha256 - (base16-string->bytevector - "6a7046c9d4c6c522d10b2d098f9bebe2bef227e0e74044d8c1bfcf6b476af799")))) - ("rust-serde_derive" - ,(origin - (method url-fetch) - (uri (crate-uri "serde_derive" "1.0.15")) - (file-name "rust-serde_derive-1.0.15") - (sha256 - (base16-string->bytevector - "1afcaae083fd1c46952a315062326bc9957f182358eb7da03b57ef1c688f7aa9")))) - ("rust-serde_derive_internals" - ,(origin - (method url-fetch) - (uri (crate-uri "serde_derive_internals" "0.16.0")) - (file-name "rust-serde_derive_internals-0.16.0") - (sha256 - (base16-string->bytevector - "bd381f6d01a6616cdba8530492d453b7761b456ba974e98768a18cad2cd76f58")))) - ("rust-serde_ignored" - ,(origin - (method url-fetch) - (uri (crate-uri "serde_ignored" "0.0.4")) - (file-name "rust-serde_ignored-0.0.4") - (sha256 - (base16-string->bytevector - "190e9765dcedb56be63b6e0993a006c7e3b071a016a304736e4a315dc01fb142")))) - ("rust-serde_json" - ,(origin - (method url-fetch) - (uri (crate-uri "serde_json" "1.0.3")) - (file-name "rust-serde_json-1.0.3") - (sha256 - (base16-string->bytevector - "d243424e06f9f9c39e3cd36147470fd340db785825e367625f79298a6ac6b7ac")))) - ("rust-shell-escape" - ,(origin - (method url-fetch) - (uri (crate-uri "shell-escape" "0.1.3")) - (file-name "rust-shell-escape-0.1.3") - (sha256 - (base16-string->bytevector - "dd5cc96481d54583947bfe88bf30c23d53f883c6cd0145368b69989d97b84ef8")))) - ("rust-socket2" - ,(origin - (method url-fetch) - (uri (crate-uri "socket2" "0.2.3")) - (file-name "rust-socket2-0.2.3") - (sha256 - (base16-string->bytevector - "9e76b159741052c7deaa9fd0b5ca6b5f79cecf525ed665abfe5002086c6b2791")))) - ("rust-strsim" - ,(origin - (method url-fetch) - (uri (crate-uri "strsim" "0.6.0")) - (file-name "rust-strsim-0.6.0") - (sha256 - (base16-string->bytevector - "b4d15c810519a91cf877e7e36e63fe068815c678181439f2f29e2562147c3694")))) - ("rust-syn" - ,(origin - (method url-fetch) - (uri (crate-uri "syn" "0.11.11")) - (file-name "rust-syn-0.11.11") - (sha256 - (base16-string->bytevector - "d3b891b9015c88c576343b9b3e41c2c11a51c219ef067b264bd9c8aa9b441dad")))) - ("rust-synom" - ,(origin - (method url-fetch) - (uri (crate-uri "synom" "0.11.3")) - (file-name "rust-synom-0.11.3") - (sha256 - (base16-string->bytevector - "a393066ed9010ebaed60b9eafa373d4b1baac186dd7e008555b0f702b51945b6")))) - ("rust-tar" - ,(origin - (method url-fetch) - (uri (crate-uri "tar" "0.4.13")) - (file-name "rust-tar-0.4.13") - (sha256 - (base16-string->bytevector - "281285b717926caa919ad905ef89c63d75805c7d89437fb873100925a53f2b1b")))) - ("rust-tempdir" - ,(origin - (method url-fetch) - (uri (crate-uri "tempdir" "0.3.5")) - (file-name "rust-tempdir-0.3.5") - (sha256 - (base16-string->bytevector - "87974a6f5c1dfb344d733055601650059a3363de2a6104819293baff662132d6")))) - ("rust-termcolor" - ,(origin - (method url-fetch) - (uri (crate-uri "termcolor" "0.3.3")) - (file-name "rust-termcolor-0.3.3") - (sha256 - (base16-string->bytevector - "9065bced9c3e43453aa3d56f1e98590b8455b341d2fa191a1090c0dd0b242c75")))) - ("rust-termion" - ,(origin - (method url-fetch) - (uri (crate-uri "termion" "1.5.1")) - (file-name "rust-termion-1.5.1") - (sha256 - (base16-string->bytevector - "689a3bdfaab439fd92bc87df5c4c78417d3cbe537487274e9b0b2dce76e92096")))) - ("rust-thread-id" - ,(origin - (method url-fetch) - (uri (crate-uri "thread-id" "2.0.0")) - (file-name "rust-thread-id-2.0.0") - (sha256 - (base16-string->bytevector - "a9539db560102d1cef46b8b78ce737ff0bb64e7e18d35b2a5688f7d097d0ff03")))) - ("rust-thread_local" - ,(origin - (method url-fetch) - (uri (crate-uri "thread_local" "0.2.7")) - (file-name "rust-thread_local-0.2.7") - (sha256 - (base16-string->bytevector - "8576dbbfcaef9641452d5cf0df9b0e7eeab7694956dd33bb61515fb8f18cfdd5")))) - ("rust-thread_local-0.3.4" - ,(origin - (method url-fetch) - (uri (crate-uri "thread_local" "0.3.4")) - (file-name "rust-thread_local-0.3.4") - (sha256 - (base16-string->bytevector - "1697c4b57aeeb7a536b647165a2825faddffb1d3bad386d507709bd51a90bb14")))) - ("rust-toml" - ,(origin - (method url-fetch) - (uri (crate-uri "toml" "0.4.5")) - (file-name "rust-toml-0.4.5") - (sha256 - (base16-string->bytevector - "a7540f4ffc193e0d3c94121edb19b055670d369f77d5804db11ae053a45b6e7e")))) - ("rust-unicode-bidi" - ,(origin - (method url-fetch) - (uri (crate-uri "unicode-bidi" "0.3.4")) - (file-name "rust-unicode-bidi-0.3.4") - (sha256 - (base16-string->bytevector - "49f2bd0c6468a8230e1db229cff8029217cf623c767ea5d60bfbd42729ea54d5")))) - ("rust-unicode-normalization" - ,(origin - (method url-fetch) - (uri (crate-uri "unicode-normalization" "0.1.5")) - (file-name "rust-unicode-normalization-0.1.5") - (sha256 - (base16-string->bytevector - "51ccda9ef9efa3f7ef5d91e8f9b83bbe6955f9bf86aec89d5cce2c874625920f")))) - ("rust-unicode-xid" - ,(origin - (method url-fetch) - (uri (crate-uri "unicode-xid" "0.0.4")) - (file-name "rust-unicode-xid-0.0.4") - (sha256 - (base16-string->bytevector - "8c1f860d7d29cf02cb2f3f359fd35991af3d30bac52c57d265a3c461074cb4dc")))) - ("rust-unreachable" - ,(origin - (method url-fetch) - (uri (crate-uri "unreachable" "1.0.0")) - (file-name "rust-unreachable-1.0.0") - (sha256 - (base16-string->bytevector - "382810877fe448991dfc7f0dd6e3ae5d58088fd0ea5e35189655f84e6814fa56")))) - ("rust-url" - ,(origin - (method url-fetch) - (uri (crate-uri "url" "1.5.1")) - (file-name "rust-url-1.5.1") - (sha256 - (base16-string->bytevector - "eeb819346883532a271eb626deb43c4a1bb4c4dd47c519bd78137c3e72a4fe27")))) - ("rust-userenv-sys" - ,(origin - (method url-fetch) - (uri (crate-uri "userenv-sys" "0.2.0")) - (file-name "rust-userenv-sys-0.2.0") - (sha256 - (base16-string->bytevector - "71d28ea36bbd9192d75bd9fa9b39f96ddb986eaee824adae5d53b6e51919b2f3")))) - ("rust-utf8-ranges" - ,(origin - (method url-fetch) - (uri (crate-uri "utf8-ranges" "0.1.3")) - (file-name "rust-utf8-ranges-0.1.3") - (sha256 - (base16-string->bytevector - "a1ca13c08c41c9c3e04224ed9ff80461d97e121589ff27c753a16cb10830ae0f")))) - ("rust-utf8-ranges-1.0.0" - ,(origin - (method url-fetch) - (uri (crate-uri "utf8-ranges" "1.0.0")) - (file-name "rust-utf8-ranges-1.0.0") - (sha256 - (base16-string->bytevector - "662fab6525a98beff2921d7f61a39e7d59e0b425ebc7d0d9e66d316e55124122")))) - ("rust-vcpkg" - ,(origin - (method url-fetch) - (uri (crate-uri "vcpkg" "0.2.2")) - (file-name "rust-vcpkg-0.2.2") - (sha256 - (base16-string->bytevector - "9e0a7d8bed3178a8fb112199d466eeca9ed09a14ba8ad67718179b4fd5487d0b")))) - ("rust-void" - ,(origin - (method url-fetch) - (uri (crate-uri "void" "1.0.2")) - (file-name "rust-void-1.0.2") - (sha256 - (base16-string->bytevector - "6a02e4885ed3bc0f2de90ea6dd45ebcbb66dacffe03547fadbb0eeae2770887d")))) - ("rust-walkdir" - ,(origin - (method url-fetch) - (uri (crate-uri "walkdir" "1.0.7")) - (file-name "rust-walkdir-1.0.7") - (sha256 - (base16-string->bytevector - "bb08f9e670fab86099470b97cd2b252d6527f0b3cc1401acdb595ffc9dd288ff")))) - ("rust-winapi" - ,(origin - (method url-fetch) - (uri (crate-uri "winapi" "0.2.8")) - (file-name "rust-winapi-0.2.8") - (sha256 - (base16-string->bytevector - "167dc9d6949a9b857f3451275e911c3f44255842c1f7a76f33c55103a909087a")))) - ("rust-winapi-build" - ,(origin - (method url-fetch) - (uri (crate-uri "winapi-build" "0.1.1")) - (file-name "rust-winapi-build-0.1.1") - (sha256 - (base16-string->bytevector - "2d315eee3b34aca4797b2da6b13ed88266e6d612562a0c46390af8299fc699bc")))) - ("rust-wincolor" - ,(origin - (method url-fetch) - (uri (crate-uri "wincolor" "0.1.4")) - (file-name "rust-wincolor-0.1.4") - (sha256 - (base16-string->bytevector - "a39ee4464208f6430992ff20154216ab2357772ac871d994c51628d60e58b8b0")))) - ("rust-ws2_32-sys" - ,(origin - (method url-fetch) - (uri (crate-uri "ws2_32-sys" "0.2.1")) - (file-name "rust-ws2_32-sys-0.2.1") - (sha256 - (base16-string->bytevector - "d59cefebd0c892fa2dd6de581e937301d8552cb44489cdff035c6187cb63fa5e")))))) - (arguments - `(#:cargo ,cargo-bootstrap - #:rustc ,rustc ; Force to use rustc from current file - #:modules - ((ice-9 match) - (srfi srfi-1) ; 'every - (guix build utils) - (guix build cargo-build-system)) - #:phases - (modify-phases %standard-phases - (add-after 'unpack 'unpack-dependencies - (lambda* (#:key inputs outputs #:allow-other-keys) - (define (unpack source target) - (mkdir-p target) - (with-directory-excursion target - (zero? (system* "tar" "xf" - source - "--strip-components=1")))) - (define (touch file-name) - (call-with-output-file file-name (const #t))) - (define (install-rust-library entry) - (match entry - ((name . src) - (if (string-prefix? "rust-" name) - (let* ((rust-length (string-length "rust-")) - (rust-name (string-drop name rust-length)) - (rsrc (string-append "vendor/" rust-name)) - (unpack-status (unpack src rsrc))) - (touch (string-append rsrc "/.cargo-ok")) - (generate-checksums rsrc src) - unpack-status))) - (_ #t))) - (mkdir "vendor") - (every install-rust-library inputs))) - (add-after 'patch-generated-file-shebangs 'patch-cargo-checksums - (lambda* (#:key inputs #:allow-other-keys) - (substitute* "Cargo.lock" - (("(\"checksum .* = )\".*\"" all name) - (string-append name "\"" ,%cargo-reference-hash "\""))) - (for-each - (lambda (filename) - (use-modules (guix build cargo-build-system)) - (delete-file filename) - (let* ((dir (dirname filename))) - (display (string-append - "patch-cargo-checksums: generate-checksums for " - dir "\n")) - (generate-checksums dir ,%cargo-reference-project-file))) - (find-files "vendor" ".cargo-checksum.json")) - #t)) - (replace 'configure - (lambda* (#:key inputs outputs #:allow-other-keys) - (substitute* "tests/build.rs" - (("/usr/bin/env") (which "env")) - ;; Guix llvm compiled without asmjs-unknown-emscripten at all - (("fn wasm32_final_outputs") "#[ignore]\nfn wasm32_final_outputs")) - (substitute* "tests/death.rs" - ;; Stuck when built in container - (("fn ctrl_c_kills_everyone") "#[ignore]\nfn ctrl_c_kills_everyone")) - (mkdir ".cargo") - (call-with-output-file ".cargo/config" - (lambda (port) - (display " -[source.crates-io] -registry = 'https://github.com/rust-lang/crates.io-index' -replace-with = 'vendored-sources' - -[source.vendored-sources] -directory = 'vendor' -" port))) - ;; Disable test for cross compilation support - (setenv "CFG_DISABLE_CROSS_TESTS" "1") - (setenv "SHELL" (which "sh")) - (setenv "CONFIG_SHELL" (which "sh")) - (setenv "CC" (string-append (assoc-ref inputs "gcc") "/bin/gcc")) - #t))))) - (home-page "https://github.com/rust-lang/cargo") - (synopsis "Build tool and package manager for Rust") - (description "Cargo is a tool that allows Rust projects to declare their -dependencies and ensures a reproducible build.") - ;; Cargo is dual licensed Apache and MIT. Also contains - ;; code from openssl which is GPL2 with linking exception. - (license (list license:asl2.0 license:expat license:gpl2)))) +(define-public rust + (let ((base-rust rust-1.23)) + (package + (inherit base-rust) + (version "1.24.1") + (source + (rust-source version + "1vv10x2h9kq7fxh2v01damdq8pvlp5acyh1kzcda9sfjx12kv99y")) + (native-inputs + (alist-replace "cargo-bootstrap" (list base-rust "cargo") + (alist-replace "rustc-bootstrap" (list base-rust) + (package-native-inputs base-rust)))) + (arguments + (substitute-keyword-arguments (package-arguments base-rust) + ((#:phases phases) `(modify-phases ,phases + (delete 'fix-mtime-bug)))))))) diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm index c637fbb162..4a1eb0cfa0 100644 --- a/guix/build-system/cargo.scm +++ b/guix/build-system/cargo.scm @@ -43,17 +43,11 @@ to NAME and VERSION." (string-append crate-url name "/" version "/download")) -(define (default-cargo) - "Return the default Cargo package." +(define (default-rust) + "Return the default Rust package." ;; Lazily resolve the binding to avoid a circular dependency. (let ((rust (resolve-interface '(gnu packages rust)))) - (module-ref rust 'cargo))) - -(define (default-rustc) - "Return the default Rustc package." - ;; Lazily resolve the binding to avoid a circular dependency. - (let ((rust (resolve-interface '(gnu packages rust)))) - (module-ref rust 'rustc))) + (module-ref rust 'rust))) (define %cargo-build-system-modules ;; Build-side modules imported by default. @@ -115,14 +109,13 @@ to NAME and VERSION." (define* (lower name #:key source inputs native-inputs outputs system target - (cargo (default-cargo)) - (rustc (default-rustc)) + (rust (default-rust)) #:allow-other-keys #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:cargo #:rustc #:inputs #:native-inputs #:outputs)) + '(#:source #:target #:rust #:inputs #:native-inputs #:outputs)) (and (not target) ;; TODO: support cross-compilation (bag @@ -136,8 +129,8 @@ to NAME and VERSION." ;; Keep the standard inputs of 'gnu-build-system' ,@(standard-packages))) - (build-inputs `(("cargo" ,cargo) - ("rustc" ,rustc) + (build-inputs `(("cargo" ,rust "cargo") + ("rustc" ,rust) ,@native-inputs)) (outputs outputs) (build cargo-build) -- cgit v1.2.3 From fc95dc4c34bf88ebd8c21752bf6d54b5cf752d1a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 31 Mar 2018 23:14:56 +0200 Subject: guix package: Add '--allow-collisions'. Fixes . Suggested by Ricardo Wurmus . * guix/scripts/package.scm (build-and-use-profile): Add #:allow-collisions? and pass it to 'profile-derivation'. (show-help, %options): Add '--allow-collisions'. (manifest-action, process-actions): Pass #:allow-collisions? to 'build-and-use-profile'. * tests/guix-package.sh: Add collision test. * doc/guix.texi (Invoking guix package): Document '--allow-collisions'. --- doc/guix.texi | 10 ++++++++++ guix/scripts/package.scm | 17 +++++++++++++++-- tests/guix-package.sh | 8 ++++++++ 3 files changed, 33 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 25c08b9f06..4eac281a82 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2039,6 +2039,16 @@ variable, even though, taken individually, neither @file{foo} nor @itemx -p @var{profile} Use @var{profile} instead of the user's default profile. +@cindex collisions, in a profile +@cindex colliding packages in profiles +@cindex profile collisions +@item --allow-collisions +Allow colliding packages in the new profile. Use at your own risk! + +By default, @command{guix package} reports as an error @dfn{collisions} +in the profile. Collisions happen when two or more different versions +or variants of a given package end up in the profile. + @item --verbose Produce verbose output. In particular, emit the build log of the environment on the standard error port. diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index d8b80efe8e..4f519e6f33 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -194,15 +194,18 @@ denote ranges as interpreted by 'matching-generations'." (define* (build-and-use-profile store profile manifest #:key + allow-collisions? bootstrap? use-substitutes? dry-run?) "Build a new generation of PROFILE, a file name, using the packages -specified in MANIFEST, a manifest object." +specified in MANIFEST, a manifest object. When ALLOW-COLLISIONS? is true, +do not treat collisions in MANIFEST as an error." (when (equal? profile %current-profile) (ensure-default-profile)) (let* ((prof-drv (run-with-store store (profile-derivation manifest + #:allow-collisions? allow-collisions? #:hooks (if bootstrap? '() %default-profile-hooks) @@ -407,6 +410,8 @@ Install, remove, or upgrade packages in a single transaction.\n")) (display (G_ " -p, --profile=PROFILE use PROFILE instead of the user's default profile")) (newline) + (display (G_ " + --allow-collisions do not treat collisions in the profile as an error")) (display (G_ " --bootstrap use the bootstrap Guile to build the profile")) (display (G_ " @@ -544,6 +549,10 @@ kind of search path~%") (lambda (opt name arg result arg-handler) (values (alist-cons 'verbose? #t result) #f))) + (option '("allow-collisions") #f #f + (lambda (opt name arg result arg-handler) + (values (alist-cons 'allow-collisions? #t result) + #f))) (option '(#\s "search") #t #f (lambda (opt name arg result arg-handler) (values (cons `(query search ,(or arg "")) @@ -831,13 +840,15 @@ processed, #f otherwise." (let* ((user-module (make-user-module '((guix profiles) (gnu)))) (manifest (load* file user-module)) (bootstrap? (assoc-ref opts 'bootstrap?)) - (substitutes? (assoc-ref opts 'substitutes?))) + (substitutes? (assoc-ref opts 'substitutes?)) + (allow-collisions? (assoc-ref opts 'allow-collisions?))) (if dry-run? (format #t (G_ "would install new manifest from '~a' with ~d entries~%") file (length (manifest-entries manifest))) (format #t (G_ "installing new manifest from '~a' with ~d entries~%") file (length (manifest-entries manifest)))) (build-and-use-profile store profile manifest + #:allow-collisions? allow-collisions? #:bootstrap? bootstrap? #:use-substitutes? substitutes? #:dry-run? dry-run?))) @@ -856,6 +867,7 @@ processed, #f otherwise." (define dry-run? (assoc-ref opts 'dry-run?)) (define bootstrap? (assoc-ref opts 'bootstrap?)) (define substitutes? (assoc-ref opts 'substitutes?)) + (define allow-collisions? (assoc-ref opts 'allow-collisions?)) (define profile (or (assoc-ref opts 'profile) %current-profile)) (define transform (options->transformation opts)) @@ -894,6 +906,7 @@ processed, #f otherwise." (show-manifest-transaction store manifest step3 #:dry-run? dry-run?) (build-and-use-profile store profile new + #:allow-collisions? allow-collisions? #:bootstrap? bootstrap? #:use-substitutes? substitutes? #:dry-run? dry-run?)))) diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 760a2e4c9b..aa5eaa66e7 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -60,6 +60,14 @@ test -L "$profile" && test -L "$profile-1-link" ! test -f "$profile-2-link" test -f "$profile/bin/guile" +# Collisions are properly flagged (in this case, 'python-wrapper' propagates +# python@3, which conflicts with python@2.) +if guix package --bootstrap -n -p "$profile" -i python@2 python-wrapper +then false; else true; fi + +guix package --bootstrap -n -p "$profile" -i python@2 python-wrapper \ + --allow-collisions + # No search path env. var. here. guix package -p "$profile" --search-paths guix package -p "$profile" --search-paths | grep '^export PATH=' -- cgit v1.2.3 From f8d13038645e635634469b673bcc20d87c91b913 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 31 Mar 2018 23:18:29 +0200 Subject: union: Slightly improve messages for file collisions. * guix/build/union.scm (union-build): Indent file names upon collision. Remove "arbitrarily" from the message. --- guix/build/union.scm | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/guix/build/union.scm b/guix/build/union.scm index d46b750035..5f1cf8e450 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2016, 2017 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2014 Mark H Weaver ;;; Copyright © 2017 Huang Ying ;;; @@ -93,14 +93,12 @@ make sure the caller can modify them later." (cond ((null? dirs) ;; The inputs are all files. (format (current-error-port) - "~%warning: collision encountered:~%~{~a~%~}" + "~%warning: collision encountered:~%~{ ~a~%~}" files) (let ((file (first files))) ;; TODO: Implement smarter strategies. - (format (current-error-port) - "warning: arbitrarily choosing ~a~%" - file) + (format (current-error-port) "warning: choosing ~a~%" file) (symlink* file output))) -- cgit v1.2.3 From 9188198692e3899ed9179af73cf721c19bb05db4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 2 Apr 2018 23:11:07 +0200 Subject: git: Increase modularity and expose 'update-cached-checkout'. * guix/git.scm (repository->head-sha1, copy-to-store): Remove. (switch-to-ref): Return the OID of OBJ. (update-cached-checkout): New procedure, with code from 'latest-repository-commit'. (latest-repository-commit): Use it. --- guix/git.scm | 87 +++++++++++++++++++++++++++++++++--------------------------- 1 file changed, 48 insertions(+), 39 deletions(-) (limited to 'guix') diff --git a/guix/git.scm b/guix/git.scm index 103749d0e2..9e89cc0062 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -28,9 +28,11 @@ #:use-module (rnrs bytevectors) #:use-module (ice-9 match) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:export (%repository-cache-directory + update-cached-checkout latest-repository-commit)) (define %repository-cache-directory @@ -68,11 +70,6 @@ make sure no empty directory is left behind." (lambda _ (false-if-exception (rmdir directory))))) -(define (repository->head-sha1 repo) - "Return the sha1 of the HEAD commit in REPOSITORY as a string." - (let ((oid (reference-target (repository-head repo)))) - (oid->string (commit-id (commit-lookup repo oid))))) - (define (url+commit->name url sha1) "Return the string \"-\" where REPO-NAME is the name of the git repository, extracted from URL and SHA1:7 the seven first digits @@ -82,21 +79,9 @@ of SHA1 string." (last (string-split url #\/)) ".git" "") "-" (string-take sha1 7))) -(define* (copy-to-store store cache-directory #:key url repository) - "Copy CACHE-DIRECTORY recursively to STORE. URL and REPOSITORY are used to -create the store directory name." - (define (dot-git? file stat) - (and (string=? (basename file) ".git") - (eq? 'directory (stat:type stat)))) - - (let* ((commit (repository->head-sha1 repository)) - (name (url+commit->name url commit))) - (values (add-to-store store name #t "sha256" cache-directory - #:select? (negate dot-git?)) - commit))) - (define (switch-to-ref repository ref) - "Switch to REPOSITORY's branch, commit or tag specified by REF." + "Switch to REPOSITORY's branch, commit or tag specified by REF. Return the +OID (roughly the commit hash) corresponding to REF." (define obj (match ref (('branch . branch) @@ -122,7 +107,38 @@ create the store directory name." (string-append "refs/tags/" tag)))) (object-lookup repository oid))))) - (reset repository obj RESET_HARD)) + (reset repository obj RESET_HARD) + (object-id obj)) + +(define* (update-cached-checkout url + #:key + (ref '(branch . "origin/master")) + (cache-directory + (%repository-cache-directory))) + "Update the cached checkout of URL to REF in CACHE-DIRECTORY. Return two +values: the cache directory name, and the SHA1 commit (a string) corresponding +to REF. + +REF is pair whose key is [branch | commit | tag] and value the associated +data, respectively [ | | ]." + (with-libgit2 + (let* ((cache-dir (url-cache-directory url cache-directory)) + (cache-exists? (openable-repository? cache-dir)) + (repository (if cache-exists? + (repository-open cache-dir) + (clone* url cache-dir)))) + ;; Only fetch remote if it has not been cloned just before. + (when cache-exists? + (remote-fetch (remote-lookup repository "origin"))) + (let ((oid (switch-to-ref repository ref))) + + ;; Reclaim file descriptors and memory mappings associated with + ;; REPOSITORY as soon as possible. + (when (module-defined? (resolve-interface '(git repository)) + 'repository-close!) + (repository-close! repository)) + + (values cache-dir (oid->string oid)))))) (define* (latest-repository-commit store url #:key @@ -137,23 +153,16 @@ data, respectively [ | | ]. Git repositories are kept in the cache directory specified by %repository-cache-directory parameter." - (with-libgit2 - (let* ((cache-dir (url-cache-directory url cache-directory)) - (cache-exists? (openable-repository? cache-dir)) - (repository (if cache-exists? - (repository-open cache-dir) - (clone* url cache-dir)))) - ;; Only fetch remote if it has not been cloned just before. - (when cache-exists? - (remote-fetch (remote-lookup repository "origin"))) - (switch-to-ref repository ref) - - ;; Reclaim file descriptors and memory mappings associated with - ;; REPOSITORY as soon as possible. - (when (module-defined? (resolve-interface '(git repository)) - 'repository-close!) - (repository-close! repository)) + (define (dot-git? file stat) + (and (string=? (basename file) ".git") + (eq? 'directory (stat:type stat)))) - (copy-to-store store cache-dir - #:url url - #:repository repository)))) + (let*-values (((checkout commit) + (update-cached-checkout url + #:ref ref + #:cache-directory cache-directory)) + ((name) + (url+commit->name url commit))) + (values (add-to-store store name #t "sha256" checkout + #:select? (negate dot-git?)) + commit))) -- cgit v1.2.3 From 1b92d65a40a2cf6028bfc0efb7d7d007d76d008a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 3 Apr 2018 23:33:39 +0200 Subject: modules: Report the search path in &missing-dependency-error. * guix/modules.scm (&missing-dependency-error)[search-path]: New field. (source-module-dependencies): Initialize the 'search-path' field. --- guix/modules.scm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/modules.scm b/guix/modules.scm index bf656bb241..65928f67f2 100644 --- a/guix/modules.scm +++ b/guix/modules.scm @@ -25,6 +25,7 @@ #:use-module (ice-9 match) #:export (missing-dependency-error? missing-dependency-module + missing-dependency-search-path file-name->module-name module-name->file-name @@ -47,7 +48,8 @@ ;; The error corresponding to a missing module. (define-condition-type &missing-dependency-error &error missing-dependency-error? - (module missing-dependency-module)) + (module missing-dependency-module) + (search-path missing-dependency-search-path)) (define (colon-symbol? obj) "Return true if OBJ is a symbol that starts with a colon." @@ -132,7 +134,8 @@ depends on." (module-file-dependencies file)) (#f (raise (condition (&missing-dependency-error - (module module)))))))) + (module module) + (search-path load-path)))))))) (define* (module-closure modules #:key -- cgit v1.2.3 From e40aa54e98aa6329e6196fd29e7e4e34ce3a063c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 8 Apr 2018 15:47:11 +0200 Subject: union: Allow callers to choose the collision resolution policy. * guix/build/union.scm (warn-about-collision): New procedure. (union-build): Add #:resolve-collision. [resolve-collisions]: Call it. * tests/union.scm ("union-build collision first & last"): New test. --- guix/build/union.scm | 36 ++++++++++++++++++++++++------------ tests/union.scm | 42 +++++++++++++++++++++++++++++++++++++++++- 2 files changed, 65 insertions(+), 13 deletions(-) (limited to 'guix') diff --git a/guix/build/union.scm b/guix/build/union.scm index 5f1cf8e450..1179f1234b 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -25,7 +25,9 @@ #:use-module (srfi srfi-26) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) - #:export (union-build)) + #:export (union-build + + warn-about-collision)) ;;; Commentary: ;;; @@ -76,14 +78,29 @@ identical, #f otherwise." (or (eof-object? n1) (loop)))))))))))))) +(define (warn-about-collision files) + "Handle the collision among FILES by emitting a warning and choosing the +first one of THEM." + (format (current-error-port) + "~%warning: collision encountered:~%~{ ~a~%~}" + files) + (let ((file (first files))) + (format (current-error-port) "warning: choosing ~a~%" file) + file)) + (define* (union-build output inputs #:key (log-port (current-error-port)) (create-all-directories? #f) - (symlink symlink)) + (symlink symlink) + (resolve-collision warn-about-collision)) "Build in the OUTPUT directory a symlink tree that is the union of all the INPUTS, using SYMLINK to create symlinks. As a special case, if CREATE-ALL-DIRECTORIES?, creates the subdirectories in the output directory to -make sure the caller can modify them later." +make sure the caller can modify them later. + +When two or more regular files collide, call RESOLVE-COLLISION with the list +of colliding files and use the one that it returns; or, if RESOLVE-COLLISION +returns #f, skip the faulty file altogether." (define (symlink* input output) (format log-port "`~a' ~~> `~a'~%" input output) @@ -92,15 +109,10 @@ make sure the caller can modify them later." (define (resolve-collisions output dirs files) (cond ((null? dirs) ;; The inputs are all files. - (format (current-error-port) - "~%warning: collision encountered:~%~{ ~a~%~}" - files) - - (let ((file (first files))) - ;; TODO: Implement smarter strategies. - (format (current-error-port) "warning: choosing ~a~%" file) - - (symlink* file output))) + (match (resolve-collision files) + (#f #f) + ((? string? file) + (symlink* file output)))) (else ;; The inputs are a mixture of files and directories diff --git a/tests/union.scm b/tests/union.scm index b63edc757b..aa95cae001 100644 --- a/tests/union.scm +++ b/tests/union.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2017 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -124,6 +124,46 @@ ;; new 'bin' sub-directory in the profile. (eq? 'directory (stat:type (lstat "bin")))))))) +(test-assert "union-build collision first & last" + (let* ((guile (package-derivation %store %bootstrap-guile)) + (fake (build-expression->derivation + %store "fake-guile" + '(begin + (use-modules (guix build utils)) + (let ((out (assoc-ref %outputs "out"))) + (mkdir-p (string-append out "/bin")) + (call-with-output-file (string-append out "/bin/guile") + (const #t)))) + #:modules '((guix build utils)))) + (builder (lambda (policy) + `(begin + (use-modules (guix build union) + (srfi srfi-1)) + (union-build (assoc-ref %outputs "out") + (map cdr %build-inputs) + #:resolve-collision ,policy)))) + (drv1 + (build-expression->derivation %store "union-first" + (builder 'first) + #:inputs `(("guile" ,guile) + ("fake" ,fake)) + #:modules '((guix build union)))) + (drv2 + (build-expression->derivation %store "union-last" + (builder 'last) + #:inputs `(("guile" ,guile) + ("fake" ,fake)) + #:modules '((guix build union))))) + (and (build-derivations %store (list drv1 drv2)) + (with-directory-excursion (derivation->output-path drv1) + (string=? (readlink "bin/guile") + (string-append (derivation->output-path guile) + "/bin/guile"))) + (with-directory-excursion (derivation->output-path drv2) + (string=? (readlink "bin/guile") + (string-append (derivation->output-path fake) + "/bin/guile")))))) + (test-assert "union-build #:create-all-directories? #t" (let* ((build `(begin (use-modules (guix build union)) -- cgit v1.2.3 From b244ae25f9d5d09ef62f59249c794601b1433886 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 8 Apr 2018 16:22:25 +0200 Subject: gexp: 'directory-union' has a #:resolve-collision parameter. * guix/gexp.scm (directory-union): Add #:resolve-collision and honor it. --- guix/gexp.scm | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/gexp.scm b/guix/gexp.scm index b47965d9eb..448eeed3f1 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1250,7 +1250,8 @@ This yields an 'etc' directory containing these two files." files)))))) (define* (directory-union name things - #:key (copy? #f) (quiet? #f)) + #:key (copy? #f) (quiet? #f) + (resolve-collision 'warn-about-collision)) "Return a directory that is the union of THINGS, where THINGS is a list of file-like objects denoting directories. For example: @@ -1258,6 +1259,10 @@ file-like objects denoting directories. For example: yields a directory that is the union of the 'guile' and 'emacs' packages. +Call RESOLVE-COLLISION when several files collide, passing it the list of +colliding files. RESOLVE-COLLISION must return the chosen file or #f, in +which case the colliding entry is skipped altogether. + When HARD-LINKS? is true, create hard links instead of symlinks. When QUIET? is true, the derivation will not print anything." (define symlink @@ -1281,12 +1286,16 @@ is true, the derivation will not print anything." (computed-file name (with-imported-modules '((guix build union)) (gexp (begin - (use-modules (guix build union)) + (use-modules (guix build union) + (srfi srfi-1)) ;for 'first' and 'last' + (union-build (ungexp output) '(ungexp things) #:log-port (ungexp log-port) - #:symlink (ungexp symlink))))))))) + #:symlink (ungexp symlink) + #:resolve-collision + (ungexp resolve-collision))))))))) ;;; -- cgit v1.2.3 From eaae07ec2878707744fed76029a28ab9a494fc2e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 23 Mar 2018 15:36:12 +0100 Subject: Add (guix self). * guix/self.scm: New file. * Makefile.am (MODULES): Add it. * gnu/packages.scm (%distro-root-directory): Rewrite to try different directories. * guix/discovery.scm (guix): Export 'scheme-files'. --- Makefile.am | 1 + gnu/packages.scm | 21 +- guix/discovery.scm | 3 +- guix/self.scm | 599 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 621 insertions(+), 3 deletions(-) create mode 100644 guix/self.scm (limited to 'guix') diff --git a/Makefile.am b/Makefile.am index 244069b533..e4edd05d72 100644 --- a/Makefile.am +++ b/Makefile.am @@ -81,6 +81,7 @@ MODULES = \ guix/derivations.scm \ guix/grafts.scm \ guix/gnu-maintenance.scm \ + guix/self.scm \ guix/upstream.scm \ guix/licenses.scm \ guix/glob.scm \ diff --git a/gnu/packages.scm b/gnu/packages.scm index 97e6cb347f..44a56dfde0 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -110,8 +110,25 @@ for system '~a'") file-name system))))))) (define %distro-root-directory - ;; Absolute file name of the module hierarchy. - (dirname (search-path %load-path "guix.scm"))) + ;; Absolute file name of the module hierarchy. Since (gnu packages …) might + ;; live in a directory different from (guix), try to get the best match. + (letrec-syntax ((dirname* (syntax-rules () + ((_ file) + (dirname file)) + ((_ file head tail ...) + (dirname (dirname* file tail ...))))) + (try (syntax-rules () + ((_ (file things ...) rest ...) + (match (search-path %load-path file) + (#f + (try rest ...)) + (absolute + (dirname* absolute things ...)))) + ((_) + #f)))) + (try ("gnu/packages/base.scm" gnu/ packages/) + ("gnu/packages.scm" gnu/) + ("guix.scm")))) (define %package-module-path ;; Search path for package modules. Each item must be either a directory diff --git a/guix/discovery.scm b/guix/discovery.scm index 7b57579023..8ffcf7cd9a 100644 --- a/guix/discovery.scm +++ b/guix/discovery.scm @@ -25,7 +25,8 @@ #:use-module (ice-9 match) #:use-module (ice-9 vlist) #:use-module (ice-9 ftw) - #:export (scheme-modules + #:export (scheme-files + scheme-modules fold-modules all-modules fold-module-public-variables)) diff --git a/guix/self.scm b/guix/self.scm new file mode 100644 index 0000000000..c9e4a4250e --- /dev/null +++ b/guix/self.scm @@ -0,0 +1,599 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017, 2018 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 self) + #:use-module (guix config) + #:use-module (guix i18n) + #:use-module (guix modules) + #:use-module (guix gexp) + #:use-module (guix store) + #:use-module (guix monads) + #:use-module (guix discovery) + #:use-module (guix packages) + #:use-module (guix sets) + #:use-module (guix utils) + #:use-module (guix modules) + #:use-module (guix build utils) + #:use-module ((guix build compile) #:select (%lightweight-optimizations)) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (ice-9 match) + #:export (make-config.scm + compiled-guix + guix-derivation + reload-guix)) + + +;;; +;;; Dependency handling. +;;; + +(define* (false-if-wrong-guile package + #:optional (guile-version (effective-version))) + "Return #f if PACKAGE depends on the \"wrong\" major version of Guile (e.g., +2.0 instead of 2.2), otherwise return PACKAGE." + (let ((guile (any (match-lambda + ((label (? package? dep) _ ...) + (and (string=? (package-name dep) "guile") + dep))) + (package-direct-inputs package)))) + (and (or (not guile) + (string-prefix? guile-version + (package-version guile))) + package))) + +(define (package-for-guile guile-version . names) + "Return the package with one of the given NAMES that depends on +GUILE-VERSION (\"2.0\" or \"2.2\"), or #f if none of the packages matches." + (let loop ((names names)) + (match names + (() + #f) + ((name rest ...) + (match (specification->package name) + (#f + (loop rest)) + ((? package? package) + (or (false-if-wrong-guile package) + (loop rest)))))))) + +(define specification->package + ;; Use our own variant of that procedure because that of (gnu packages) + ;; would traverse all the .scm files, which is wasteful. + (let ((ref (lambda (module variable) + (module-ref (resolve-interface module) variable)))) + (match-lambda + ("guile" (ref '(gnu packages commencement) 'guile-final)) + ("guile-json" (ref '(gnu packages guile) 'guile-json)) + ("guile-ssh" (ref '(gnu packages ssh) 'guile-ssh)) + ("guile-git" (ref '(gnu packages guile) 'guile-git)) + ("libgcrypt" (ref '(gnu packages gnupg) 'libgcrypt)) + ("zlib" (ref '(gnu packages compression) 'zlib)) + ("gzip" (ref '(gnu packages compression) 'gzip)) + ("bzip2" (ref '(gnu packages compression) 'bzip2)) + ("xz" (ref '(gnu packages compression) 'xz)) + ("guix" (ref '(gnu packages package-management) + 'guix-register))))) + + +;;; +;;; Derivations. +;;; + +;; Node in a DAG of build tasks. Each node maps to a derivation, but it's +;; easier to express things this way. +(define-record-type + (node name modules source dependencies compiled) + node? + (name node-name) ;string + (modules node-modules) ;list of module names + (source node-source) ;list of source files + (dependencies node-dependencies) ;list of nodes + (compiled node-compiled)) ;node -> lowerable object + +(define (node-fold proc init nodes) + (let loop ((nodes nodes) + (visited (setq)) + (result init)) + (match nodes + (() result) + ((head tail ...) + (if (set-contains? visited head) + (loop tail visited result) + (loop tail (set-insert head visited) + (proc head result))))))) + +(define (node-modules/recursive nodes) + (node-fold (lambda (node modules) + (append (node-modules node) modules)) + '() + nodes)) + +(define* (closure modules #:optional (except '())) + (source-module-closure modules + #:select? + (match-lambda + (('guix 'config) + #f) + ((and module + (or ('guix _ ...) ('gnu _ ...))) + (not (member module except))) + (rest #f)))) + +(define module->import + ;; Return a file-name/file-like object pair for the specified module and + ;; suitable for 'imported-files'. + (match-lambda + ((module '=> thing) + (let ((file (module-name->file-name module))) + (list file thing))) + (module + (let ((file (module-name->file-name module))) + (list file + (local-file (search-path %load-path file))))))) + +(define* (scheme-node name modules #:optional (dependencies '()) + #:key (extra-modules '()) (extra-files '()) + (extensions '()) + parallel? guile-for-build) + "Return a node that builds the given Scheme MODULES, and depends on +DEPENDENCIES (a list of nodes). EXTRA-MODULES is a list of additional modules +added to the source, and EXTRA-FILES is a list of additional files. +EXTENSIONS is a set of full-blown Guile packages (e.g., 'guile-json') that +must be present in the search path." + (let* ((modules (append extra-modules + (closure modules + (node-modules/recursive dependencies)))) + (module-files (map module->import modules)) + (source (imported-files (string-append name "-source") + (append module-files extra-files)))) + (node name modules source dependencies + (compiled-modules name source modules + (map node-source dependencies) + (map node-compiled dependencies) + #:extensions extensions + #:parallel? parallel? + #:guile-for-build guile-for-build)))) + +(define (file-imports directory sub-directory pred) + "List all the files matching PRED under DIRECTORY/SUB-DIRECTORY. Return a +list of file-name/file-like objects suitable as inputs to 'imported-files'." + (map (lambda (file) + (list (string-drop file (+ 1 (string-length directory))) + (local-file file #:recursive? #t))) + (find-files (string-append directory "/" sub-directory) pred))) + +(define (scheme-modules* directory sub-directory) + "Return the list of module names found under SUB-DIRECTORY in DIRECTORY." + (let ((prefix (string-length directory))) + (map (lambda (file) + (file-name->module-name (string-drop file prefix))) + (scheme-files (string-append directory "/" sub-directory))))) + +(define* (compiled-guix source #:key (version %guix-version) + (name (string-append "guix-" version)) + (guile-version (effective-version)) + (guile-for-build (guile-for-build guile-version)) + (libgcrypt (specification->package "libgcrypt")) + (zlib (specification->package "zlib")) + (gzip (specification->package "gzip")) + (bzip2 (specification->package "bzip2")) + (xz (specification->package "xz")) + (guix (specification->package "guix"))) + "Return a file-like object that contains a compiled Guix." + (define guile-json + (package-for-guile guile-version + "guile-json" + "guile2.2-json" + "guile2.0-json")) + + (define guile-ssh + (package-for-guile guile-version + "guile-ssh" + "guile2.2-ssh" + "guile2.0-ssh")) + + (define guile-git + (package-for-guile guile-version + "guile-git" + "guile2.0-git")) + + + (define dependencies + (match (append-map (lambda (package) + (cons (list "x" package) + (package-transitive-inputs package))) + (list guile-git guile-json guile-ssh)) + (((labels packages _ ...) ...) + packages))) + + (define *core-modules* + (scheme-node "guix-core" + '((guix) + (guix monad-repl) + (guix packages) + (guix download) + (guix discovery) + (guix profiles) + (guix build-system gnu) + (guix build-system trivial) + (guix build profiles) + (guix build gnu-build-system)) + + ;; Provide a dummy (guix config) with the default version + ;; number, storedir, etc. This is so that "guix-core" is the + ;; same across all installations and doesn't need to be + ;; rebuilt when the version changes, which in turn means we + ;; can have substitutes for it. + #:extra-modules + `(((guix config) + => ,(make-config.scm #:libgcrypt + (specification->package + "libgcrypt")))) + + #:guile-for-build guile-for-build)) + + (define *extra-modules* + (scheme-node "guix-extra" + (filter-map (match-lambda + (('guix 'scripts _ ..1) #f) + (name name)) + (scheme-modules* source "guix")) + (list *core-modules*) + #:extensions dependencies + #:guile-for-build guile-for-build)) + + (define *package-modules* + (scheme-node "guix-packages" + `((gnu packages) + ,@(scheme-modules* source "gnu/packages")) + (list *core-modules* *extra-modules*) + #:extensions dependencies + #:extra-files ;all the non-Scheme files + (file-imports source "gnu/packages" + (lambda (file stat) + (and (eq? 'regular (stat:type stat)) + (not (string-suffix? ".scm" file)) + (not (string-suffix? ".go" file)) + (not (string-prefix? ".#" file)) + (not (string-suffix? "~" file))))) + #:guile-for-build guile-for-build)) + + (define *system-modules* + (scheme-node "guix-system" + `((gnu system) + (gnu services) + ,@(scheme-modules* source "gnu/system") + ,@(scheme-modules* source "gnu/services")) + (list *package-modules* *extra-modules* *core-modules*) + #:extensions dependencies + #:extra-files + (file-imports source "gnu/system/examples" (const #t)) + #:guile-for-build + guile-for-build)) + + (define *cli-modules* + (scheme-node "guix-cli" + (scheme-modules* source "/guix/scripts") + (list *core-modules* *extra-modules* *package-modules* + *system-modules*) + #:extensions dependencies + #:guile-for-build guile-for-build)) + + (define *config* + (scheme-node "guix-config" + '() + #:extra-modules + `(((guix config) + => ,(make-config.scm #:libgcrypt libgcrypt + #:zlib zlib + #:gzip gzip + #:bzip2 bzip2 + #:xz xz + #:guix guix + #:package-name + %guix-package-name + #:package-version + version + #:bug-report-address + %guix-bug-report-address + #:home-page-url + %guix-home-page-url))) + #:guile-for-build guile-for-build)) + + (directory-union name + (append-map (lambda (node) + (list (node-source node) + (node-compiled node))) + + ;; Note: *CONFIG* comes first so that it + ;; overrides the (guix config) module that + ;; comes with *CORE-MODULES*. + (list *config* + *cli-modules* + *system-modules* + *package-modules* + *extra-modules* + *core-modules*)) + + ;; Silently choose the first entry upon collision so that + ;; we choose *CONFIG*. + #:resolve-collision 'first + + ;; When we do (add-to-store "utils.scm"), "utils.scm" must + ;; be a regular file, not a symlink. Thus, arrange so that + ;; regular files appear as regular files in the final + ;; output. + #:copy? #t + #:quiet? #t)) + + +;;; +;;; Generating (guix config). +;;; + +(define %dependency-variables + ;; (guix config) variables corresponding to dependencies. + '(%libgcrypt %libz %xz %gzip %bzip2 %nix-instantiate + %sbindir %guix-register-program)) + +(define %persona-variables + ;; (guix config) variables that define Guix's persona. + '(%guix-package-name + %guix-version + %guix-bug-report-address + %guix-home-page-url)) + +(define %config-variables + ;; (guix config) variables corresponding to Guix configuration (storedir, + ;; localstatedir, etc.) + (sort (filter pair? + (module-map (lambda (name var) + (and (not (memq name %dependency-variables)) + (not (memq name %persona-variables)) + (cons name (variable-ref var)))) + (resolve-interface '(guix config)))) + (lambda (name+value1 name+value2) + (stringstring (car name+value1)) + (symbol->string (car name+value2)))))) + +(define* (make-config.scm #:key libgcrypt zlib gzip xz bzip2 guix + (package-name "GNU Guix") + (package-version "0") + (bug-report-address "bug-guix@gnu.org") + (home-page-url "https://gnu.org/s/guix")) + + ;; Hack so that Geiser is not confused. + (define defmod 'define-module) + + (scheme-file "config.scm" + #~(begin + (#$defmod (guix config) + #:export (%guix-package-name + %guix-version + %guix-bug-report-address + %guix-home-page-url + %sbindir + %libgcrypt + %libz + %gzip + %bzip2 + %xz + %nix-instantiate)) + + ;; XXX: Work around . + (eval-when (expand load eval) + #$@(map (match-lambda + ((name . value) + #~(define-public #$name #$value))) + %config-variables) + + (define %guix-package-name #$package-name) + (define %guix-version #$package-version) + (define %guix-bug-report-address #$bug-report-address) + (define %guix-home-page-url #$home-page-url) + + (define %sbindir + ;; This is used to define '%guix-register-program'. + ;; TODO: Use a derivation that builds nothing but the + ;; C++ part. + #+(and guix (file-append guix "/sbin"))) + + (define %guix-register-program + (or (getenv "GUIX_REGISTER") + (and %sbindir + (string-append %sbindir "/guix-register")))) + + (define %gzip + #+(and gzip (file-append gzip "/bin/gzip"))) + (define %bzip2 + #+(and bzip2 (file-append bzip2 "/bin/bzip2"))) + (define %xz + #+(and xz (file-append xz "/bin/xz"))) + + (define %libgcrypt + #+(and libgcrypt + (file-append libgcrypt "/lib/libgcrypt"))) + (define %libz + #+(and zlib + (file-append zlib "/lib/libz"))) + + (define %nix-instantiate ;for (guix import snix) + "nix-instantiate"))))) + + + +;;; +;;; Building. +;;; + +(define (imported-files name files) + ;; This is a non-monadic, simplified version of 'imported-files' from (guix + ;; gexp). + (define build + (with-imported-modules (source-module-closure + '((guix build utils))) + #~(begin + (use-modules (ice-9 match) + (guix build utils)) + + (mkdir (ungexp output)) (chdir (ungexp output)) + (for-each (match-lambda + ((final-path store-path) + (mkdir-p (dirname final-path)) + + ;; Note: We need regular files to be regular files, not + ;; symlinks, as this makes a difference for + ;; 'add-to-store'. + (copy-file store-path final-path))) + '#$files)))) + + (computed-file name build)) + +(define* (compiled-modules name module-tree modules + #:optional + (dependencies '()) + (dependencies-compiled '()) + #:key + (extensions '()) ;full-blown Guile packages + parallel? + guile-for-build) + ;; This is a non-monadic, enhanced version of 'compiled-file' from (guix + ;; gexp). + (define build + (with-imported-modules (source-module-closure + '((guix build compile) + (guix build utils))) + #~(begin + (use-modules (srfi srfi-26) + (ice-9 match) + (ice-9 format) + (ice-9 threads) + (guix build compile) + (guix build utils)) + + (define (regular? file) + (not (member file '("." "..")))) + + (define (report-load file total completed) + (display #\cr) + (format #t + "loading...\t~5,1f% of ~d files" ;FIXME: i18n + (* 100. (/ completed total)) total) + (force-output)) + + (define (report-compilation file total completed) + (display #\cr) + (format #t "compiling...\t~5,1f% of ~d files" ;FIXME: i18n + (* 100. (/ completed total)) total) + (force-output)) + + (define (process-directory directory output) + (let ((files (find-files directory "\\.scm$")) + (prefix (+ 1 (string-length directory)))) + ;; Hide compilation warnings. + (parameterize ((current-warning-port (%make-void-port "w"))) + (compile-files directory #$output + (map (cut string-drop <> prefix) files) + #:workers (parallel-job-count) + #:report-load report-load + #:report-compilation report-compilation)))) + + (setvbuf (current-output-port) _IONBF) + (setvbuf (current-error-port) _IONBF) + + (set! %load-path (cons #+module-tree %load-path)) + (set! %load-path + (append '#+dependencies + (map (lambda (extension) + (string-append extension "/share/guile/site/" + (effective-version))) + '#+extensions) + %load-path)) + + (set! %load-compiled-path + (append '#+dependencies-compiled + (map (lambda (extension) + (string-append extension "/lib/guile/" + (effective-version) + "/site-ccache")) + '#+extensions) + %load-compiled-path)) + + ;; Load the compiler modules upfront. + (compile #f) + + (mkdir #$output) + (chdir #+module-tree) + (process-directory "." #$output)))) + + (computed-file name build + #:guile guile-for-build + #:options + `(#:local-build? #f ;allow substitutes + + ;; Don't annoy people about _IONBF deprecation. + #:env-vars (("GUILE_WARN_DEPRECATED" . "no"))))) + + +;;; +;;; Building. +;;; + +(define (guile-for-build version) + "Return a derivation for Guile 2.0 or 2.2, whichever matches the currently +running Guile." + (define canonical-package ;soft reference + (module-ref (resolve-interface '(gnu packages base)) + 'canonical-package)) + + (match version + ("2.2.2" + ;; Gross hack to avoid ABI incompatibilities (see + ;; .) + (module-ref (resolve-interface '(gnu packages guile)) + 'guile-2.2.2)) + ("2.2" + (canonical-package (module-ref (resolve-interface '(gnu packages guile)) + 'guile-2.2/fixed))) + ("2.0" + (canonical-package (specification->package "guile@2.0"))))) + +(define* (guix-derivation source version + #:optional (guile-version (effective-version))) + "Return, as a monadic value, the derivation to build the Guix from SOURCE +for GUILE-VERSION. Use VERSION as the version string." + (define (shorten version) + (if (and (string-every char-set:hex-digit version) + (> (string-length version) 9)) + (string-take version 9) ;Git commit + version)) + + (define guile + (guile-for-build guile-version)) + + (mbegin %store-monad + (set-guile-for-build guile) + (lower-object (compiled-guix source + #:version version + #:name (string-append "guix-" + (shorten version)) + #:guile-version (match guile-version + ("2.2.2" "2.2") + (version version)) + #:guile-for-build guile)))) -- cgit v1.2.3 From 3c0128b035ae00462f1b0a4427d9525d750e5575 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 26 Mar 2018 23:42:59 +0200 Subject: discovery: Remove dependency on (guix ui). This reduces the closure of (guix discovery) from 28 to 8 modules. * guix/discovery.scm (scheme-files): Use 'format' instead of 'warning'. (scheme-modules): Add #:warn parameter. Use it instead of 'warn-about-load-error'. (fold-modules): Add #:warn and pass it to 'scheme-modules'. (all-modules): Likewise. * gnu/bootloader.scm (bootloader-modules): Pass #:warn to 'all-modules'. * gnu/packages.scm (fold-packages): Likewise. * gnu/services.scm (all-service-modules): Likewise. * guix/upstream.scm (importer-modules): Likewise. --- gnu/bootloader.scm | 3 ++- gnu/packages.scm | 6 ++++-- gnu/services.scm | 3 ++- guix/discovery.scm | 28 +++++++++++++++++----------- guix/upstream.scm | 5 +++-- 5 files changed, 28 insertions(+), 17 deletions(-) (limited to 'guix') diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm index 736f119527..4f2c71cb5a 100644 --- a/gnu/bootloader.scm +++ b/gnu/bootloader.scm @@ -146,7 +146,8 @@ "Return the list of bootloader modules." (all-modules (map (lambda (entry) `(,entry . "gnu/bootloader")) - %load-path))) + %load-path) + #:warn warn-about-load-error)) (define %bootloaders ;; The list of publically-known bootloaders. diff --git a/gnu/packages.scm b/gnu/packages.scm index 44a56dfde0..1a37a17342 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2013 Mark H Weaver ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2016, 2017 Alex Kost @@ -159,7 +159,9 @@ for system '~a'") (define* (fold-packages proc init #:optional - (modules (all-modules (%package-module-path))) + (modules (all-modules (%package-module-path) + #:warn + warn-about-load-error)) #:key (select? (negate hidden-package?))) "Call (PROC PACKAGE RESULT) for each available package defined in one of MODULES that matches SELECT?, using INIT as the initial value of RESULT. It diff --git a/gnu/services.scm b/gnu/services.scm index 2fcacb9eb4..81af4df849 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -181,7 +181,8 @@ (define (all-service-modules) "Return the default set of service modules." (cons (resolve-interface '(gnu services)) - (all-modules (%service-type-path)))) + (all-modules (%service-type-path) + #:warn warn-about-load-error))) (define* (fold-service-types proc seed #:optional diff --git a/guix/discovery.scm b/guix/discovery.scm index 8ffcf7cd9a..2b627d108e 100644 --- a/guix/discovery.scm +++ b/guix/discovery.scm @@ -17,7 +17,7 @@ ;;; along with GNU Guix. If not, see . (define-module (guix discovery) - #:use-module (guix ui) + #:use-module (guix i18n) #:use-module (guix modules) #:use-module (guix combinators) #:use-module (guix build syscalls) @@ -86,13 +86,18 @@ DIRECTORY is not accessible." (lambda args (let ((errno (system-error-errno args))) (unless (= errno ENOENT) - (warning (G_ "cannot access `~a': ~a~%") - directory (strerror errno))) + (format (current-error-port) ;XXX + (G_ "cannot access `~a': ~a~%") + directory (strerror errno))) '()))))) -(define* (scheme-modules directory #:optional sub-directory) +(define* (scheme-modules directory #:optional sub-directory + #:key (warn (const #f))) "Return the list of Scheme modules available under DIRECTORY. -Optionally, narrow the search to SUB-DIRECTORY." +Optionally, narrow the search to SUB-DIRECTORY. + +WARN is called when a module could not be loaded. It is passed the module +name and the exception key and arguments." (define prefix-len (string-length directory)) @@ -104,31 +109,32 @@ Optionally, narrow the search to SUB-DIRECTORY." (resolve-interface module)) (lambda args ;; Report the error, but keep going. - (warn-about-load-error module args) + (warn module args) #f)))) (scheme-files (if sub-directory (string-append directory "/" sub-directory) directory)))) -(define (fold-modules proc init path) +(define* (fold-modules proc init path #:key (warn (const #f))) "Fold over all the Scheme modules present in PATH, a list of directories. Call (PROC MODULE RESULT) for each module that is found." (fold (lambda (spec result) (match spec ((? string? directory) - (fold proc result (scheme-modules directory))) + (fold proc result (scheme-modules directory #:warn warn))) ((directory . sub-directory) (fold proc result - (scheme-modules directory sub-directory))))) + (scheme-modules directory sub-directory + #:warn warn))))) '() path)) -(define (all-modules path) +(define* (all-modules path #:key (warn (const #f))) "Return the list of package modules found in PATH, a list of directories to search. Entries in PATH can be directory names (strings) or (DIRECTORY . SUB-DIRECTORY) pairs, in which case modules are searched for beneath SUB-DIRECTORY." - (fold-modules cons '() path)) + (fold-modules cons '() path #:warn warn)) (define (fold-module-public-variables proc init modules) "Call (PROC OBJECT RESULT) for each variable exported by one of MODULES, diff --git a/guix/upstream.scm b/guix/upstream.scm index caaa0e44e4..9e1056f7a7 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2015 Alex Kost ;;; ;;; This file is part of GNU Guix. @@ -153,7 +153,8 @@ correspond to the same version." (cons (resolve-interface '(guix gnu-maintenance)) (all-modules (map (lambda (entry) `(,entry . "guix/import")) - %load-path)))) + %load-path) + #:warn warn-about-load-error))) (define %updaters ;; The list of publically-known updaters. -- cgit v1.2.3 From 14b392a8ad25454cfd3d929d6ae359e369a76cbf Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 10 Apr 2018 14:33:25 +0200 Subject: self: Don't substitute the '-source' derivations. With substitution enabled we would end up downloading 10+ MiB of source that's already available locally on disk. * guix/self.scm (imported-files): Pass #:options to 'computed-file'. --- guix/self.scm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/self.scm b/guix/self.scm index c9e4a4250e..76cbe2d6e3 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -463,7 +463,10 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'." (copy-file store-path final-path))) '#$files)))) - (computed-file name build)) + ;; We're just copying files around, no need to substitute or offload it. + (computed-file name build + #:options '(#:local-build? #t + #:substitutable? #f))) (define* (compiled-modules name module-tree modules #:optional -- cgit v1.2.3 From 69447b6393d6f2c3528e3964c7c5f30f710aaa85 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 10 Apr 2018 14:34:59 +0200 Subject: self: Display a new line at the end of module compilation. * guix/self.scm (compiled-modules)[build]: Add a 'newline' call at the end. --- guix/self.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/self.scm b/guix/self.scm index 76cbe2d6e3..dbe942cf23 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -543,7 +543,8 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'." (mkdir #$output) (chdir #+module-tree) - (process-directory "." #$output)))) + (process-directory "." #$output) + (newline)))) (computed-file name build #:guile guile-for-build -- cgit v1.2.3 From e69dd8443ad2b8620c3a3db874dc50e06b0d43d0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 10 Apr 2018 14:36:18 +0200 Subject: self: Fix package names for compilation with Guile 2.0. Reported by Ricardo Wurmus. * guix/self.scm (specification->package): Add guile2.0-{json,git,ssh}. (guile-for-build): Use 'module-ref' for Guile 2.0. --- guix/self.scm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/self.scm b/guix/self.scm index dbe942cf23..f2e912c85d 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -88,7 +88,11 @@ GUILE-VERSION (\"2.0\" or \"2.2\"), or #f if none of the packages matches." ("bzip2" (ref '(gnu packages compression) 'bzip2)) ("xz" (ref '(gnu packages compression) 'xz)) ("guix" (ref '(gnu packages package-management) - 'guix-register))))) + 'guix-register)) + ("guile2.0-json" (ref '(gnu packages guile) 'guile2.0-json)) + ("guile2.0-ssh" (ref '(gnu packages ssh) 'guile2.0-ssh)) + ("guile2.0-git" (ref '(gnu packages guile) 'guile2.0-git)) + (_ #f)))) ;no such package ;;; @@ -576,7 +580,8 @@ running Guile." (canonical-package (module-ref (resolve-interface '(gnu packages guile)) 'guile-2.2/fixed))) ("2.0" - (canonical-package (specification->package "guile@2.0"))))) + (module-ref (resolve-interface '(gnu packages guile)) + 'guile-2.0)))) (define* (guix-derivation source version #:optional (guile-version (effective-version))) -- cgit v1.2.3 From 806ff35854b3d5c0a2e906ad8d3af6a95b174de1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 10 Apr 2018 14:37:36 +0200 Subject: self: Export '%guix-register-program' in generated (guix config). * guix/self.scm (make-config.scm): Export '%guix-register-program'. --- guix/self.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix') diff --git a/guix/self.scm b/guix/self.scm index f2e912c85d..23d65e5545 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -393,6 +393,7 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'." %guix-bug-report-address %guix-home-page-url %sbindir + %guix-register-program %libgcrypt %libz %gzip -- cgit v1.2.3 From 43176dd605ac040a290171dee5a1019cb7c7a1fc Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 10 Apr 2018 14:38:19 +0200 Subject: self: Don't use deprecated package names. * guix/self.scm (compiled-guix)[guile-json, guile-ssh]: Don't refer t "guile2.2-json" and "guile2.2-ssh", which are deprecated. --- guix/self.scm | 2 -- 1 file changed, 2 deletions(-) (limited to 'guix') diff --git a/guix/self.scm b/guix/self.scm index 23d65e5545..2275ab51a4 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -203,13 +203,11 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'." (define guile-json (package-for-guile guile-version "guile-json" - "guile2.2-json" "guile2.0-json")) (define guile-ssh (package-for-guile guile-version "guile-ssh" - "guile2.2-ssh" "guile2.0-ssh")) (define guile-git -- cgit v1.2.3 From 63cab4182d60dd228dccc03c149ac01bf100301a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 11 Apr 2018 00:22:03 +0200 Subject: self: Remove 'eval-when' from in generated (guix config). * guix/self.scm (make-config.scm): Remove unneeded 'eval-when'. --- guix/self.scm | 76 +++++++++++++++++++++++++++++------------------------------ 1 file changed, 37 insertions(+), 39 deletions(-) (limited to 'guix') diff --git a/guix/self.scm b/guix/self.scm index 2275ab51a4..dd61322a54 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -399,45 +399,43 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'." %xz %nix-instantiate)) - ;; XXX: Work around . - (eval-when (expand load eval) - #$@(map (match-lambda - ((name . value) - #~(define-public #$name #$value))) - %config-variables) - - (define %guix-package-name #$package-name) - (define %guix-version #$package-version) - (define %guix-bug-report-address #$bug-report-address) - (define %guix-home-page-url #$home-page-url) - - (define %sbindir - ;; This is used to define '%guix-register-program'. - ;; TODO: Use a derivation that builds nothing but the - ;; C++ part. - #+(and guix (file-append guix "/sbin"))) - - (define %guix-register-program - (or (getenv "GUIX_REGISTER") - (and %sbindir - (string-append %sbindir "/guix-register")))) - - (define %gzip - #+(and gzip (file-append gzip "/bin/gzip"))) - (define %bzip2 - #+(and bzip2 (file-append bzip2 "/bin/bzip2"))) - (define %xz - #+(and xz (file-append xz "/bin/xz"))) - - (define %libgcrypt - #+(and libgcrypt - (file-append libgcrypt "/lib/libgcrypt"))) - (define %libz - #+(and zlib - (file-append zlib "/lib/libz"))) - - (define %nix-instantiate ;for (guix import snix) - "nix-instantiate"))))) + #$@(map (match-lambda + ((name . value) + #~(define-public #$name #$value))) + %config-variables) + + (define %guix-package-name #$package-name) + (define %guix-version #$package-version) + (define %guix-bug-report-address #$bug-report-address) + (define %guix-home-page-url #$home-page-url) + + (define %sbindir + ;; This is used to define '%guix-register-program'. + ;; TODO: Use a derivation that builds nothing but the + ;; C++ part. + #+(and guix (file-append guix "/sbin"))) + + (define %guix-register-program + (or (getenv "GUIX_REGISTER") + (and %sbindir + (string-append %sbindir "/guix-register")))) + + (define %gzip + #+(and gzip (file-append gzip "/bin/gzip"))) + (define %bzip2 + #+(and bzip2 (file-append bzip2 "/bin/bzip2"))) + (define %xz + #+(and xz (file-append xz "/bin/xz"))) + + (define %libgcrypt + #+(and libgcrypt + (file-append libgcrypt "/lib/libgcrypt"))) + (define %libz + #+(and zlib + (file-append zlib "/lib/libz"))) + + (define %nix-instantiate ;for (guix import snix) + "nix-instantiate")))) -- cgit v1.2.3 From a1639ae9de39d5ce47e6ddfd87e792db52b44bd6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 11 Apr 2018 00:29:47 +0200 Subject: self: 'package-for-guile' really honors GUILE-VERSION. * guix/self.scm (package-for-guile): Pass GUILE-VERSION to 'false-if-wrong-guile'. --- guix/self.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/self.scm b/guix/self.scm index dd61322a54..0730cd850d 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -69,7 +69,7 @@ GUILE-VERSION (\"2.0\" or \"2.2\"), or #f if none of the packages matches." (#f (loop rest)) ((? package? package) - (or (false-if-wrong-guile package) + (or (false-if-wrong-guile package guile-version) (loop rest)))))))) (define specification->package -- cgit v1.2.3 From 4fbd1a2b7f0db819e14d7cc862445d9ab3d0d80f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 11 Apr 2018 00:52:40 +0200 Subject: gexp: 'scheme-file' can splice expressions. * guix/gexp.scm ()[splice?]: New field. (scheme-file): Add #:splice? and pass it to '%scheme-file'. (scheme-file-compiler): Pass SPLICE? to 'gexp->file'. (gexp->file): Add #:splice? and honor it. * tests/gexp.scm ("gexp->file + #:splice?"): New test. ("gexp->derivation & with-imported-module & computed module"): Use #:splice? #t. --- doc/guix.texi | 6 +++++- guix/gexp.scm | 39 ++++++++++++++++++++++++++------------- tests/gexp.scm | 23 +++++++++++++++++++++-- 3 files changed, 52 insertions(+), 16 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 738fdf65ca..d825f39e0e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5221,8 +5221,12 @@ This is the declarative counterpart of @code{gexp->script}. @deffn {Monadic Procedure} gexp->file @var{name} @var{exp} @ [#:set-load-path? #t] [#:module-path %load-path] @ + [#:splice? #f] @ [#:guile (default-guile)] Return a derivation that builds a file @var{name} containing @var{exp}. +When @var{splice?} is true, @var{exp} is considered to be a list of +expressions that will be spliced in the resulting file. + When @var{set-load-path?} is true, emit code in the resulting file to set @code{%load-path} and @code{%load-compiled-path} to honor @var{exp}'s imported modules. Look up @var{exp}'s modules in @@ -5232,7 +5236,7 @@ The resulting file holds references to all the dependencies of @var{exp} or a subset thereof. @end deffn -@deffn {Scheme Procedure} scheme-file @var{name} @var{exp} +@deffn {Scheme Procedure} scheme-file @var{name} @var{exp} [#:splice? #f] Return an object representing the Scheme file @var{name} that contains @var{exp}. diff --git a/guix/gexp.scm b/guix/gexp.scm index 448eeed3f1..d26fad7e0b 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -406,23 +406,24 @@ This is the declarative counterpart of 'gexp->script'." #:guile (or guile (default-guile)))))) (define-record-type - (%scheme-file name gexp) + (%scheme-file name gexp splice?) scheme-file? (name scheme-file-name) ;string - (gexp scheme-file-gexp)) ;gexp + (gexp scheme-file-gexp) ;gexp + (splice? scheme-file-splice?)) ;Boolean -(define* (scheme-file name gexp) +(define* (scheme-file name gexp #:key splice?) "Return an object representing the Scheme file NAME that contains GEXP. This is the declarative counterpart of 'gexp->file'." - (%scheme-file name gexp)) + (%scheme-file name gexp splice?)) (define-gexp-compiler (scheme-file-compiler (file ) system target) ;; Compile FILE by returning a derivation that builds the file. (match file - (($ name gexp) - (gexp->file name gexp)))) + (($ name gexp splice?) + (gexp->file name gexp #:splice? splice?)))) ;; Appending SUFFIX to BASE's output file name. (define-record-type @@ -1162,18 +1163,26 @@ imported modules in its search path. Look up EXP's modules in MODULE-PATH." (define* (gexp->file name exp #:key (set-load-path? #t) - (module-path %load-path)) - "Return a derivation that builds a file NAME containing EXP. When -SET-LOAD-PATH? is true, emit code in the resulting file to set '%load-path' -and '%load-compiled-path' to honor EXP's imported modules. Lookup EXP's -modules in MODULE-PATH." + (module-path %load-path) + (splice? #f)) + "Return a derivation that builds a file NAME containing EXP. When SPLICE? +is true, EXP is considered to be a list of expressions that will be spliced in +the resulting file. + +When SET-LOAD-PATH? is true, emit code in the resulting file to set +'%load-path' and '%load-compiled-path' to honor EXP's imported modules. +Lookup EXP's modules in MODULE-PATH." (match (if set-load-path? (gexp-modules exp) '()) (() ;zero modules (gexp->derivation name (gexp (call-with-output-file (ungexp output) (lambda (port) - (write '(ungexp exp) port)))) + (for-each (lambda (exp) + (write exp port)) + '(ungexp (if splice? + exp + (gexp ((ungexp exp))))))))) #:local-build? #t #:substitutable? #f)) ((modules ...) @@ -1184,7 +1193,11 @@ modules in MODULE-PATH." (call-with-output-file (ungexp output) (lambda (port) (write '(ungexp set-load-path) port) - (write '(ungexp exp) port)))) + (for-each (lambda (exp) + (write exp port)) + '(ungexp (if splice? + exp + (gexp ((ungexp exp))))))))) #:module-path module-path #:local-build? #t #:substitutable? #f))))) diff --git a/tests/gexp.scm b/tests/gexp.scm index 2f8940e2c6..3c8b4624da 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -419,6 +419,24 @@ (call-with-input-file out read)) (equal? (list guile) refs))))) +(test-assertm "gexp->file + #:splice?" + (mlet* %store-monad ((exp -> (list + #~(define foo 'bar) + #~(define guile #$%bootstrap-guile))) + (guile (package-file %bootstrap-guile)) + (drv (gexp->file "splice" exp #:splice? #t)) + (out -> (derivation->output-path drv)) + (done (built-derivations (list drv))) + (refs (references* out))) + (pk 'splice out) + (return (and (equal? `((define foo 'bar) + (define guile ,guile) + ,(call-with-input-string "" read)) + (call-with-input-file out + (lambda (port) + (list (read port) (read port) (read port))))) + (equal? (list guile) refs))))) + (test-assertm "gexp->derivation" (mlet* %store-monad ((file (text-file "foo" "Hello, world!")) (exp -> (gexp @@ -700,11 +718,12 @@ (test-assertm "gexp->derivation & with-imported-module & computed module" (mlet* %store-monad - ((module -> (scheme-file "x" #~(begin + ((module -> (scheme-file "x" #~(;; splice! (define-module (foo bar) #:export (the-answer)) - (define the-answer 42)))) + (define the-answer 42)) + #:splice? #t)) (build -> (with-imported-modules `(((foo bar) => ,module) (guix build utils)) #~(begin -- cgit v1.2.3 From eb72cdf087fe51d85e0c1514ec8e669047b5d6e1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 11 Apr 2018 00:55:13 +0200 Subject: self: Produce a spliced (guix config) to placate Guile 2.0. Fixes 'guix pull' with Guile 2.0. See . * guix/self.scm (make-config.scm): Remove 'begin' in 'scheme-file' argument and pass #:splice? #t. --- guix/self.scm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/self.scm b/guix/self.scm index 0730cd850d..6220efb397 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -384,7 +384,7 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'." (define defmod 'define-module) (scheme-file "config.scm" - #~(begin + #~(;; The following expressions get spliced. (#$defmod (guix config) #:export (%guix-package-name %guix-version @@ -435,7 +435,12 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'." (file-append zlib "/lib/libz"))) (define %nix-instantiate ;for (guix import snix) - "nix-instantiate")))) + "nix-instantiate")) + + ;; Guile 2.0 *requires* the 'define-module' to be at the + ;; top-level or it 'toplevel-ref' in the resulting .go file are + ;; made relative to a nonexistent anonymous module. + #:splice? #t)) -- cgit v1.2.3