Merge branch 'master' into core-updates

Conflicts:
	Makefile.am
	guix/scripts/gc.scm
	guix/scripts/package.scm
	guix/ui.scm
	tests/guix-package.sh

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