From 98a7b528d61cfca3f8bfc827cf94f4716ab75abd Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 12 Feb 2016 18:59:11 +0100 Subject: store: Add monadic access to '%current-system'. * guix/store.scm (current-system, set-current-system): New procedures. * tests/store.scm ("current-system"): New test. --- guix/store.scm | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/store.scm b/guix/store.scm index 3c4d1c0058..8123407816 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -118,6 +118,8 @@ store-lower run-with-store %guile-for-build + current-system + set-current-system text-file interned-file @@ -1040,6 +1042,18 @@ permission bits are kept." (define set-build-options* (store-lift set-build-options)) +(define-inlinable (current-system) + ;; Consult the %CURRENT-SYSTEM fluid at bind time. This is equivalent to + ;; (lift0 %current-system %store-monad), but inlinable, thus avoiding + ;; closure allocation in some cases. + (lambda (state) + (values (%current-system) state))) + +(define-inlinable (set-current-system system) + ;; Set the %CURRENT-SYSTEM fluid at bind time. + (lambda (state) + (values (%current-system system) state))) + (define %guile-for-build ;; The derivation of the Guile to be used within the build environment, ;; when using 'gexp->derivation' and co. -- cgit v1.2.3 From e5f04c2dde258c14e714e748d17b1137fe0bf4f3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 12 Feb 2016 19:12:18 +0100 Subject: profiles: Add #:system argument to profile-derivation. Suggested by David Thompson . * guix/profiles.scm (profile-derivation): Add #:system parameter and honor it. --- guix/profiles.scm | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/profiles.scm b/guix/profiles.scm index ce86ff8e0a..1c53c8047a 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2014 Alex Kost ;;; Copyright © 2015 Mark H Weaver @@ -694,11 +694,15 @@ creates the GTK+ 'icon-theme.cache' file for each theme." (define* (profile-derivation manifest #:key - (hooks %default-profile-hooks)) + (hooks %default-profile-hooks) + system) "Return a derivation that builds a profile (aka. 'user environment') with the given MANIFEST. The profile includes additional derivations returned by the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc." - (mlet %store-monad ((extras (if (null? (manifest-entries manifest)) + (mlet %store-monad ((system (if system + (return system) + (current-system))) + (extras (if (null? (manifest-entries manifest)) (return '()) (sequence %store-monad (map (lambda (hook) -- cgit v1.2.3 From 779aa003fbacbbcb6973f289b607d1d285009cec Mon Sep 17 00:00:00 2001 From: David Thompson Date: Fri, 12 Feb 2016 21:39:26 +0100 Subject: scripts: environment: Build environments as profiles. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . * guix/scripts/environment.scm (evaluate-input-search-paths) (build-inputs): Delete. (evaluate-profile-search-paths, strip-input-name) (package-or-package+output?, package-environment-inputs) (build-environment, inputs->profile-derivations): New procedures. (create-environment, show-search-paths, launch-environment) (launch-environment/container): Replace 'inputs' argument with 'profile' argument. (package+propagated-inputs): Strip off names off of input tuples. (options/resolve-packages): Handle input tuples that specify an output in expressions. (guix-environment): Convert inputs into a profile to use in the environment. Remove non-package inputs such as origins from environment inputs. * doc/guix.texi ("invoking guix environment"): Document package+output tuples for --expression option. * tests/guix-environment.sh: Update tests. * tests/guix-environment-container.sh: Likewise. Co-authored-by: Ludovic Courtès --- doc/guix.texi | 7 ++ guix/scripts/environment.scm | 239 ++++++++++++++++++++---------------- tests/guix-environment-container.sh | 2 +- tests/guix-environment.sh | 104 ++++++++++------ 4 files changed, 206 insertions(+), 146 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index ee5cb5de24..89935b476c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5093,6 +5093,13 @@ guix environment --ad-hoc -e '(@@ (gnu) %base-packages)' starts a shell with all the GuixSD base packages available. +The above commands only the use default output of the given packages. +To select other outputs, two element tuples can be specified: + +@example +guix environment --ad-hoc -e '(list (@ (gnu packages bash) bash) "include")' +@end example + @item --load=@var{file} @itemx -l @var{file} Create an environment for the package or list of packages that the code diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 2cc5f366a7..0e462de4bf 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -35,6 +35,9 @@ #:use-module (gnu system file-systems) #:use-module (gnu packages) #:use-module (gnu packages bash) + #:use-module (gnu packages commencement) + #:use-module (gnu packages guile) + #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile)) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 rdelim) @@ -45,19 +48,10 @@ #:use-module (srfi srfi-98) #:export (guix-environment)) -(define (evaluate-input-search-paths inputs search-paths) +(define (evaluate-profile-search-paths profile search-paths) "Evaluate SEARCH-PATHS, a list of search-path specifications, for the -directories corresponding to INPUTS, a list of (DERIVATION) or (DERIVATION -OUTPUT) tuples." - (let ((directories (map (match-lambda - (((? derivation? drv)) - (derivation->output-path drv)) - (((? derivation? drv) output) - (derivation->output-path drv output)) - (((? string? item)) - item)) - inputs))) - (evaluate-search-paths search-paths directories))) +directories in PROFILE, the store path of a profile." + (evaluate-search-paths search-paths (list profile))) ;; Protect some env vars from purification. Borrowed from nix-shell. (define %precious-variables @@ -81,11 +75,10 @@ as 'HOME' and 'USER' are left untouched." (((names . _) ...) names))))) -(define (create-environment inputs paths pure?) - "Set the environment variables specified by PATHS for all the packages -within INPUTS. When PURE? is #t, unset the variables in the current -environment. Otherwise, augment existing enviroment variables with additional -search paths." +(define (create-environment profile paths pure?) + "Set the environment variables specified by PATHS for PROFILE. When PURE? +is #t, unset the variables in the current environment. Otherwise, augment +existing enviroment variables with additional search paths." (when pure? (purify-environment)) (for-each (match-lambda ((($ variable _ separator) . value) @@ -94,15 +87,14 @@ search paths." (if (and current (not pure?)) (string-append value separator current) value))))) - (evaluate-input-search-paths inputs paths)) + (evaluate-profile-search-paths profile paths)) ;; Give users a way to know that they're in 'guix environment', so they can ;; adjust 'PS1' accordingly, for instance. (setenv "GUIX_ENVIRONMENT" "t")) -(define (show-search-paths inputs search-paths pure?) - "Display SEARCH-PATHS applied to the packages specified by INPUTS, a list of - (DERIVATION) or (DERIVATION OUTPUT) tuples. When PURE? is #t, do not augment +(define (show-search-paths profile search-paths pure?) + "Display SEARCH-PATHS applied to PROFILE. When PURE? is #t, do not augment existing environment variables with additional search paths." (for-each (match-lambda ((search-path . value) @@ -110,12 +102,37 @@ existing environment variables with additional search paths." (search-path-definition search-path value #:kind (if pure? 'exact 'prefix))) (newline))) - (evaluate-input-search-paths inputs search-paths))) + (evaluate-profile-search-paths profile search-paths))) + +(define (strip-input-name input) + "Remove the name element from the tuple INPUT." + (match input + ((_ package) package) + ((_ package output) + (list package output)))) (define (package+propagated-inputs package output) "Return the union of PACKAGE's OUTPUT and its transitive propagated inputs." - `((,(package-name package) ,package ,output) - ,@(package-transitive-propagated-inputs package))) + (cons (list package output) + (map strip-input-name + (package-transitive-propagated-inputs package)))) + +(define (package-or-package+output? expr) + "Return #t if EXPR is a package or a 2 element list consisting of a package +and an output string." + (match expr + ((or (? package?) ; bare package object + ((? package?) (? string?))) ; package+output tuple + #t) + (_ #f))) + +(define (package-environment-inputs package) + "Return a list of the transitive input packages for PACKAGE." + ;; Remove non-package inputs such as origin records. + (filter package-or-package+output? + (map strip-input-name + (bag-transitive-inputs + (package->bag package))))) (define (show-help) (display (_ "Usage: guix environment [OPTION]... PACKAGE... [-- COMMAND...] @@ -252,17 +269,19 @@ COMMAND or an interactive shell in that environment.\n")) (define (options/resolve-packages opts) "Return OPTS with package specification strings replaced by actual packages." - (define (package->outputs package mode) - (map (lambda (output) - (list mode package output)) - (package-outputs package))) + (define (package->output package mode) + (match package + ((? package?) + (list mode package "out")) + (((? package? package) (? string? output)) + (list mode package output)))) (define (packages->outputs packages mode) (match packages - ((? package? package) - (package->outputs package mode)) - (((? package? packages) ...) - (append-map (cut package->outputs <> mode) packages)))) + ((? package-or-package+output? package) ; single package + (list (package->output package mode))) + (((? package-or-package+output?) ...) ; many packages + (map (cut package->output <> mode) packages)))) (compact (append-map (match-lambda @@ -280,22 +299,30 @@ packages." (_ '(#f))) opts))) -(define (build-inputs inputs opts) - "Build the derivations in INPUTS, a list of (DERIVATION) or (DERIVATION -OUTPUT) tuples, using the build options in OPTS." +(define* (build-environment derivations opts) + "Build the DERIVATIONS required by the environment using the build options +in OPTS." (let ((substitutes? (assoc-ref opts 'substitutes?)) (dry-run? (assoc-ref opts 'dry-run?))) - (match inputs - (((derivations _ ...) ...) - (mbegin %store-monad - (show-what-to-build* derivations - #:use-substitutes? substitutes? - #:dry-run? dry-run?) - (if dry-run? - (return #f) - (mbegin %store-monad - (built-derivations derivations) - (return derivations)))))))) + (mbegin %store-monad + (show-what-to-build* derivations + #:use-substitutes? substitutes? + #:dry-run? dry-run?) + (if dry-run? + (return #f) + (mbegin %store-monad + (set-build-options-from-command-line* opts) + (built-derivations derivations)))))) + +(define (inputs->profile-derivation inputs system bootstrap?) + "Return the derivation for a profile consisting of INPUTS for SYSTEM. +BOOTSTRAP? specifies whether to use the bootstrap Guile to build the +profile." + (profile-derivation (packages->manifest inputs) + #:system system + #:hooks (if bootstrap? + '() + %default-profile-hooks))) (define requisites* (store-lift requisites)) @@ -334,16 +361,15 @@ variables are cleared before setting the new ones." (apply system* command)) (define* (launch-environment/container #:key command bash user-mappings - inputs paths network?) - "Run COMMAND within a Linux container. The environment features INPUTS, a -list of derivations to be shared from the host system. Environment variables -are set according to PATHS, a list of native search paths. The global shell -is BASH, a file name for a GNU Bash binary in the store. When NETWORK?, -access to the host system network is permitted. USER-MAPPINGS, a list of file -system mappings, contains the user-specified host file systems to mount inside -the container." + profile paths network?) + "Run COMMAND within a container that features the software in PROFILE. +Environment variables are set according to PATHS, a list of native search +paths. The global shell is BASH, a file name for a GNU Bash binary in the +store. When NETWORK?, access to the host system network is permitted. +USER-MAPPINGS, a list of file system mappings, contains the user-specified +host file systems to mount inside the container." (mlet %store-monad ((reqs (inputs->requisites - (cons (direct-store-path bash) inputs)))) + (list (direct-store-path bash) profile)))) (return (let* ((cwd (getcwd)) ;; Bind-mount all requisite store items, user-specified mappings, @@ -408,7 +434,7 @@ the container." (primitive-exit/status ;; A container's environment is already purified, so no need to ;; request it be purified again. - (launch-environment command inputs paths #f))) + (launch-environment command profile paths #f))) #:namespaces (if network? (delq 'net %namespaces) ; share host network %namespaces))))))) @@ -482,64 +508,65 @@ message if any test fails." (('ad-hoc-package package output) (package+propagated-inputs package output)) - (('package package output) - (bag-transitive-inputs - (package->bag package)))) + (('package package _) + (package-environment-inputs package))) packages))) (paths (delete-duplicates (cons $PATH (append-map (match-lambda - ((label (? package? p) _ ...) - (package-native-search-paths p)) - (_ - '())) + ((or ((? package? p) _ ...) + (? package? p)) + (package-native-search-paths p)) + (_ '())) inputs)) eq?))) (when container? (assert-container-features)) (with-store store - (set-build-options-from-command-line store opts) - (run-with-store store - (mlet* %store-monad ((inputs (lower-inputs - (map (match-lambda - ((label item) - (list item)) - ((label item output) - (list item output))) - inputs) - #:system system)) - ;; Containers need a Bourne shell at /bin/sh. - (bash (environment-bash container? - bootstrap? - system))) - (mbegin %store-monad + ;; Use the bootstrap Guile when requested. + (parameterize ((%guile-for-build + (package-derivation + store + (if bootstrap? + %bootstrap-guile + (canonical-package guile-2.0))))) + (set-build-options-from-command-line store opts) + (run-with-store store + ;; Containers need a Bourne shell at /bin/sh. + (mlet* %store-monad ((bash (environment-bash container? + bootstrap? + system)) + (prof-drv (inputs->profile-derivation + inputs system bootstrap?)) + (profile -> (derivation->output-path prof-drv))) ;; First build the inputs. This is necessary even for - ;; --search-paths. Additionally, we might need to build bash - ;; for a container. - (build-inputs (if (derivation? bash) - `((,bash "out") ,@inputs) - inputs) - opts) - (cond - ((assoc-ref opts 'dry-run?) - (return #t)) - ((assoc-ref opts 'search-paths) - (show-search-paths inputs paths pure?) - (return #t)) - (container? - (let ((bash-binary - (if bootstrap? - bash - (string-append (derivation->output-path bash) - "/bin/sh")))) - (launch-environment/container #:command command - #:bash bash-binary - #:user-mappings mappings - #:inputs inputs - #:paths paths - #:network? network?))) - (else - (return - (exit/status - (launch-environment command inputs paths pure?)))))))))))) + ;; --search-paths. Additionally, we might need to build bash for + ;; a container. + (mbegin %store-monad + (build-environment (if (derivation? bash) + (list prof-drv bash) + (list prof-drv)) + opts) + (cond + ((assoc-ref opts 'dry-run?) + (return #t)) + ((assoc-ref opts 'search-paths) + (show-search-paths profile paths pure?) + (return #t)) + (container? + (let ((bash-binary + (if bootstrap? + bash + (string-append (derivation->output-path bash) + "/bin/sh")))) + (launch-environment/container #:command command + #:bash bash-binary + #:user-mappings mappings + #:profile profile + #:paths paths + #:network? network?))) + (else + (return + (exit/status + (launch-environment command profile paths pure?))))))))))))) diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh index 703ab31d27..aba34a3bd0 100644 --- a/tests/guix-environment-container.sh +++ b/tests/guix-environment-container.sh @@ -73,7 +73,7 @@ guix environment --container --ad-hoc --bootstrap guile-bootstrap \ -- guile -c "$mount_test_code" > $tmpdir/mounts cat "$tmpdir/mounts" -test `wc -l < $tmpdir/mounts` -eq 3 +test `wc -l < $tmpdir/mounts` -eq 4 current_dir="`cd $PWD; pwd -P`" grep -e "$current_dir$" $tmpdir/mounts # current directory diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh index aed27c103c..5ad8dfa82a 100644 --- a/tests/guix-environment.sh +++ b/tests/guix-environment.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2015 Ludovic Courtès +# Copyright © 2015, 2016 Ludovic Courtès # # This file is part of GNU Guix. # @@ -34,17 +34,23 @@ mkdir "$tmpdir" export SHELL # Check the environment variables for the bootstrap Guile. -guix environment --ad-hoc guile-bootstrap --pure --search-paths > "$tmpdir/a" -guix environment --ad-hoc guile-bootstrap:out --pure --search-paths > "$tmpdir/b" +guix environment --bootstrap --ad-hoc guile-bootstrap --pure \ + --search-paths > "$tmpdir/a" +guix environment --bootstrap --ad-hoc guile-bootstrap:out --pure \ + --search-paths > "$tmpdir/b" # $PATH must appear in the search paths, and nothing else. -grep -E '^export PATH=.*guile-bootstrap-[0-9.]+/bin' "$tmpdir/a" +grep -E '^export PATH=.*profile/bin' "$tmpdir/a" test "`wc -l < "$tmpdir/a"`" = 1 +# Guile must be on $PATH. +test -x `sed -r 's/^export PATH="(.*)"/\1/' "$tmpdir/a"`/guile + cmp "$tmpdir/a" "$tmpdir/b" # Make sure the exit value is preserved. -if guix environment --ad-hoc guile-bootstrap --pure -- guile -c '(exit 42)' +if guix environment --bootstrap --ad-hoc guile-bootstrap --pure \ + -- guile -c '(exit 42)' then false else @@ -52,7 +58,8 @@ else fi # Same as above, but with deprecated -E flag. -if guix environment --ad-hoc guile-bootstrap --pure -E "guile -c '(exit 42)'" +if guix environment --bootstrap --ad-hoc guile-bootstrap --pure \ + -E "guile -c '(exit 42)'" then false else @@ -62,22 +69,29 @@ fi if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null then # Compute the build environment for the initial GNU Make. - guix environment -e '(@@ (gnu packages commencement) gnu-make-boot0)' \ - --no-substitutes --search-paths --pure > "$tmpdir/a" + guix environment --bootstrap --no-substitutes --search-paths --pure \ + -e '(@@ (gnu packages commencement) gnu-make-boot0)' > "$tmpdir/a" + + # Make sure bootstrap binaries are in the profile. + profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'` # Make sure the bootstrap binaries are all listed where they belong. - grep -E '^export PATH=.*-bootstrap-binaries-0/bin' "$tmpdir/a" - grep -E '^export CPATH=.*-gcc-bootstrap-0/include' "$tmpdir/a" - grep -E '^export CPATH=.*-glibc-bootstrap-0/include' "$tmpdir/a" - grep -E '^export LIBRARY_PATH=.*-glibc-bootstrap-0/lib' "$tmpdir/a" + grep -E "^export PATH=\"$profile/bin\"" "$tmpdir/a" + grep -E "^export CPATH=\"$profile/include\"" "$tmpdir/a" + grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a" + for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0 + do + guix gc --references "$profile" | grep "$dep" + done # 'make-boot0' itself must not be listed. - if grep "make-boot0" "$tmpdir/a"; then false; else true; fi + if guix gc --references "$profile" | grep make-boot0 + then false; else true; fi # Make sure that the shell spawned with '--exec' sees the same environment # as returned by '--search-paths'. - guix environment -e '(@@ (gnu packages commencement) gnu-make-boot0)' \ - --no-substitutes --pure \ + guix environment --bootstrap --no-substitutes --pure \ + -e '(@@ (gnu packages commencement) gnu-make-boot0)' \ -- /bin/sh -c 'echo $PATH $CPATH $LIBRARY_PATH' > "$tmpdir/b" ( . "$tmpdir/a" ; echo $PATH $CPATH $LIBRARY_PATH ) > "$tmpdir/c" cmp "$tmpdir/b" "$tmpdir/c" @@ -85,45 +99,57 @@ then rm "$tmpdir"/* # Compute the build environment for the initial GNU Findutils. - guix environment -e '(@@ (gnu packages commencement) findutils-boot0)' \ - --no-substitutes --search-paths --pure > "$tmpdir/a" + guix environment --bootstrap --no-substitutes --search-paths --pure \ + -e '(@@ (gnu packages commencement) findutils-boot0)' > "$tmpdir/a" + profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'` # Make sure the bootstrap binaries are all listed where they belong. - grep -E '^export PATH=.*-bootstrap-binaries-0/bin' "$tmpdir/a" - grep -E '^export PATH=.*-make-boot0-[0-9.]+/bin' "$tmpdir/a" - grep -E '^export CPATH=.*-gcc-bootstrap-0/include' "$tmpdir/a" - grep -E '^export CPATH=.*-glibc-bootstrap-0/include' "$tmpdir/a" - grep -E '^export LIBRARY_PATH=.*-glibc-bootstrap-0/lib' "$tmpdir/a" + grep -E "^export PATH=\"$profile/bin\"" "$tmpdir/a" + grep -E "^export CPATH=\"$profile/include\"" "$tmpdir/a" + grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a" + for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0 \ + make-boot0 + do + guix gc --references "$profile" | grep "$dep" + done # The following test assumes 'make-boot0' has a "debug" output. make_boot0_debug="`guix build -e '(@@ (gnu packages commencement) gnu-make-boot0)' | grep -e -debug`" test "x$make_boot0_debug" != "x" # Make sure the "debug" output is not listed. - if grep -E "$make_boot0_debug" "$tmpdir/a"; then false; else true; fi + if guix gc --references "$profile" | grep "$make_boot0_debug" + then false; else true; fi # Compute the build environment for the initial GNU Make, but add in the # bootstrap Guile as an ad-hoc addition. - guix environment -e '(@@ (gnu packages commencement) gnu-make-boot0)' \ - --ad-hoc guile-bootstrap --no-substitutes --search-paths \ - --pure > "$tmpdir/a" + guix environment --bootstrap --no-substitutes --search-paths --pure \ + -e '(@@ (gnu packages commencement) gnu-make-boot0)' \ + --ad-hoc guile-bootstrap > "$tmpdir/a" + profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'` # Make sure the bootstrap binaries are all listed where they belong. - cat $tmpdir/a - grep -E '^export PATH=.*-bootstrap-binaries-0/bin' "$tmpdir/a" - grep -E '^export PATH=.*-guile-bootstrap-2.0/bin' "$tmpdir/a" - grep -E '^export CPATH=.*-gcc-bootstrap-0/include' "$tmpdir/a" - grep -E '^export CPATH=.*-glibc-bootstrap-0/include' "$tmpdir/a" - grep -E '^export LIBRARY_PATH=.*-glibc-bootstrap-0/lib' "$tmpdir/a" - - # Make sure a package list can be used with -e. + grep -E "^export PATH=\"$profile/bin\"" "$tmpdir/a" + grep -E "^export CPATH=\"$profile/include\"" "$tmpdir/a" + grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a" + for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0 \ + guile-bootstrap + do + guix gc --references "$profile" | grep "$dep" + done + + # Make sure a package list with plain package objects and package+output + # tuples can be used with -e. expr_list_test_code=" (list (@@ (gnu packages commencement) gnu-make-boot0) - (@ (gnu packages bootstrap) %bootstrap-guile))" + (list (@ (gnu packages bootstrap) %bootstrap-guile) \"out\"))" - guix environment --ad-hoc --no-substitutes --search-paths --pure \ - -e "$expr_list_test_code" > "$tmpdir/a" + guix environment --bootstrap --ad-hoc --no-substitutes --search-paths \ + --pure -e "$expr_list_test_code" > "$tmpdir/a" + profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'` - grep -E '^export PATH=.*-make-boot0-4.1/bin' "$tmpdir/a" - grep -E '^export PATH=.*-guile-bootstrap-2.0/bin' "$tmpdir/a" + for dep in make-boot0 guile-bootstrap + do + guix gc --references "$profile" | grep "$dep" + done fi -- cgit v1.2.3 From d29f64707719bb44e15668f71d4e7fbcd74acb40 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Thu, 11 Feb 2016 21:28:41 +0100 Subject: licenses: Add tcl/tk license. * guix/licenses.scm (tcl/tk): New variable. Signed-off-by: Leo Famulari --- guix/licenses.scm | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'guix') diff --git a/guix/licenses.scm b/guix/licenses.scm index a43ab438f1..1abb0a150e 100644 --- a/guix/licenses.scm +++ b/guix/licenses.scm @@ -63,6 +63,7 @@ sgifreeb2.0 silofl1.1 sleepycat + tcl/tk unlicense vim x11 x11-style @@ -388,6 +389,11 @@ at URI, which may be a file:// URI pointing the package's tree." "http://directory.fsf.org/wiki/License:Sleepycat" "https://www.gnu.org/licenses/license-list#BerkeleyDB")) +(define tcl/tk + (license "Tcl/Tk" + "http://www.tcl.tk/software/tcltk/license.html" + "A non-copyleft free software license from the Tcl/Tk project")) + (define vim (license "Vim" "http://directory.fsf.org/wiki/License:Vim7.2" -- cgit v1.2.3 From a10bf13915891ebcc09045b9a1eab2b383325145 Mon Sep 17 00:00:00 2001 From: Rene Saavedra Date: Mon, 15 Feb 2016 19:23:34 -0600 Subject: licenses: Add CC-BY-SA and CC-BY. * guix/licenses.scm (cc-by-sa2.0, cc-by2.0): New variables. Signed-off-by: Alex Kost --- guix/licenses.scm | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/licenses.scm b/guix/licenses.scm index 1abb0a150e..54488d3f1f 100644 --- a/guix/licenses.scm +++ b/guix/licenses.scm @@ -7,6 +7,7 @@ ;;; Copyright © 2016 Eric Bavier ;;; Copyright © 2016 Leo Famulari ;;; Copyright © 2016 Fabian Harfert +;;; Copyright © 2016 Rene Saavedra ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,7 +34,7 @@ non-copyleft bsd-style ;deprecated! cc0 - cc-by-sa4.0 cc-by-sa3.0 cc-by3.0 + cc-by2.0 cc-by3.0 cc-by-sa2.0 cc-by-sa3.0 cc-by-sa4.0 cddl1.0 cecill-c artistic2.0 clarified-artistic @@ -155,11 +156,21 @@ at URI, which may be a file:// URI pointing the package's tree." "http://creativecommons.org/licenses/by-sa/3.0/" "Creative Commons Attribution-ShareAlike 3.0 Unported")) +(define cc-by-sa2.0 + (license "CC-BY-SA 2.0" + "http://creativecommons.org/licenses/by-sa/2.0/" + "Creative Commons Attribution-ShareAlike 2.0 Generic")) + (define cc-by3.0 (license "CC-BY 3.0" "http://creativecommons.org/licenses/by/3.0/" "Creative Commons Attribution 3.0 Unported")) +(define cc-by2.0 + (license "CC-BY 2.0" + "http://creativecommons.org/licenses/by/2.0/" + "Creative Commons Attribution 2.0 Generic")) + (define cddl1.0 (license "CDDL 1.0" "http://directory.fsf.org/wiki/License:CDDLv1.0" -- cgit v1.2.3 From fbc5b815cce85a6af75226ab16acf243fd7d22ce Mon Sep 17 00:00:00 2001 From: Ben Woodcroft Date: Fri, 1 Jan 2016 16:56:07 +1000 Subject: import: gem: Add updater. * guix/import/gem.scm (guix-package->gem-name, gem-package?, latest-release): New procedures. (%gem-updater): New variable. (rubygems-fetch): Wrap body in 'call-with-output-file' and 'with-error-to-port'. * guix/scripts/refresh.scm (%updaters): Add %GEM-UPDATER. * doc/guix.texi (Invoking guix refresh): Mention RubyGems. --- doc/guix.texi | 2 ++ guix/import/gem.scm | 63 +++++++++++++++++++++++++++++++++++++++++++++--- guix/scripts/refresh.scm | 5 +++- 3 files changed, 66 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index c5a7de7c3b..b991cc1da4 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4571,6 +4571,8 @@ the updater for @uref{http://cran.r-project.org/, CRAN} packages; the updater for @uref{http://www.bioconductor.org/, Bioconductor} R packages; @item pypi the updater for @uref{https://pypi.python.org, PyPI} packages. +@item gem +the updater for @uref{https://rubygems.org, RubyGems} packages. @end table For instance, the following command only checks for updates of Emacs diff --git a/guix/import/gem.scm b/guix/import/gem.scm index 4b2a253130..b46622f00d 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson +;;; Copryight © 2016 Ben Woodcroft ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,21 +20,33 @@ (define-module (guix import gem) #:use-module (ice-9 match) #:use-module (ice-9 pretty-print) + #:use-module (srfi srfi-1) #:use-module (rnrs bytevectors) #:use-module (json) #:use-module (web uri) + #:use-module ((guix download) #:prefix download:) #:use-module (guix import utils) #:use-module (guix import json) #:use-module (guix packages) + #:use-module (guix upstream) #:use-module (guix licenses) #:use-module (guix base32) - #:export (gem->guix-package)) + #:use-module (guix build-system ruby) + #:use-module (gnu packages) + #:export (gem->guix-package + %gem-updater)) (define (rubygems-fetch name) "Return an alist representation of the RubyGems metadata for the package NAME, or #f on failure." - (json-fetch - (string-append "https://rubygems.org/api/v1/gems/" name ".json"))) + ;; XXX: We want to silence the download progress report, which is especially + ;; annoying for 'guix refresh', but we have to use a file port. + (call-with-output-file "/dev/null" + (lambda (null) + (with-error-to-port null + (lambda () + (json-fetch + (string-append "https://rubygems.org/api/v1/gems/" name ".json"))))))) (define (ruby-package-name name) "Given the NAME of a package on RubyGems, return a Guix-compliant name for @@ -132,3 +145,47 @@ VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES." (assoc-ref package "licenses")))) (make-gem-sexp name version hash home-page synopsis description dependencies licenses))))) + +(define (guix-package->gem-name package) + "Given a PACKAGE built from rubygems.org, return the name of the +package on RubyGems." + (let ((source-url (and=> (package-source package) origin-uri))) + ;; The URL has the form: + ;; 'https://rubygems.org/downloads/' + + ;; package name + '-' + version + '.gem' + ;; e.g. "https://rubygems.org/downloads/hashery-2.1.1.gem" + (substring source-url 31 (string-rindex source-url #\-)))) + +(define (gem-package? package) + "Return true if PACKAGE is a gem package from RubyGems." + + (define (rubygems-url? url) + (string-prefix? "https://rubygems.org/downloads/" url)) + + (let ((source-url (and=> (package-source package) origin-uri)) + (fetch-method (and=> (package-source package) origin-method))) + (and (eq? fetch-method download:url-fetch) + (match source-url + ((? string?) + (rubygems-url? source-url)) + ((source-url ...) + (any rubygems-url? source-url)))))) + +(define (latest-release guix-package) + "Return an for the latest release of GUIX-PACKAGE." + (let* ((gem-name (guix-package->gem-name + (specification->package guix-package))) + (metadata (rubygems-fetch gem-name)) + (version (assoc-ref metadata "version")) + (url (rubygems-uri gem-name version))) + (upstream-source + (package guix-package) + (version version) + (urls (list url))))) + +(define %gem-updater + (upstream-updater + (name 'gem) + (description "Updater for RubyGem packages") + (pred gem-package?) + (latest latest-release))) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index f9e3f31a03..bb38f09688 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2015 Alex Kost +;;; Copyright © 2016 Ben Woodcroft ;;; ;;; This file is part of GNU Guix. ;;; @@ -34,6 +35,7 @@ #:select (%gnu-updater %gnome-updater)) #:use-module (guix import elpa) #:use-module (guix import cran) + #:use-module (guix import gem) #:use-module (guix gnupg) #:use-module (gnu packages) #:use-module ((gnu packages commencement) #:select (%final-inputs)) @@ -196,7 +198,8 @@ unavailable optional dependencies such as Guile-JSON." %elpa-updater %cran-updater %bioconductor-updater - ((guix import pypi) => %pypi-updater))) + ((guix import pypi) => %pypi-updater) + ((guix import gem) => %gem-updater))) (define (lookup-updater name) "Return the updater called NAME." -- cgit v1.2.3 From 95001d4b4677b64f26a4bf202a77267830bb7039 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 22 Feb 2016 00:29:54 +0100 Subject: download: Add 'url-fetch/tarbomb'. Suggested by Federico Beffa. Fixes . Reported by Danny Milosavljevic . * gnu/packages/engineering.scm (broken-tarball-fetch): Remove. (fastcap)[source](method): Use URL-FETCH/TARBOMB instead. * gnu/packages/scheme.scm (broken-tarball-fetch): Remove. (scmutils)[source](method): Use URL-FETCH/TARBOMB instead. * guix/download.scm (url-fetch/tarbomb): New procedure, renamed from 'broken-tarball-fetch'. --- gnu/packages/engineering.scm | 21 +-------------------- gnu/packages/scheme.scm | 8 +------- guix/download.scm | 29 ++++++++++++++++++++++++++++- 3 files changed, 30 insertions(+), 28 deletions(-) (limited to 'guix') diff --git a/gnu/packages/engineering.scm b/gnu/packages/engineering.scm index 204ea9dc02..9a36ffbb31 100644 --- a/gnu/packages/engineering.scm +++ b/gnu/packages/engineering.scm @@ -203,31 +203,12 @@ and design rule checking. It also includes an autorouter and a trace optimizer; and it can produce photorealistic and design review images.") (license license:gpl2+))) -(define* (broken-tarball-fetch url hash-algo hash - #:optional name - #:key (system (%current-system)) - (guile (default-guile))) - (mlet %store-monad ((drv (url-fetch url hash-algo hash - (string-append "tarbomb-" name) - #:system system - #:guile guile))) - ;; Take the tar bomb, and simply unpack it as a directory. - (gexp->derivation name - #~(begin - (mkdir #$output) - (setenv "PATH" - (string-append #$gzip "/bin")) - (chdir #$output) - (zero? (system* (string-append #$tar "/bin/tar") - "xf" #$drv)))))) - - (define-public fastcap (package (name "fastcap") (version "2.0-18Sep92") (source (origin - (method broken-tarball-fetch) + (method url-fetch/tarbomb) (file-name (string-append name "-" version ".tar.gz")) (uri (string-append "http://www.rle.mit.edu/cpg/codes/" name "-" version ".tgz")) diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm index 352b66c59b..00b573fc0b 100644 --- a/gnu/packages/scheme.scm +++ b/gnu/packages/scheme.scm @@ -526,12 +526,6 @@ an isolated heap allowing multiple VMs to run simultaneously in different OS threads.") (license bsd-3))) -;; FIXME: This function is temporarily in the engineering module and not -;; exported. It will be moved to an utility module for general use. Once -;; this is done, we should remove this definition. -(define broken-tarball-fetch - (@@ (gnu packages engineering) broken-tarball-fetch)) - (define-public scmutils (let () (define (system-suffix) @@ -546,7 +540,7 @@ threads.") (version "20140302") (source (origin - (method broken-tarball-fetch) + (method url-fetch/tarbomb) (modules '((guix build utils))) (snippet ;; Remove binary code diff --git a/guix/download.scm b/guix/download.scm index 204cfc0826..88f285dc0a 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès ;;; Copyright © 2013, 2014, 2015 Andreas Enge +;;; Copyright © 2015 Federico Beffa ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,6 +32,7 @@ #:use-module (srfi srfi-26) #:export (%mirrors url-fetch + url-fetch/tarbomb download-to-store)) ;;; Commentary: @@ -294,6 +296,31 @@ in the store." ;; .) #:local-build? #t))))) +(define* (url-fetch/tarbomb url hash-algo hash + #:optional name + #:key (system (%current-system)) + (guile (default-guile))) + "Similar to 'url-fetch' but unpack the file from URL in a directory of its +own. This helper makes it easier to deal with \"tar bombs\"." + (define gzip + (module-ref (resolve-interface '(gnu packages compression)) 'gzip)) + (define tar + (module-ref (resolve-interface '(gnu packages base)) 'tar)) + + (mlet %store-monad ((drv (url-fetch url hash-algo hash + (string-append "tarbomb-" name) + #:system system + #:guile guile))) + ;; Take the tar bomb, and simply unpack it as a directory. + (gexp->derivation name + #~(begin + (mkdir #$output) + (setenv "PATH" (string-append #$gzip "/bin")) + (chdir #$output) + (zero? (system* (string-append #$tar "/bin/tar") + "xf" #$drv))) + #:local-build? #t))) + (define* (download-to-store store url #:optional (name (basename url)) #:key (log (current-error-port)) recursive?) "Download from URL to STORE, either under NAME or URL's basename if -- cgit v1.2.3 From 0db71dd2d142cab3713e567bbb10632169b19ace Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Wed, 17 Feb 2016 21:19:16 -0500 Subject: licenses: Add repoze license. * guix/licenses.scm (repoze): New variable. --- guix/licenses.scm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'guix') diff --git a/guix/licenses.scm b/guix/licenses.scm index 54488d3f1f..61e679358a 100644 --- a/guix/licenses.scm +++ b/guix/licenses.scm @@ -60,6 +60,7 @@ openldap2.8 openssl psfl public-domain qpl + repoze ruby sgifreeb2.0 silofl1.1 @@ -380,6 +381,12 @@ at URI, which may be a file:// URI pointing the package's tree." "http://directory.fsf.org/wiki/License:QPLv1.0" "http://www.gnu.org/licenses/license-list.html#QPL")) +(define repoze + (license "Repoze" + "http://repoze.org/LICENSE.txt" + "A BSD-like license with a clause requiring all changes to be + attributed by author and date.")) + (define ruby (license "Ruby License" "http://directory.fsf.org/wiki/License:Ruby" -- cgit v1.2.3 From 7adf9b8469f3f043e61d1c9614aea8abb63fb727 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 22 Feb 2016 16:29:44 +0100 Subject: derivations: Move grafts to (guix grafts). * guix/derivations.scm (, graft-derivation, %graft?) (set-grafting): Move to... * guix/grafts.scm: ... here. New file. * guix/gexp.scm, guix/packages.scm, tests/packages.scm, guix/scripts/build.scm: Use it. * Makefile.am (MODULES): Add it. (SCM_TESTS): Add tests/grafts.scm. * tests/derivations.scm ("graft-derivation"): Move to... * tests/grafts.scm: ... here. New file. --- Makefile.am | 2 + guix/derivations.scm | 98 -------------------------------------- guix/gexp.scm | 3 +- guix/grafts.scm | 127 +++++++++++++++++++++++++++++++++++++++++++++++++ guix/packages.scm | 3 +- guix/scripts/build.scm | 1 + tests/derivations.scm | 34 ------------- tests/grafts.scm | 81 +++++++++++++++++++++++++++++++ tests/packages.scm | 3 +- 9 files changed, 217 insertions(+), 135 deletions(-) create mode 100644 guix/grafts.scm create mode 100644 tests/grafts.scm (limited to 'guix') diff --git a/Makefile.am b/Makefile.am index 9beeb9d564..01d7fbecb7 100644 --- a/Makefile.am +++ b/Makefile.am @@ -49,6 +49,7 @@ MODULES = \ guix/serialization.scm \ guix/nar.scm \ guix/derivations.scm \ + guix/grafts.scm \ guix/gnu-maintenance.scm \ guix/upstream.scm \ guix/licenses.scm \ @@ -220,6 +221,7 @@ SCM_TESTS = \ tests/substitute.scm \ tests/builders.scm \ tests/derivations.scm \ + tests/grafts.scm \ tests/ui.scm \ tests/records.scm \ tests/utils.scm \ diff --git a/guix/derivations.scm b/guix/derivations.scm index 5db739a97d..1164774009 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -85,21 +85,11 @@ derivation-path->output-paths derivation - graft - graft? - graft-origin - graft-replacement - graft-origin-output - graft-replacement-output - graft-derivation - map-derivation build-derivations built-derivations - %graft? - set-grafting build-expression->derivation) @@ -1111,81 +1101,6 @@ they can refer to each other." #:guile-for-build guile #:local-build? #t))) -(define-record-type* graft make-graft - graft? - (origin graft-origin) ;derivation | store item - (origin-output graft-origin-output ;string | #f - (default "out")) - (replacement graft-replacement) ;derivation | store item - (replacement-output graft-replacement-output ;string | #f - (default "out"))) - -(define* (graft-derivation store name drv grafts - #:key (guile (%guile-for-build)) - (system (%current-system))) - "Return a derivation called NAME, based on DRV but with all the GRAFTS -applied." - ;; XXX: Someday rewrite using gexps. - (define mapping - ;; List of store item pairs. - (map (match-lambda - (($ source source-output target target-output) - (cons (if (derivation? source) - (derivation->output-path source source-output) - source) - (if (derivation? target) - (derivation->output-path target target-output) - target)))) - grafts)) - - (define outputs - (match (derivation-outputs drv) - (((names . outputs) ...) - (map derivation-output-path outputs)))) - - (define output-names - (match (derivation-outputs drv) - (((names . outputs) ...) - names))) - - (define build - `(begin - (use-modules (guix build graft) - (guix build utils) - (ice-9 match)) - - (let ((mapping ',mapping)) - (for-each (lambda (input output) - (format #t "grafting '~a' -> '~a'...~%" input output) - (force-output) - (rewrite-directory input output - `((,input . ,output) - ,@mapping))) - ',outputs - (match %outputs - (((names . files) ...) - files)))))) - - (define add-label - (cut cons "x" <>)) - - (match grafts - ((($ sources source-outputs targets target-outputs) ...) - (let ((sources (zip sources source-outputs)) - (targets (zip targets target-outputs))) - (build-expression->derivation store name build - #:system system - #:guile-for-build guile - #:modules '((guix build graft) - (guix build utils)) - #:inputs `(,@(map (lambda (out) - `("x" ,drv ,out)) - output-names) - ,@(append (map add-label sources) - (map add-label targets))) - #:outputs output-names - #:local-build? #t))))) - (define* (build-expression->derivation store name exp ;deprecated #:key (system (%current-system)) @@ -1353,16 +1268,3 @@ ALLOWED-REFERENCES, LOCAL-BUILD?, and SUBSTITUTABLE?." (define built-derivations (store-lift build-derivations)) - -;; The following might feel more at home in (guix packages) but since (guix -;; gexp), which is a lower level, needs them, we put them here. - -(define %graft? - ;; Whether to honor package grafts by default. - (make-parameter #t)) - -(define (set-grafting enable?) - "This monadic procedure enables grafting when ENABLE? is true, and disables -it otherwise. It returns the previous setting." - (lambda (store) - (values (%graft? enable?) store))) diff --git a/guix/gexp.scm b/guix/gexp.scm index 35adc179a1..87bc316f97 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,6 +20,7 @@ #:use-module (guix store) #:use-module (guix monads) #:use-module (guix derivations) + #:use-module (guix grafts) #:use-module (guix utils) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) diff --git a/guix/grafts.scm b/guix/grafts.scm new file mode 100644 index 0000000000..6b78a784e7 --- /dev/null +++ b/guix/grafts.scm @@ -0,0 +1,127 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014, 2015, 2016 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 grafts) + #:use-module (guix records) + #:use-module (guix derivations) + #:use-module ((guix utils) #:select (%current-system)) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (ice-9 match) + #:export (graft? + graft + graft-origin + graft-replacement + graft-origin-output + graft-replacement-output + + graft-derivation + + %graft? + set-grafting)) + +(define-record-type* graft make-graft + graft? + (origin graft-origin) ;derivation | store item + (origin-output graft-origin-output ;string | #f + (default "out")) + (replacement graft-replacement) ;derivation | store item + (replacement-output graft-replacement-output ;string | #f + (default "out"))) + +(define* (graft-derivation store name drv grafts + #:key (guile (%guile-for-build)) + (system (%current-system))) + "Return a derivation called NAME, based on DRV but with all the GRAFTS +applied." + ;; XXX: Someday rewrite using gexps. + (define mapping + ;; List of store item pairs. + (map (match-lambda + (($ source source-output target target-output) + (cons (if (derivation? source) + (derivation->output-path source source-output) + source) + (if (derivation? target) + (derivation->output-path target target-output) + target)))) + grafts)) + + (define outputs + (match (derivation-outputs drv) + (((names . outputs) ...) + (map derivation-output-path outputs)))) + + (define output-names + (match (derivation-outputs drv) + (((names . outputs) ...) + names))) + + (define build + `(begin + (use-modules (guix build graft) + (guix build utils) + (ice-9 match)) + + (let ((mapping ',mapping)) + (for-each (lambda (input output) + (format #t "grafting '~a' -> '~a'...~%" input output) + (force-output) + (rewrite-directory input output + `((,input . ,output) + ,@mapping))) + ',outputs + (match %outputs + (((names . files) ...) + files)))))) + + (define add-label + (cut cons "x" <>)) + + (match grafts + ((($ sources source-outputs targets target-outputs) ...) + (let ((sources (zip sources source-outputs)) + (targets (zip targets target-outputs))) + (build-expression->derivation store name build + #:system system + #:guile-for-build guile + #:modules '((guix build graft) + (guix build utils)) + #:inputs `(,@(map (lambda (out) + `("x" ,drv ,out)) + output-names) + ,@(append (map add-label sources) + (map add-label targets))) + #:outputs output-names + #:local-build? #t))))) + + +;; The following might feel more at home in (guix packages) but since (guix +;; gexp), which is a lower level, needs them, we put them here. + +(define %graft? + ;; Whether to honor package grafts by default. + (make-parameter #t)) + +(define (set-grafting enable?) + "This monadic procedure enables grafting when ENABLE? is true, and disables +it otherwise. It returns the previous setting." + (lambda (store) + (values (%graft? enable?) store))) + +;;; grafts.scm ends here diff --git a/guix/packages.scm b/guix/packages.scm index 6ec168c204..93bfbc4683 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès ;;; Copyright © 2014, 2015 Mark H Weaver ;;; Copyright © 2015 Eric Bavier ;;; @@ -25,6 +25,7 @@ #:use-module (guix monads) #:use-module (guix gexp) #:use-module (guix base32) + #:use-module (guix grafts) #:use-module (guix derivations) #:use-module (guix build-system) #:use-module (guix search-paths) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index aa9c105f58..8725ddad88 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -23,6 +23,7 @@ #:use-module (guix store) #:use-module (guix derivations) #:use-module (guix packages) + #:use-module (guix grafts) #:use-module (guix utils) #:use-module (guix monads) #:use-module (guix gexp) diff --git a/tests/derivations.scm b/tests/derivations.scm index db96e26ab1..9b53019cc5 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -929,40 +929,6 @@ ((p2 . _) (stringderivation %store "graft" build - #:inputs `(("a" ,%bash) - ("b" ,%mkdir)))) - (one (add-text-to-store %store "bash" "fake bash")) - (two (build-expression->derivation %store "mkdir" - '(call-with-output-file %output - (lambda (port) - (display "fake mkdir" port))))) - (graft (graft-derivation %store "graft" orig - (list (graft - (origin %bash) - (replacement one)) - (graft - (origin %mkdir) - (replacement two)))))) - (and (build-derivations %store (list graft)) - (let ((two (derivation->output-path two)) - (graft (derivation->output-path graft))) - (and (string=? (format #f "foo/~a/bar" two) - (call-with-input-file (string-append graft "/text") - get-string-all)) - (string=? (readlink (string-append graft "/sh")) one) - (string=? (readlink (string-append graft "/self")) graft)))))) - (test-equal "map-derivation" "hello" (let* ((joke (package-derivation %store guile-1.8)) diff --git a/tests/grafts.scm b/tests/grafts.scm new file mode 100644 index 0000000000..c11403be19 --- /dev/null +++ b/tests/grafts.scm @@ -0,0 +1,81 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014, 2015, 2016 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 (test-grafts) + #:use-module (guix derivations) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix grafts) + #:use-module (guix tests) + #:use-module ((gnu packages) #:select (search-bootstrap-binary)) + #:use-module (srfi srfi-64) + #:use-module (rnrs io ports)) + +(define %store + (open-connection-for-tests)) + +(define (bootstrap-binary name) + (let ((bin (search-bootstrap-binary name (%current-system)))) + (and %store + (add-to-store %store name #t "sha256" bin)))) + +(define %bash + (bootstrap-binary "bash")) +(define %mkdir + (bootstrap-binary "mkdir")) + + +(test-begin "grafts") + +(test-assert "graft-derivation" + (let* ((build `(begin + (mkdir %output) + (chdir %output) + (symlink %output "self") + (call-with-output-file "text" + (lambda (output) + (format output "foo/~a/bar" ,%mkdir))) + (symlink ,%bash "sh"))) + (orig (build-expression->derivation %store "graft" build + #:inputs `(("a" ,%bash) + ("b" ,%mkdir)))) + (one (add-text-to-store %store "bash" "fake bash")) + (two (build-expression->derivation %store "mkdir" + '(call-with-output-file %output + (lambda (port) + (display "fake mkdir" port))))) + (graft (graft-derivation %store "graft" orig + (list (graft + (origin %bash) + (replacement one)) + (graft + (origin %mkdir) + (replacement two)))))) + (and (build-derivations %store (list graft)) + (let ((two (derivation->output-path two)) + (graft (derivation->output-path graft))) + (and (string=? (format #f "foo/~a/bar" two) + (call-with-input-file (string-append graft "/text") + get-string-all)) + (string=? (readlink (string-append graft "/sh")) one) + (string=? (readlink (string-append graft "/self")) graft)))))) + +(test-end) + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) diff --git a/tests/packages.scm b/tests/packages.scm index 9d37fb68d6..68ab3f897b 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,6 +29,7 @@ #:use-module (guix hash) #:use-module (guix derivations) #:use-module (guix packages) + #:use-module (guix grafts) #:use-module (guix search-paths) #:use-module (guix build-system) #:use-module (guix build-system trivial) -- cgit v1.2.3 From b0fef4d660ca86fdda5749356fbc29a456e7a326 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 22 Feb 2016 19:02:16 +0100 Subject: grafts: 'name' parameter of 'graft-derivation' is now optional. * guix/grafts.scm (graft-derivation): Name 'name' a keyword parameter. * guix/packages.scm (package-derivation, package-cross-derivation): Adjust accordingly. * tests/grafts.scm ("graft-derivation"): Likewise. * tests/packages.scm ("package-derivation, indirect grafts"): Likewise. --- guix/grafts.scm | 6 ++++-- guix/packages.scm | 4 ++-- tests/grafts.scm | 2 +- tests/packages.scm | 2 +- 4 files changed, 8 insertions(+), 6 deletions(-) (limited to 'guix') diff --git a/guix/grafts.scm b/guix/grafts.scm index 6b78a784e7..5074809c43 100644 --- a/guix/grafts.scm +++ b/guix/grafts.scm @@ -44,8 +44,10 @@ (replacement-output graft-replacement-output ;string | #f (default "out"))) -(define* (graft-derivation store name drv grafts - #:key (guile (%guile-for-build)) +(define* (graft-derivation store drv grafts + #:key + (name (derivation-name drv)) + (guile (%guile-for-build)) (system (%current-system))) "Return a derivation called NAME, based on DRV but with all the GRAFTS applied." diff --git a/guix/packages.scm b/guix/packages.scm index 93bfbc4683..f6afaeb510 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -985,7 +985,7 @@ This is an internal procedure." (grafts (let ((guile (package-derivation store (default-guile) system #:graft? #f))) - (graft-derivation store (bag-name bag) drv grafts + (graft-derivation store drv grafts #:system system #:guile guile)))) drv)))) @@ -1003,7 +1003,7 @@ system identifying string)." (() drv) (grafts - (graft-derivation store (bag-name bag) drv grafts + (graft-derivation store drv grafts #:system system #:guile (package-derivation store (default-guile) diff --git a/tests/grafts.scm b/tests/grafts.scm index c11403be19..4a4122a3e9 100644 --- a/tests/grafts.scm +++ b/tests/grafts.scm @@ -59,7 +59,7 @@ '(call-with-output-file %output (lambda (port) (display "fake mkdir" port))))) - (graft (graft-derivation %store "graft" orig + (graft (graft-derivation %store orig (list (graft (origin %bash) (replacement one)) diff --git a/tests/packages.scm b/tests/packages.scm index 68ab3f897b..6315c2204f 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -616,7 +616,7 @@ (guile (package-derivation %store (canonical-package guile-2.0) #:graft? #f))) (equal? (package-derivation %store dummy) - (graft-derivation %store "dummy-0" + (graft-derivation %store (package-derivation %store dummy #:graft? #f) (package-grafts %store dummy) -- cgit v1.2.3 From 305b58c05c6e04e165489373b2ab3355b64afebf Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 23 Feb 2016 12:58:25 +0100 Subject: refresh: Remove unneeded import. Reported by Leo Famulari and Ben Woodcroft at . * guix/scripts/refresh.scm: Remove unneeded and harmful import of (guix import gem). --- guix/scripts/refresh.scm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index bb38f09688..9ddde2dbad 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2015 Alex Kost @@ -35,7 +35,6 @@ #:select (%gnu-updater %gnome-updater)) #:use-module (guix import elpa) #:use-module (guix import cran) - #:use-module (guix import gem) #:use-module (guix gnupg) #:use-module (gnu packages) #:use-module ((gnu packages commencement) #:select (%final-inputs)) -- cgit v1.2.3 From 4d459d87347905d7602fbc14cdd786a04c8bf67e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 24 Feb 2016 13:00:11 +0100 Subject: publish: Move 'query-path-info' call where it belongs. * guix/scripts/publish.scm (narinfo-string): Remove 'path-info' parameter and add 'store' parameter. Call 'query-path-info'. (render-narinfo): Adjust accordingly. --- guix/scripts/publish.scm | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) (limited to 'guix') diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index fb7b4218e0..3d197384d6 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson -;;; Copyright © 2015 Ludovic Courtès +;;; Copyright © 2015, 2016 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -142,10 +142,11 @@ Publish ~a over HTTP.\n") %store-directory) (define base64-encode-string (compose base64-encode string->utf8)) -(define (narinfo-string store-path path-info key) - "Generate a narinfo key/value string for STORE-PATH using the details in -PATH-INFO. The narinfo is signed with KEY." - (let* ((url (string-append "nar/" (basename store-path))) +(define (narinfo-string store store-path key) + "Generate a narinfo key/value string for STORE-PATH; an exception is raised +if STORE-PATH is invalid. The narinfo is signed with KEY." + (let* ((path-info (query-path-info store store-path)) + (url (string-append "nar/" (basename store-path))) (hash (bytevector->nix-base32-string (path-info-hash path-info))) (size (path-info-nar-size path-info)) @@ -199,15 +200,13 @@ References: ~a~%" (define (render-narinfo store request hash) "Render metadata for the store path corresponding to HASH." - (let* ((store-path (hash-part->path store hash)) - (path-info (and (not (string-null? store-path)) - (query-path-info store store-path)))) - (if path-info + (let ((store-path (hash-part->path store hash))) + (if (string-null? store-path) + (not-found request) (values '((content-type . (application/x-nix-narinfo))) (cut display - (narinfo-string store-path path-info (force %private-key)) - <>)) - (not-found request)))) + (narinfo-string store store-path (force %private-key)) + <>))))) (define (render-nar request store-item) "Render archive of the store path corresponding to STORE-ITEM." -- cgit v1.2.3 From 6caa4dfa37e9b87336908e188500c14b402a0090 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Tue, 23 Feb 2016 11:38:00 +0300 Subject: Do not check package freshness during upgrade. Fixes . Reported by Andreas Enge . * gnu/packages.scm (waiting, ftp-open*, check-package-freshness): Remove. * guix/scripts/package.scm (options->installable): Adjust accordingly. * emacs/guix-main.scm (package->manifest-entry*): Likewise. --- emacs/guix-main.scm | 4 +-- gnu/packages.scm | 69 +----------------------------------------------- guix/scripts/package.scm | 12 +++------ 3 files changed, 6 insertions(+), 79 deletions(-) (limited to 'guix') diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index 335686ed25..11b9c773b9 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -856,9 +856,7 @@ parameter/value pairs." (define* (package->manifest-entry* package #:optional output) (and package - (begin - (check-package-freshness package) - (package->manifest-entry package output)))) + (package->manifest-entry package output))) (define* (make-install-manifest-entries id #:optional output) (package->manifest-entry* (package-by-id id) output)) diff --git a/gnu/packages.scm b/gnu/packages.scm index b309a7806d..64a695d970 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès ;;; Copyright © 2013 Mark H Weaver ;;; Copyright © 2014 Eric Bavier +;;; Copyright © 2016 Alex Kost ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,9 +23,6 @@ #:use-module (guix packages) #:use-module (guix ui) #:use-module (guix utils) - #:use-module ((guix ftp-client) #:select (ftp-open)) - #:use-module (guix gnu-maintenance) - #:use-module (guix upstream) #:use-module (ice-9 ftw) #:use-module (ice-9 vlist) #:use-module (ice-9 match) @@ -46,8 +44,6 @@ find-best-packages-by-name find-newest-available-packages - check-package-freshness - specification->package specification->package+output)) @@ -280,69 +276,6 @@ return its return value." (lambda (k signum) (handler signum)))) -(define-syntax-rule (waiting exp fmt rest ...) - "Display the given message while EXP is being evaluated." - (let* ((message (format #f fmt rest ...)) - (blank (make-string (string-length message) #\space))) - (display message (current-error-port)) - (force-output (current-error-port)) - (call-with-sigint-handler - (lambda () - (dynamic-wind - (const #f) - (lambda () exp) - (lambda () - ;; Clear the line. - (display #\cr (current-error-port)) - (display blank (current-error-port)) - (display #\cr (current-error-port)) - (force-output (current-error-port))))) - (lambda (signum) - (format (current-error-port) " interrupted by signal ~a~%" SIGINT) - #f)))) - -(define ftp-open* - ;; Memoizing version of `ftp-open'. The goal is to avoid initiating a new - ;; FTP connection for each package, esp. since most of them are to the same - ;; server. This has a noticeable impact when doing "guix upgrade -u". - (memoize ftp-open)) - -(define (check-package-freshness package) - "Check whether PACKAGE has a newer version available upstream, and report -it." - ;; TODO: Automatically inject the upstream version when desired. - - (catch #t - (lambda () - (when (false-if-exception (gnu-package? package)) - (let ((name (package-name package)) - (full-name (package-full-name package))) - ;; XXX: This could work with non-GNU packages as well. However, - ;; GNU's FTP-based updater would be too slow if it weren't memoized, - ;; and the generic interface in (guix upstream) doesn't support - ;; that. - (match (waiting (latest-release name - #:ftp-open ftp-open* - #:ftp-close (const #f)) - (_ "looking for the latest release of GNU ~a...") name) - ((? upstream-source? source) - (let ((latest-version - (string-append (upstream-source-package source) "-" - (upstream-source-version source)))) - (when (version>? latest-version full-name) - (format (current-error-port) - (_ "~a: note: using ~a \ -but ~a is available upstream~%") - (location->string (package-location package)) - full-name latest-version)))) - (_ #t))))) - (lambda (key . args) - ;; Silently ignore networking errors rather than preventing - ;; installation. - (case key - ((getaddrinfo-error ftp-error) #f) - (else (apply throw key args)))))) - (define (specification->package spec) "Return a package matching SPEC. SPEC may be a package name, or a package name followed by a hyphen and a version number. If the version number is not diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index b93ffb0b6b..f65834386b 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2013, 2015 Mark H Weaver -;;; Copyright © 2014 Alex Kost +;;; Copyright © 2014, 2016 Alex Kost ;;; ;;; This file is part of GNU Guix. ;;; @@ -551,10 +551,6 @@ upgrading, #f otherwise." (define (options->installable opts manifest) "Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold', return the new list of manifest entries." - (define (package->manifest-entry* package output) - (check-package-freshness package) - (package->manifest-entry package output)) - (define upgrade? (options->upgrade-predicate opts)) @@ -567,7 +563,7 @@ return the new list of manifest entries." (call-with-values (lambda () (specification->package+output name output)) - package->manifest-entry*)))) + package->manifest-entry)))) (_ #f)) (manifest-entries manifest))) @@ -576,13 +572,13 @@ return the new list of manifest entries." (('install . (? package? p)) ;; When given a package via `-e', install the first of its ;; outputs (XXX). - (package->manifest-entry* p "out")) + (package->manifest-entry p "out")) (('install . (? string? spec)) (if (store-path? spec) (store-item->manifest-entry spec) (let-values (((package output) (specification->package+output spec))) - (package->manifest-entry* package output)))) + (package->manifest-entry package output)))) (_ #f)) opts)) -- cgit v1.2.3 From 62061d6be3614dd84a1d0034dd5946f7e54fbaea Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 18 Feb 2016 20:50:02 +0100 Subject: gnu-maintenance: Add X.org updater. * guix/gnu-maintenance.scm (xorg-package?, latest-xorg-release): New private functions. (%xorg-updater): New public variable. * guix/scripts/refresh.scm (%updaters): Add %xorg-updater. * doc/guix.texi (Invoking guix refresh): Mention the new updater. --- doc/guix.texi | 2 ++ guix/gnu-maintenance.scm | 37 ++++++++++++++++++++++++++++++++++++- guix/scripts/refresh.scm | 3 ++- 3 files changed, 40 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index ec05461faa..15b36f9039 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4616,6 +4616,8 @@ list of updaters). Currently, @var{updater} may be one of: the updater for GNU packages; @item gnome the updater for GNOME packages; +@item xorg +the updater for X.org packages; @item elpa the updater for @uref{http://elpa.gnu.org/, ELPA} packages; @item cran diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 96fbfb76b4..9d720ca030 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -33,6 +33,7 @@ #:use-module (guix records) #:use-module (guix upstream) #:use-module (guix packages) + #:use-module (gnu packages) #:export (gnu-package-name gnu-package-mundane-name gnu-package-copyright-holder @@ -57,7 +58,8 @@ gnu-package-name->name+version %gnu-updater - %gnome-updater)) + %gnome-updater + %xorg-updater)) ;;; Commentary: ;;; @@ -508,6 +510,32 @@ elpa.gnu.org, and all the GNOME packages." ;; checksums. #:file->signature (const #f)))) +(define (xorg-package? package) + "Return true if PACKAGE is an X.org package, developed by X.org." + (define xorg-uri? + (match-lambda + ((? string? uri) + (string-prefix? "mirror://xorg/" uri)) + (_ + #f))) + + (match (package-source package) + ((? origin? origin) + (match (origin-uri origin) + ((? xorg-uri?) #t) + (_ #f))) + (_ #f))) + +(define (latest-xorg-release package) + "Return the latest release of PACKAGE, the name of an X.org package." + (let ((uri (string->uri (origin-uri (package-source (specification->package package)))))) + (false-if-ftp-error + (latest-ftp-release + package + #:server "ftp.freedesktop.org" + #:directory + (string-append "/pub/xorg/" (dirname (uri-path uri))))))) + (define %gnu-updater (upstream-updater (name 'gnu) @@ -522,4 +550,11 @@ elpa.gnu.org, and all the GNOME packages." (pred gnome-package?) (latest latest-gnome-release))) +(define %xorg-updater + (upstream-updater + (name 'xorg) + (description "Updater for X.org packages") + (pred xorg-package?) + (latest latest-xorg-release))) + ;;; gnu-maintenance.scm ends here diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 9ddde2dbad..bbc3521f11 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -32,7 +32,7 @@ #:use-module (guix scripts graph) #:use-module (guix monads) #:use-module ((guix gnu-maintenance) - #:select (%gnu-updater %gnome-updater)) + #:select (%gnu-updater %gnome-updater %xorg-updater)) #:use-module (guix import elpa) #:use-module (guix import cran) #:use-module (guix gnupg) @@ -194,6 +194,7 @@ unavailable optional dependencies such as Guile-JSON." ;; List of "updaters" used by default. They are consulted in this order. (list-updaters %gnu-updater %gnome-updater + %xorg-updater %elpa-updater %cran-updater %bioconductor-updater -- cgit v1.2.3 From 0043558082d619d0dc51ef27acda8ebb299c2f2c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 25 Feb 2016 11:48:17 +0100 Subject: publish: Do not publish nars for invalid store items. Before that, /nar requests could succeed if the requested store item exists but is invalid (although such requests were unlikely because the corresponding narinfo request would have failed.) * guix/scripts/publish.scm (render-nar): Add 'store' parameter. Use 'valid-path?' instead of 'file-exists?'. (make-request-handler): Adjust 'render-nar' call accordingly. * tests/publish.scm ("/nar/invalid"): New test. --- guix/scripts/publish.scm | 6 +++--- tests/publish.scm | 8 ++++++++ 2 files changed, 11 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index 3d197384d6..5306afcf07 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -208,13 +208,13 @@ References: ~a~%" (narinfo-string store store-path (force %private-key)) <>))))) -(define (render-nar request store-item) +(define (render-nar store request store-item) "Render archive of the store path corresponding to STORE-ITEM." (let ((store-path (string-append %store-directory "/" store-item))) ;; The ISO-8859-1 charset *must* be used otherwise HTTP clients will ;; interpret the byte stream as UTF-8 and arbitrarily change invalid byte ;; sequences. - (if (file-exists? store-path) + (if (valid-path? store store-path) (values '((content-type . (application/x-nix-archive (charset . "ISO-8859-1")))) ;; XXX: We're not returning the actual contents, deferring @@ -314,7 +314,7 @@ blocking." (render-narinfo store request hash)) ;; /nar/ (("nar" store-item) - (render-nar request store-item)) + (render-nar store request store-item)) (_ (not-found request))) (not-found request)))) diff --git a/tests/publish.scm b/tests/publish.scm index 0b92390900..6c710fe0a7 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -112,6 +112,14 @@ References: ~a~%" (call-with-input-string nar (cut restore-file <> temp))) (call-with-input-file temp read-string)))) +(test-equal "/nar/invalid" + 404 + (begin + (call-with-output-file (string-append (%store-prefix) "/invalid") + (lambda (port) + (display "This file is not a valid store item." port))) + (response-code (http-get (publish-uri (string-append "/nar/invalid")))))) + (test-end "publish") -- cgit v1.2.3 From 06b76accebd5c98ae50dc7ec4c3f4dad764a637e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 25 Feb 2016 12:12:50 +0100 Subject: store: Clarify documentation of 'valid-path?'. * guix/store.scm (valid-path?): Improve docstring. * doc/guix.texi (The Store): Update accordingly. --- doc/guix.texi | 9 ++++++++- guix/store.scm | 7 ++++++- 2 files changed, 14 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index b48f988a0d..2bebeeddf7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2913,7 +2913,14 @@ Procedures that make RPCs all take a server object as their first argument. @deffn {Scheme Procedure} valid-path? @var{server} @var{path} -Return @code{#t} when @var{path} is a valid store path. +@cindex invalid store items +Return @code{#t} when @var{path} designates a valid store item and +@code{#f} otherwise (an invalid item may exist on disk but still be +invalid, for instance because it is the result of an aborted or failed +build.) + +A @code{&nix-protocol-error} condition is raised if @var{path} is not +prefixed by the store directory (@file{/gnu/store}). @end deffn @deffn {Scheme Procedure} add-text-to-store @var{server} @var{name} @var{text} [@var{references}] diff --git a/guix/store.scm b/guix/store.scm index 8123407816..3d6cff4c21 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -582,7 +582,12 @@ encoding conversion errors." (operation (name args ...) docstring return ...))) (define-operation (valid-path? (string path)) - "Return #t when PATH is a valid store path." + "Return #t when PATH designates a valid store item and #f otherwise (an +invalid item may exist on disk but still be invalid, for instance because it +is the result of an aborted or failed build.) + +A '&nix-protocol-error' condition is raised if PATH is not prefixed by the +store directory (/gnu/store)." boolean) (define-operation (query-path-hash (store-path path)) -- cgit v1.2.3 From cfd503205e6b72895eaca73ffd76762d09218d36 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 25 Feb 2016 12:42:01 +0100 Subject: guix system: Restore load path after running the activation script. Fixes . Reported by Mark H Weaver . * guix/scripts/system.scm (save-load-path-excursion): New variable. (upgrade-shepherd-services): Add comment about the issue. (switch-to-system): Use 'save-load-path-excursion' around 'primitive-load' call. --- guix/scripts/system.scm | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 7279be0c43..401aa8b60a 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -211,6 +211,19 @@ the ownership of '~a' may be incorrect!~%") (lambda () (environ env))))) +(define-syntax-rule (save-load-path-excursion body ...) + "Save the current values of '%load-path' and '%load-compiled-path', run +BODY..., and restore them." + (let ((path %load-path) + (cpath %load-compiled-path)) + (dynamic-wind + (const #t) + (lambda () + body ...) + (lambda () + (set! %load-path path) + (set! %load-compiled-path cpath))))) + (define-syntax-rule (warn-on-system-error body ...) (catch 'system-error (lambda () @@ -273,6 +286,9 @@ bring the system down." (info (_ "loading new services:~{ ~a~}...~%") to-load-names) (mlet %store-monad ((files (mapm %store-monad shepherd-service-file to-load))) + ;; Here we assume that FILES are exactly those that were computed + ;; as part of the derivation that built OS, which is normally the + ;; case. (load-services (map derivation->output-path files)) (for-each start-service @@ -299,7 +315,12 @@ it atomically, and then run OS's activation script." ;; Tell 'activate-current-system' what the new system is. (setenv "GUIX_NEW_SYSTEM" system) - (primitive-load (derivation->output-path script))) + ;; The activation script may modify '%load-path' & co., so protect + ;; against that. This is necessary to ensure that + ;; 'upgrade-shepherd-services' gets to see the right modules when it + ;; computes derivations with (gexp->derivation #:modules …). + (save-load-path-excursion + (primitive-load (derivation->output-path script)))) ;; Finally, try to update system services. (upgrade-shepherd-services os)))) -- cgit v1.2.3 From e72f50a7873b3233a8f962a7374e1219d0426230 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 25 Feb 2016 16:49:11 +0100 Subject: http-client: 'http-fetch/cached' updates the cache atomically. * guix/http-client.scm (http-fetch/cached)[update-cache]: Use 'with-atomic-file-output' instead of 'call-with-output-file'. --- guix/http-client.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/http-client.scm b/guix/http-client.scm index 31b511eb1c..b26795c64d 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -291,7 +291,7 @@ Raise an '&http-get-error' condition if downloading fails." ;; Update the cache and return an input port. (let ((port (http-fetch uri #:text? text?))) (mkdir-p directory) - (call-with-output-file file + (with-atomic-file-output file (cut dump-port port <>)) (close-port port) (open-input-file file))) -- cgit v1.2.3 From a4e7083da32395dd434970725df0bc15601d202a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 25 Feb 2016 17:23:29 +0100 Subject: http-client: 'http-client/cached' uses unique cache file names. * guix/http-client.scm (cache-file-for-uri): New procedure. (http-fetch/cached): Use it. Remove 'directory' variable. [update-cache]: Make the 'dirname' of FILE. --- guix/http-client.scm | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/guix/http-client.scm b/guix/http-client.scm index b26795c64d..2161856c63 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -33,6 +33,7 @@ #:use-module (guix ui) #:use-module (guix utils) #:use-module (guix base64) + #:autoload (guix hash) (sha256) #:use-module ((guix build utils) #:select (mkdir-p dump-port)) #:use-module ((guix build download) @@ -280,17 +281,22 @@ Raise an '&http-get-error' condition if downloading fails." string->number*) 36)))) +(define (cache-file-for-uri uri) + "Return the name of the file in the cache corresponding to URI." + (let ((digest (sha256 (string->utf8 (uri->string uri))))) + ;; Use the "URL" alphabet because it does not contain "/". + (string-append (cache-directory) "/http/" + (base64-encode digest 0 (bytevector-length digest) + #f #f base64url-alphabet)))) + (define* (http-fetch/cached uri #:key (ttl (%http-cache-ttl)) text?) "Like 'http-fetch', return an input port, but cache its contents in ~/.cache/guix. The cache remains valid for TTL seconds." - (let* ((directory (string-append (cache-directory) "/http/" - (uri-host uri))) - (file (string-append directory "/" - (basename (uri-path uri))))) + (let ((file (cache-file-for-uri uri))) (define (update-cache) ;; Update the cache and return an input port. (let ((port (http-fetch uri #:text? text?))) - (mkdir-p directory) + (mkdir-p (dirname file)) (with-atomic-file-output file (cut dump-port port <>)) (close-port port) -- cgit v1.2.3 From acb01e37466a1d3fff81f10e00fe15a4ef20e2db Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 26 Feb 2016 12:42:15 +0100 Subject: grafts: Add record type printer. * guix/grafts.scm (write-graft): New procedure. Register it as a printer for . --- guix/grafts.scm | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) (limited to 'guix') diff --git a/guix/grafts.scm b/guix/grafts.scm index 5074809c43..a1f7d8801a 100644 --- a/guix/grafts.scm +++ b/guix/grafts.scm @@ -21,6 +21,7 @@ #:use-module (guix derivations) #:use-module ((guix utils) #:select (%current-system)) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:export (graft? @@ -44,6 +45,22 @@ (replacement-output graft-replacement-output ;string | #f (default "out"))) +(define (write-graft graft port) + "Write a concise representation of GRAFT to PORT." + (define (->string thing output) + (if (derivation? thing) + (derivation->output-path thing output) + thing)) + + (match graft + (($ origin origin-output replacement replacement-output) + (format port "# ~a ~a>" + (->string origin origin-output) + (->string replacement replacement-output) + (number->string (object-address graft) 16))))) + +(set-record-type-printer! write-graft) + (define* (graft-derivation store drv grafts #:key (name (derivation-name drv)) -- cgit v1.2.3 From 22572d56cb3da5b176b5b5697d4e8e71067eab74 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 26 Feb 2016 23:14:28 +0100 Subject: store: 'path-info-deriver' is #f when there is no deriver. * guix/store.scm (read-path-info): Use #f when we get the empty string for DERIVER. * guix/scripts/publish.scm (narinfo-string): Adjust accordingly. * tests/store.scm ("path-info-deriver"): New test. --- guix/scripts/publish.scm | 2 +- guix/store.scm | 6 ++++-- tests/store.scm | 15 +++++++++++++++ 3 files changed, 20 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index 5306afcf07..46292131d7 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -164,7 +164,7 @@ References: ~a~%" store-path url hash size references)) ;; Do not render a "Deriver" or "System" line if we are rendering ;; info for a derivation. - (info (if (string-null? deriver) + (info (if (not deriver) base-info (catch 'system-error (lambda () diff --git a/guix/store.scm b/guix/store.scm index 3d6cff4c21..8746d3c2d6 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -242,14 +242,16 @@ (define-record-type (path-info deriver hash references registration-time nar-size) path-info? - (deriver path-info-deriver) + (deriver path-info-deriver) ;string | #f (hash path-info-hash) (references path-info-references) (registration-time path-info-registration-time) (nar-size path-info-nar-size)) (define (read-path-info p) - (let ((deriver (read-store-path p)) + (let ((deriver (match (read-store-path p) + ("" #f) + (x x))) (hash (base16-string->bytevector (read-string p))) (refs (read-store-path-list p)) (registration-time (read-int p)) diff --git a/tests/store.scm b/tests/store.scm index 9d651ce5a9..de070eab23 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -856,6 +856,21 @@ (string->utf8 (call-with-output-string (cut write-file item <>)))))))) +(test-assert "path-info-deriver" + (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '())) + (s (add-to-store %store "bash" #t "sha256" + (search-bootstrap-binary "bash" + (%current-system)))) + (d (derivation %store "the-thing" + s `("-e" ,b) + #:env-vars `(("foo" . ,(random-text))) + #:inputs `((,b) (,s)))) + (o (derivation->output-path d))) + (and (build-derivations %store (list d)) + (not (path-info-deriver (query-path-info %store b))) + (string=? (derivation-file-name d) + (path-info-deriver (query-path-info %store o)))))) + (test-end "store") -- cgit v1.2.3 From 917a2a58ec3db94983198c447061a41048cfc6a1 Mon Sep 17 00:00:00 2001 From: Ben Woodcroft Date: Sun, 15 Nov 2015 10:18:05 +1000 Subject: import: Add github-updater. * guix/import/github.scm: New file. * guix/scripts/refresh.scm (%updaters): Add %GITHUB-UPDATER. * doc/guix.texi (Invoking guix refresh): Mention it. * Makefile.am (MODULES): Add gnu/import/github.scm. --- Makefile.am | 1 + doc/guix.texi | 15 ++++ guix/import/github.scm | 198 +++++++++++++++++++++++++++++++++++++++++++++++ guix/scripts/refresh.scm | 3 +- 4 files changed, 216 insertions(+), 1 deletion(-) create mode 100644 guix/import/github.scm (limited to 'guix') diff --git a/Makefile.am b/Makefile.am index 01d7fbecb7..4c53779aaa 100644 --- a/Makefile.am +++ b/Makefile.am @@ -109,6 +109,7 @@ MODULES = \ guix/import/cran.scm \ guix/import/hackage.scm \ guix/import/elpa.scm \ + guix/import/github.scm \ guix/scripts.scm \ guix/scripts/download.scm \ guix/scripts/build.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index c111b0ffbf..4c9a91b399 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -17,6 +17,7 @@ Copyright @copyright{} 2015 Mathieu Lirzin@* Copyright @copyright{} 2014 Pierre-Antoine Rault@* Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@* Copyright @copyright{} 2015, 2016 Leo Famulari +Copyright @copyright{} 2016 Ben Woodcroft Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -4660,6 +4661,8 @@ the updater for @uref{http://www.bioconductor.org/, Bioconductor} R packages; the updater for @uref{https://pypi.python.org, PyPI} packages. @item gem the updater for @uref{https://rubygems.org, RubyGems} packages. +@item github +the updater for @uref{https://github.com, GitHub} packages. @end table For instance, the following command only checks for updates of Emacs @@ -4746,6 +4749,18 @@ Use @var{host} as the OpenPGP key server when importing a public key. @end table +The @code{github} updater uses the +@uref{https://developer.github.com/v3/, GitHub API} to query for new +releases. When used repeatedly e.g. when refreshing all packages, +GitHub will eventually refuse to answer any further API requests. By +default 60 API requests per hour are allowed, and a full refresh on all +GitHub packages in Guix requires more than this. Authentication with +GitHub through the use of an API token alleviates these limits. To use +an API token, set the environment variable @code{GUIX_GITHUB_TOKEN} to a +token procured from @uref{https://github.com/settings/tokens} or +otherwise. + + @node Invoking guix lint @section Invoking @command{guix lint} The @command{guix lint} command is meant to help package developers avoid diff --git a/guix/import/github.scm b/guix/import/github.scm new file mode 100644 index 0000000000..c696dcb363 --- /dev/null +++ b/guix/import/github.scm @@ -0,0 +1,198 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Ben Woodcroft +;;; +;;; 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 import github) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (json) + #:use-module (guix utils) + #:use-module ((guix download) #:prefix download:) + #:use-module (guix import utils) + #:use-module (guix packages) + #:use-module (guix upstream) + #:use-module (gnu packages) + #:use-module (web uri) + #:export (%github-updater)) + +(define (json-fetch* url) + "Return a list/hash representation of the JSON resource URL, or #f on +failure." + (call-with-output-file "/dev/null" + (lambda (null) + (with-error-to-port null + (lambda () + (call-with-temporary-output-file + (lambda (temp port) + (and (url-fetch url temp) + (call-with-input-file temp json->scm))))))))) + +(define (find-extension url) + "Return the extension of the archive e.g. '.tar.gz' given a URL, or +false if none is recognized" + (find (lambda x (string-suffix? (first x) url)) + (list ".tar.gz" ".tar.bz2" ".tar.xz" ".zip" ".tar"))) + +(define (updated-github-url old-package new-version) + ;; Return a url for the OLD-PACKAGE with NEW-VERSION. If no source url in + ;; the OLD-PACKAGE is a GitHub url, then return false. + + (define (updated-url url) + (if (string-prefix? "https://github.com/" url) + (let ((ext (find-extension url)) + (name (package-name old-package)) + (version (package-version old-package)) + (prefix (string-append "https://github.com/" + (github-user-slash-repository url))) + (repo (github-repository url))) + (cond + ((string-suffix? (string-append "/tarball/v" version) url) + (string-append prefix "/tarball/v" new-version)) + ((string-suffix? (string-append "/tarball/" version) url) + (string-append prefix "/tarball/" new-version)) + ((string-suffix? (string-append "/archive/v" version ext) url) + (string-append prefix "/archive/v" new-version ext)) + ((string-suffix? (string-append "/archive/" version ext) url) + (string-append prefix "/archive/" new-version ext)) + ((string-suffix? (string-append "/archive/" name "-" version ext) + url) + (string-append prefix "/archive/" name "-" new-version ext)) + ((string-suffix? (string-append "/releases/download/v" version "/" + name "-" version ext) + url) + (string-append prefix "/releases/download/v" new-version "/" name + "-" new-version ext)) + ((string-suffix? (string-append "/releases/download/" version "/" + name "-" version ext) + url) + (string-append prefix "/releases/download/" new-version "/" name + "-" new-version ext)) + ((string-suffix? (string-append "/releases/download/" version "/" + repo "-" version ext) + url) + (string-append prefix "/releases/download/" new-version "/" repo + "-" new-version ext)) + ((string-suffix? (string-append "/releases/download/" repo "-" + version "/" repo "-" version ext) + url) + (string-append "/releases/download/" repo "-" version "/" repo "-" + version ext)) + (#t #f))) ; Some URLs are not recognised. + #f)) + + (let ((source-url (and=> (package-source old-package) origin-uri)) + (fetch-method (and=> (package-source old-package) origin-method))) + (if (eq? fetch-method download:url-fetch) + (match source-url + ((? string?) + (updated-url source-url)) + ((source-url ...) + (find updated-url source-url))) + #f))) + +(define (github-package? package) + "Return true if PACKAGE is a package from GitHub, else false." + (not (eq? #f (updated-github-url package "dummy")))) + +(define (github-repository url) + "Return a string e.g. bedtools2 of the name of the repository, from a string +URL of the form 'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz'" + (match (string-split (uri-path (string->uri url)) #\/) + ((_ owner project . rest) + (string-append project)))) + +(define (github-user-slash-repository url) + "Return a string e.g. arq5x/bedtools2 of the owner and the name of the +repository separated by a forward slash, from a string URL of the form +'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz'" + (match (string-split (uri-path (string->uri url)) #\/) + ((_ owner project . rest) + (string-append owner "/" project)))) + +(define %github-token + ;; Token to be passed to Github.com to avoid the 60-request per hour + ;; limit, or #f. + (make-parameter (getenv "GUIX_GITHUB_TOKEN"))) + +(define (latest-released-version url package-name) + "Return a string of the newest released version name given a string URL like +'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz' and the name of +the package e.g. 'bedtools2'. Return #f if there is no releases" + (let* ((token (%github-token)) + (api-url (string-append + "https://api.github.com/repos/" + (github-user-slash-repository url) + "/releases")) + (json (json-fetch* + (if token + (string-append api-url "?access_token=" token) + api-url)))) + (if (eq? json #f) + (if token + (error "Error downloading release information through the GitHub +API when using a GitHub token") + (error "Error downloading release information through the GitHub +API. This may be fixed by using an access token and setting the environment +variable GUIX_GITHUB_TOKEN, for instance one procured from +https://github.com/settings/tokens")) + (let ((proper-releases + (filter + (lambda (x) + ;; example pre-release: + ;; https://github.com/wwood/OrfM/releases/tag/v0.5.1 + ;; or an all-prerelease set + ;; https://github.com/powertab/powertabeditor/releases + (not (hash-ref x "prerelease"))) + json))) + (match proper-releases + (() ;empty release list + #f) + ((release . rest) ;one or more releases + (let ((tag (hash-ref release "tag_name")) + (name-length (string-length package-name))) + ;; some tags include the name of the package e.g. "fdupes-1.51" + ;; so remove these + (if (and (< name-length (string-length tag)) + (string=? (string-append package-name "-") + (substring tag 0 (+ name-length 1)))) + (substring tag (+ name-length 1)) + ;; some tags start with a "v" e.g. "v0.25.0" + ;; where some are just the version number + (if (eq? (string-ref tag 0) #\v) + (substring tag 1) tag))))))))) + +(define (latest-release guix-package) + "Return an for the latest release of GUIX-PACKAGE." + (let* ((pkg (specification->package guix-package)) + (source-uri (origin-uri (package-source pkg))) + (name (package-name pkg)) + (newest-version (latest-released-version source-uri name))) + (if newest-version + (upstream-source + (package pkg) + (version newest-version) + (urls (list (updated-github-url pkg newest-version)))) + #f))) ; On GitHub but no proper releases + +(define %github-updater + (upstream-updater + (name 'github) + (description "Updater for GitHub packages") + (pred github-package?) + (latest latest-release))) + + diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index bbc3521f11..e541138682 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -199,7 +199,8 @@ unavailable optional dependencies such as Guile-JSON." %cran-updater %bioconductor-updater ((guix import pypi) => %pypi-updater) - ((guix import gem) => %gem-updater))) + ((guix import gem) => %gem-updater) + ((guix import github) => %github-updater))) (define (lookup-updater name) "Return the updater called NAME." -- cgit v1.2.3