diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-03-04 23:27:24 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-03-04 23:27:24 +0100 |
commit | 81eec00cb221231123b74d14245ef7caa9d89ff6 (patch) | |
tree | 3beeb77c5535038dc75db843dd88a1775fb541bb /guix | |
parent | 8689a1908a8353b80ed1fcbb81feddc5eb799f24 (diff) | |
parent | 2a1e82bb5c2ae28b0018aa765cff6733136b3f70 (diff) | |
download | guix-patches-81eec00cb221231123b74d14245ef7caa9d89ff6.tar guix-patches-81eec00cb221231123b74d14245ef7caa9d89ff6.tar.gz |
Merge branch 'master' into core-updates
Conflicts:
Makefile.am
guix/scripts/gc.scm
guix/scripts/package.scm
guix/ui.scm
tests/guix-package.sh
Diffstat (limited to 'guix')
-rw-r--r-- | guix/build-system/gnu.scm | 2 | ||||
-rw-r--r-- | guix/build-system/perl.scm | 103 | ||||
-rw-r--r-- | guix/build/perl-build-system.scm | 61 | ||||
-rw-r--r-- | guix/download.scm | 47 | ||||
-rw-r--r-- | guix/scripts/build.scm | 33 | ||||
-rw-r--r-- | guix/scripts/gc.scm | 56 | ||||
-rw-r--r-- | guix/scripts/package.scm | 24 | ||||
-rw-r--r-- | guix/store.scm | 28 | ||||
-rw-r--r-- | guix/ui.scm | 21 |
9 files changed, 346 insertions, 29 deletions
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index 5be4782c2f..8049e7510f 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -21,13 +21,13 @@ #:use-module (guix utils) #:use-module (guix derivations) #:use-module (guix build-system) - #:use-module (guix build-system gnu) #:use-module (guix packages) #:use-module (srfi srfi-1) #:use-module (srfi srfi-39) #:use-module (ice-9 match) #:export (gnu-build gnu-build-system + standard-inputs package-with-explicit-inputs package-with-extra-configure-variable static-libgcc-package diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm new file mode 100644 index 0000000000..537c29e799 --- /dev/null +++ b/guix/build-system/perl.scm @@ -0,0 +1,103 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +;;; +;;; 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 <http://www.gnu.org/licenses/>. + +(define-module (guix build-system perl) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix derivations) + #:use-module (guix build-system) + #:use-module (guix build-system gnu) + #:use-module (guix packages) + #:use-module (ice-9 match) + #:export (perl-build + perl-build-system)) + +;; Commentary: +;; +;; Standard build procedure for Perl packages using the "makefile +;; maker"---i.e., "perl Makefile.PL". This is implemented as an extension of +;; `gnu-build-system'. +;; +;; Code: + +(define* (perl-build store name source inputs + #:key + (perl (@ (gnu packages perl) perl)) + (tests? #t) + (make-maker-flags ''()) + (phases '(@ (guix build perl-build-system) + %standard-phases)) + (outputs '("out")) + (system (%current-system)) + (guile #f) + (imported-modules '((guix build perl-build-system) + (guix build gnu-build-system) + (guix build utils))) + (modules '((guix build perl-build-system) + (guix build gnu-build-system) + (guix build utils)))) + "Build SOURCE using PERL, and with INPUTS. This assumes that SOURCE +provides a `Makefile.PL' file as its build system." + (define builder + `(begin + (use-modules ,@modules) + (perl-build #:name ,name + #:source ,(if (and source (derivation-path? source)) + (derivation-path->output-path source) + source) + #:make-maker-flags ,make-maker-flags + #:system ,system + #:test-target "test" + #:tests? ,tests? + #:outputs %outputs + #:inputs %build-inputs))) + + (define guile-for-build + (match guile + ((? package?) + (package-derivation store guile system)) + ((and (? string?) (? derivation-path?)) + guile) + (#f ; the default + (let* ((distro (resolve-interface '(gnu packages base))) + (guile (module-ref distro 'guile-final))) + (package-derivation store guile system))))) + + (let ((perl (package-derivation store perl system))) + (build-expression->derivation store name system + builder + `(,@(if source + `(("source" ,source)) + '()) + ("perl" ,perl) + ,@inputs + + ;; Keep the standard inputs of + ;; `gnu-build-system'. + ,@(standard-inputs system)) + + #:modules imported-modules + #:outputs outputs + #:guile-for-build guile-for-build))) + +(define perl-build-system + (build-system (name 'perl) + (description "The standard Perl build system") + (build perl-build))) + +;;; perl.scm ends here diff --git a/guix/build/perl-build-system.scm b/guix/build/perl-build-system.scm new file mode 100644 index 0000000000..d625ef3ed6 --- /dev/null +++ b/guix/build/perl-build-system.scm @@ -0,0 +1,61 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +;;; +;;; 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 <http://www.gnu.org/licenses/>. + +(define-module (guix build perl-build-system) + #:use-module ((guix build gnu-build-system) + #:renamer (symbol-prefix-proc 'gnu:)) + #:use-module (guix build utils) + #:use-module (ice-9 match) + #:export (%standard-phases + perl-build)) + +;; Commentary: +;; +;; Builder-side code of the standard Perl package build procedure. +;; +;; Code: + +(define* (configure #:key outputs (make-maker-flags '()) + #:allow-other-keys) + "Configure the given Perl package." + (let ((out (assoc-ref outputs "out"))) + (if (file-exists? "Makefile.PL") + (let ((args `("Makefile.PL" ,(string-append "PREFIX=" out) + "INSTALLDIRS=site" ,@make-maker-flags))) + (format #t "running `perl' with arguments ~s~%" args) + (zero? (apply system* "perl" args))) + (error "no Makefile.PL found")))) + +(define %standard-phases + ;; Everything is as with the GNU Build System except for the `configure' + ;; phase. + (alist-replace 'configure configure + gnu:%standard-phases)) + +(define* (perl-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given Perl package, applying all of PHASES in order." + (set-path-environment-variable "PERL5LIB" '("lib/perl5/site_perl") + (match inputs + (((_ . path) ...) + path))) + (apply gnu:gnu-build + #:inputs inputs #:phases phases + args)) + +;;; perl-build-system.scm ends here diff --git a/guix/download.scm b/guix/download.scm index 846c9e1e0b..b6bf6a0822 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -98,7 +99,51 @@ "ftp://gd.tuwien.ac.at/pub/infosys/servers/http/apache/dist/" "http://apache.belnet.be/" "http://mirrors.ircam.fr/pub/apache/" - "http://apache-mirror.rbc.ru/pub/apache/")))) + "http://apache-mirror.rbc.ru/pub/apache/") + (xorg ; from http://www.x.org/wiki/Releases/Download + "http://xorg.freedesktop.org/releases/" ; main mirrors + "http://www.x.org/pub/" + "ftp://mirror.csclub.uwaterloo.ca/x.org/" ; North America + "ftp://xorg.mirrors.pair.com/" + "http://mirror.csclub.uwaterloo.ca/x.org/" + "http://xorg.mirrors.pair.com/" + "http://mirror.us.leaseweb.net/xorg/" + "ftp://artfiles.org/x.org/" ; Europe + "ftp://ftp.chg.ru/pub/X11/x.org/" + "ftp://ftp.fu-berlin.de/unix/X11/FTP.X.ORG/" + "ftp://ftp.gwdg.de/pub/x11/x.org/" + "ftp://ftp.mirrorservice.org/sites/ftp.x.org/" + "ftp://ftp.ntua.gr/pub/X11/" + "ftp://ftp.piotrkosoft.net/pub/mirrors/ftp.x.org/" + "ftp://ftp.portal-to-web.de/pub/mirrors/x.org/" + "ftp://ftp.solnet.ch/mirror/x.org/" + "ftp://ftp.sunet.se/pub/X11/" + "ftp://gd.tuwien.ac.at/X11/" + "ftp://mi.mirror.garr.it/mirrors/x.org/" + "ftp://mirror.cict.fr/x.org/" + "ftp://mirror.switch.ch/mirror/X11/" + "ftp://mirrors.ircam.fr/pub/x.org/" + "ftp://x.mirrors.skynet.be/pub/ftp.x.org/" + "ftp://ftp.cs.cuhk.edu.hk/pub/X11" ; East Asia + "ftp://ftp.u-aizu.ac.jp/pub/x11/x.org/" + "ftp://ftp.yz.yamagata-u.ac.jp/pub/X11/x.org/" + "ftp://ftp.kaist.ac.kr/x.org/" + "ftp://mirrors.go-part.com/xorg/" + "http://x.cs.pu.edu.tw/" + "ftp://ftp.is.co.za/pub/x.org") ; South Africa + (cpan ; from http://www.cpan.org/SITES.html + "http://cpan.enstimac.fr/" + "ftp://ftp.ciril.fr/pub/cpan/" + "ftp://artfiles.org/cpan.org/" + "http://www.cpan.org/" + "ftp://cpan.rinet.ru/pub/mirror/CPAN/" + "http://cpan.cu.be/" + "ftp://cpan.inode.at/" + "ftp://cpan.iht.co.il/" + "ftp://ftp.osuosl.org/pub/CPAN/" + "ftp://ftp.nara.wide.ad.jp/pub/CPAN/" + "http://mirrors.163.com/cpan/" + "ftp://cpan.mirror.ac.za/")))) (define (gnutls-derivation store system) "Return the GnuTLS derivation for SYSTEM." diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index fbd22a9e29..a49bfdbeb8 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -38,21 +38,18 @@ (define %store (make-parameter #f)) -(define (derivations-from-package-expressions exp system source?) - "Eval EXP and return the corresponding derivation path for SYSTEM. +(define (derivations-from-package-expressions str system source?) + "Read/eval STR and return the corresponding derivation path for SYSTEM. When SOURCE? is true, return the derivations of the package sources." - (let ((p (eval exp (current-module)))) - (if (package? p) - (if source? - (let ((source (package-source p)) - (loc (package-location p))) - (if source - (package-source-derivation (%store) source) - (leave (_ "~a: error: package `~a' has no source~%") - (location->string loc) (package-name p)))) - (package-derivation (%store) p system)) - (leave (_ "expression `~s' does not evaluate to a package~%") - exp)))) + (let ((p (read/eval-package-expression str))) + (if source? + (let ((source (package-source p)) + (loc (package-location p))) + (if source + (package-source-derivation (%store) source) + (leave (_ "~a: error: package `~a' has no source~%") + (location->string loc) (package-name p)))) + (package-derivation (%store) p system)))) ;;; @@ -119,9 +116,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) (alist-cons 'derivations-only? #t result))) (option '(#\e "expression") #t #f (lambda (opt name arg result) - (alist-cons 'expression - (call-with-input-string arg read) - result))) + (alist-cons 'expression arg result))) (option '(#\K "keep-failed") #f #f (lambda (opt name arg result) (alist-cons 'keep-failed? #t result))) @@ -227,8 +222,8 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) (let* ((src? (assoc-ref opts 'source?)) (sys (assoc-ref opts 'system)) (drv (filter-map (match-lambda - (('expression . exp) - (derivations-from-package-expressions exp sys + (('expression . str) + (derivations-from-package-expressions str sys src?)) (('argument . (? derivation-path? drv)) drv) diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index f2d2e17d4b..12d80fd171 100644 --- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -20,6 +20,7 @@ #:use-module (guix ui) #:use-module (guix store) #:use-module (ice-9 match) + #:use-module (ice-9 regex) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) @@ -48,6 +49,11 @@ Invoke the garbage collector.\n")) --list-live list live paths")) (newline) (display (_ " + --references list the references of PATHS")) + (display (_ " + --referrers list the referrers of PATHS")) + (newline) + (display (_ " -h, --help display this help and exit")) (display (_ " -V, --version display version information and exit")) @@ -125,6 +131,14 @@ interpreted." (option '("list-live") #f #f (lambda (opt name arg result) (alist-cons 'action 'list-live + (alist-delete 'action result)))) + (option '("references") #f #f + (lambda (opt name arg result) + (alist-cons 'action 'list-references + (alist-delete 'action result)))) + (option '("referrers") #f #f + (lambda (opt name arg result) + (alist-cons 'action 'list-referrers (alist-delete 'action result)))))) @@ -142,9 +156,37 @@ interpreted." (alist-cons 'argument arg result)) %default-options)) + (define (symlink-target file) + (let ((s (false-if-exception (lstat file)))) + (if (and s (eq? 'symlink (stat:type s))) + (symlink-target (readlink file)) + file))) + + (define (store-directory file) + ;; Return the store directory that holds FILE if it's in the store, + ;; otherwise return FILE. + (or (and=> (string-match (string-append "^" (regexp-quote (%store-prefix)) + "/([^/]+)") + file) + (compose (cut string-append (%store-prefix) "/" <>) + (cut match:substring <> 1))) + file)) + (with-error-handling - (let ((opts (parse-options)) - (store (open-connection))) + (let* ((opts (parse-options)) + (store (open-connection)) + (paths (filter-map (match-lambda + (('argument . arg) arg) + (_ #f)) + opts))) + (define (list-relatives relatives) + (for-each (compose (lambda (path) + (for-each (cut simple-format #t "~a~%" <>) + (relatives store path))) + store-directory + symlink-target) + paths)) + (case (assoc-ref opts 'action) ((collect-garbage) (let ((min-freed (assoc-ref opts 'min-freed))) @@ -152,11 +194,11 @@ interpreted." (collect-garbage store min-freed) (collect-garbage store)))) ((delete) - (let ((paths (filter-map (match-lambda - (('argument . arg) arg) - (_ #f)) - opts))) - (delete-paths store paths))) + (delete-paths store paths)) + ((list-references) + (list-relatives references)) + ((list-referrers) + (list-relatives referrers)) ((list-dead) (for-each (cut simple-format #t "~a~%" <>) (dead-paths store))) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 1f9355ff22..ccca614d88 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -281,6 +281,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (display (_ " -i, --install=PACKAGE install PACKAGE")) (display (_ " + -e, --install-from-expression=EXP + install the package EXP evaluates to")) + (display (_ " -r, --remove=PACKAGE remove PACKAGE")) (display (_ " -u, --upgrade=REGEXP upgrade all the installed packages matching REGEXP")) @@ -325,6 +328,10 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (option '(#\i "install") #t #f (lambda (opt name arg result) (alist-cons 'install arg result))) + (option '(#\e "install-from-expression") #t #f + (lambda (opt name arg result) + (alist-cons 'install (read/eval-package-expression arg) + result))) (option '(#\r "remove") #t #f (lambda (opt name arg result) (alist-cons 'remove arg result))) @@ -490,6 +497,19 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (delete-duplicates (map input->name+path deps) same?)) + (define (package->tuple p) + (let ((path (package-derivation (%store) p)) + (deps (package-transitive-propagated-inputs p))) + `(,(package-name p) + ,(package-version p) + + ;; When given a package via `-e', install the first of its + ;; outputs (XXX). + ,(car (package-outputs p)) + + ,path + ,(canonicalize-deps deps)))) + ;; First roll back if asked to. (if (and (assoc-ref opts 'roll-back?) (not dry-run?)) (begin @@ -515,6 +535,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (install (append upgrade (filter-map (match-lambda + (('install . (? package? p)) + #f) (('install . (? store-path?)) #f) (('install . package) @@ -530,6 +552,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) install)) (install* (append (filter-map (match-lambda + (('install . (? package? p)) + (package->tuple p)) (('install . (? store-path? path)) (let-values (((name version) (package-name->name+version diff --git a/guix/store.scm b/guix/store.scm index 3627d5be04..80b36daf93 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -66,6 +66,10 @@ substitutable-paths substitutable-path-info + references + referrers + valid-derivers + query-derivation-outputs live-paths dead-paths collect-garbage @@ -126,7 +130,8 @@ (query-path-from-hash-part 29) (query-substitutable-path-infos 30) (query-valid-paths 31) - (query-substitutable-paths 32)) + (query-substitutable-paths 32) + (query-valid-derivers 33)) (define-enumerate-type hash-algo ;; hash.hh @@ -597,6 +602,27 @@ name--it is the caller's responsibility to ensure that it is an absolute file name. Return #t on success." boolean) +(define references + (operation (query-references (store-path path)) + "Return the list of references of PATH." + store-path-list)) + +(define referrers + (operation (query-referrers (store-path path)) + "Return the list of path that refer to PATH." + store-path-list)) + +(define valid-derivers + (operation (query-valid-derivers (store-path path)) + "Return the list of valid \"derivers\" of PATH---i.e., all the +.drv present in the store that have PATH among their outputs." + store-path-list)) + +(define query-derivation-outputs ; avoid name clash with `derivation-outputs' + (operation (query-derivation-outputs (store-path path)) + "Return the list of outputs of PATH, a .drv file." + store-path-list)) + (define-operation (has-substitutes? (store-path path)) "Return #t if binary substitutes are available for PATH, and #f otherwise." boolean) diff --git a/guix/ui.scm b/guix/ui.scm index 7e0c61b4f8..03d881a428 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -38,6 +38,7 @@ show-what-to-build call-with-error-handling with-error-handling + read/eval-package-expression location->string call-with-temporary-output-file switch-symlinks @@ -116,6 +117,26 @@ General help using GNU software: <http://www.gnu.org/gethelp/>")) (nix-protocol-error-message c)))) (thunk))) +(define (read/eval-package-expression str) + "Read and evaluate STR and return the package it refers to, or exit an +error." + (let ((exp (catch #t + (lambda () + (call-with-input-string str read)) + (lambda args + (leave (_ "failed to read expression ~s: ~s~%") + str args))))) + (let ((p (catch #t + (lambda () + (eval exp the-scm-module)) + (lambda args + (leave (_ "failed to evaluate expression `~a': ~s~%") + exp args))))) + (if (package? p) + p + (leave (_ "expression `~s' does not evaluate to a package~%") + exp))))) + (define* (show-what-to-build store drv #:optional dry-run?) "Show what will or would (depending on DRY-RUN?) be built in realizing the derivations listed in DRV. Return #t if there's something to build, #f |