Merge branch 'master' into core-updates

18 files changed, 503 insertions, 166 deletions

diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm
index c488adb500..e0f86438a8 100644
--- a/guix/build-system/perl.scm
+++ b/guix/build-system/perl.scm
@@ -75,7 +75,9 @@
                      (tests? #t)
                      (parallel-build? #t)
                      (parallel-tests? #t)
+                     (make-maker? #f)
                      (make-maker-flags ''())
+                     (module-build-flags ''())
                      (phases '(@ (guix build perl-build-system)
                                  %standard-phases))
                      (outputs '("out"))
@@ -101,7 +103,9 @@ provides a `Makefile.PL' file as its build system."
                                 source))
                    #:search-paths ',(map search-path-specification->sexp
                                          search-paths)
+                   #:make-maker? ,make-maker?
                    #:make-maker-flags ,make-maker-flags
+                   #:module-build-flags ,module-build-flags
                    #:phases ,phases
                    #:system ,system
                    #:test-target "test"
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 5928ccd154..e8d61e0d92 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +30,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:export (open-connection-for-uri
+            resolve-uri-reference
             maybe-expand-mirrors
             url-fetch
             progress-proc
@@ -204,6 +206,86 @@ which is not available during bootstrap."
 (module-define! (resolve-module '(web client))
                 'shutdown (const #f))
 
+;; XXX: Work around <http://bugs.gnu.org/19840>, present in Guile
+;; up to 2.0.11.
+(unless (or (> (string->number (major-version)) 2)
+            (> (string->number (minor-version)) 0)
+            (> (string->number (micro-version)) 11))
+  (let ((var (module-variable (resolve-module '(web http))
+                              'declare-relative-uri-header!)))
+    ;; If 'declare-relative-uri-header!' doesn't exist, forget it.
+    (when (and var (variable-bound? var))
+      (let ((declare-relative-uri-header! (variable-ref var)))
+        (declare-relative-uri-header! "Location")))))
+
+(define (resolve-uri-reference ref base)
+  "Resolve the URI reference REF, interpreted relative to the BASE URI, into a
+target URI, according to the algorithm specified in RFC 3986 section 5.2.2.
+Return the resulting target URI."
+
+  (define (merge-paths base-path rel-path)
+    (let* ((base-components (string-split base-path #\/))
+           (base-directory-components (match base-components
+                                        ((components ... last) components)
+                                        (() '())))
+           (base-directory (string-join base-directory-components "/")))
+      (string-append base-directory "/" rel-path)))
+
+  (define (remove-dot-segments path)
+    (let loop ((in
+                ;; Drop leading "." and ".." components from a relative path.
+                ;; (absolute paths will start with a "" component)
+                (drop-while (match-lambda
+                              ((or "." "..") #t)
+                              (_ #f))
+                            (string-split path #\/)))
+               (out '()))
+      (match in
+        (("." . rest)
+         (loop rest out))
+        ((".." . rest)
+         (match out
+           ((or () (""))
+            (error "remove-dot-segments: too many '..' components" path))
+           (_
+            (loop rest (cdr out)))))
+        ((component . rest)
+         (loop rest (cons component out)))
+        (()
+         (string-join (reverse out) "/")))))
+
+  (cond ((or (uri-scheme ref)
+             (uri-host   ref))
+         (build-uri (or (uri-scheme ref)
+                        (uri-scheme base))
+                    #:userinfo (uri-userinfo ref)
+                    #:host     (uri-host     ref)
+                    #:port     (uri-port     ref)
+                    #:path     (remove-dot-segments (uri-path ref))
+                    #:query    (uri-query    ref)
+                    #:fragment (uri-fragment ref)))
+        ((string-null? (uri-path ref))
+         (build-uri (uri-scheme base)
+                    #:userinfo (uri-userinfo base)
+                    #:host     (uri-host     base)
+                    #:port     (uri-port     base)
+                    #:path     (remove-dot-segments (uri-path base))
+                    #:query    (or (uri-query ref)
+                                   (uri-query base))
+                    #:fragment (uri-fragment ref)))
+        (else
+         (build-uri (uri-scheme base)
+                    #:userinfo (uri-userinfo base)
+                    #:host     (uri-host     base)
+                    #:port     (uri-port     base)
+                    #:path     (remove-dot-segments
+                                (if (string-prefix? "/" (uri-path ref))
+                                    (uri-path ref)
+                                    (merge-paths (uri-path base)
+                                                 (uri-path ref))))
+                    #:query    (uri-query    ref)
+                    #:fragment (uri-fragment ref)))))
+
 (define (http-fetch uri file)
   "Fetch data from URI and write it to FILE.  Return FILE on success."
 
@@ -260,7 +342,7 @@ which is not available during bootstrap."
          file))
       ((301                                       ; moved permanently
         302)                                      ; found (redirection)
-       (let ((uri (response-location resp)))
+       (let ((uri (resolve-uri-reference (response-location resp) uri)))
          (format #t "following redirection to `~a'...~%"
                  (uri->string uri))
          (close connection)
diff --git a/guix/build/perl-build-system.scm b/guix/build/perl-build-system.scm
index 904daf7ac2..7eb944ccd1 100644
--- a/guix/build/perl-build-system.scm
+++ b/guix/build/perl-build-system.scm
@@ -29,22 +29,57 @@
 ;;
 ;; Code:
 
-(define* (configure #:key outputs (make-maker-flags '())
+(define* (configure #:key outputs make-maker?
+                    (make-maker-flags '()) (module-build-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"))))
+  (let* ((out (assoc-ref outputs "out"))
+         (args (cond
+                ;; Prefer to use Module::Build unless otherwise told
+                ((and (file-exists? "Build.PL")
+                      (not make-maker?))
+                 `("Build.PL" ,(string-append "--prefix=" out)
+                   "--installdirs=site" ,@module-build-flags))
+                ((file-exists? "Makefile.PL")
+                 `("Makefile.PL" ,(string-append "PREFIX=" out)
+                   "INSTALLDIRS=site" ,@make-maker-flags))
+                (else (error "no Build.PL or Makefile.PL found")))))
+    (format #t "running `perl' with arguments ~s~%" args)
+    (zero? (apply system* "perl" args))))
+
+(define-syntax-rule (define-w/gnu-fallback* (name args ...) body ...)
+  (define* (name args ... #:rest rest)
+    (if (access? "Build" X_OK)
+        (begin body ...)
+        (apply (assoc-ref gnu:%standard-phases 'name) rest))))
+
+(define-w/gnu-fallback* (build)
+  (zero? (system* "./Build")))
+
+(define-w/gnu-fallback* (check #:key target
+                               (tests? (not target)) (test-flags '())
+                               #:allow-other-keys)
+  (if tests?
+      (zero? (apply system* "./Build" "test" test-flags))
+      (begin
+        (format #t "test suite not run~%")
+        #t)))
+
+(define-w/gnu-fallback* (install)
+  (zero? (system* "./Build" "install")))
 
 (define %standard-phases
-  ;; Everything is as with the GNU Build System except for the `configure'
-  ;; phase.
-  (alist-replace 'configure configure
-                 gnu:%standard-phases))
+  ;; Everything is as with the GNU Build System except for the `configure',
+  ;; `build', `check', and `install' phases.
+  (alist-replace
+   'configure configure
+   (alist-replace
+    'build build
+    (alist-replace
+     'check check
+     (alist-replace
+      'install install
+      gnu:%standard-phases)))))
 
 (define* (perl-build #:key inputs (phases %standard-phases)
                      #:allow-other-keys #:rest args)
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 678550a39e..e5922365a0 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -96,11 +96,8 @@
 
             build-derivations
             built-derivations
-            imported-modules
-            compiled-modules
 
-            build-expression->derivation
-            imported-files)
+            build-expression->derivation)
 
   ;; Re-export it from here for backward compatibility.
   #:re-export (%guile-for-build))
@@ -942,7 +939,7 @@ recursively."
            (remove (cut string=? <> ".")
                    (string-tokenize (dirname file-name) not-slash))))))
 
-(define* (imported-files store files
+(define* (imported-files store files              ;deprecated
                          #:key (name "file-import")
                          (system (%current-system))
                          (guile (%guile-for-build)))
@@ -982,7 +979,7 @@ system, imported, and appears under FINAL-PATH in the resulting store path."
   ;; up looking for the same files over and over again.
   (memoize search-path))
 
-(define* (%imported-modules store modules
+(define* (%imported-modules store modules         ;deprecated
                             #:key (name "module-import")
                             (system (%current-system))
                             (guile (%guile-for-build))
@@ -1001,7 +998,7 @@ search path."
     (imported-files store files #:name name #:system system
                     #:guile guile)))
 
-(define* (%compiled-modules store modules
+(define* (%compiled-modules store modules         ;deprecated
                             #:key (name "module-import-compiled")
                             (system (%current-system))
                             (guile (%guile-for-build))
@@ -1124,7 +1121,7 @@ applied."
                                      #:outputs output-names
                                      #:local-build? #t)))))
 
-(define* (build-expression->derivation store name exp
+(define* (build-expression->derivation store name exp ;deprecated
                                        #:key
                                        (system (%current-system))
                                        (inputs '())
@@ -1290,9 +1287,3 @@ ALLOWED-REFERENCES, and LOCAL-BUILD?."
 
 (define built-derivations
   (store-lift build-derivations))
-
-(define imported-modules
-  (store-lift %imported-modules))
-
-(define compiled-modules
-  (store-lift %compiled-modules))
diff --git a/guix/download.scm b/guix/download.scm
index 9a1897525b..d87d02e2af 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -164,6 +164,16 @@
        "ftp://ftp.nara.wide.ad.jp/pub/CPAN/"
        "http://mirrors.163.com/cpan/"
        "ftp://cpan.mirror.ac.za/")
+      (cran
+       ;; Arbitrary mirrors from http://cran.r-project.org/mirrors.html
+       ;; This one automatically redirects to servers worldwide
+       "http://cran.rstudio.com/"
+       "http://cran.univ-lyon1.fr/"
+       "http://cran.r-mirror.de/"
+       "http://cran.ism.ac.jp/"
+       "http://cran.stat.auckland.ac.nz/"
+       "http://cran.mirror.ac.za/"
+       "http://cran.csie.ntu.edu.tw/")
       (imagemagick
        ;; from http://www.imagemagick.org/script/download.php
        ;; (without mirrors that are unavailable or not up to date)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index fa712a8b9b..a8349c7d6e 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -21,6 +21,7 @@
   #:use-module (guix monads)
   #:use-module (guix derivations)
   #:use-module (guix packages)
+  #:use-module (guix utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
@@ -31,7 +32,10 @@
             gexp->derivation
             gexp->file
             gexp->script
-            text-file*))
+            text-file*
+            imported-files
+            imported-modules
+            compiled-modules))
 
 ;;; Commentary:
 ;;;
@@ -149,6 +153,7 @@ names and file names suitable for the #:allowed-references argument to
                            (modules '())
                            (module-path %load-path)
                            (guile-for-build (%guile-for-build))
+                           (graft? (%graft?))
                            references-graphs
                            allowed-references
                            local-build?)
@@ -161,6 +166,9 @@ names of Guile modules searched in MODULE-PATH to be copied in the store,
 compiled, and made available in the load path during the execution of
 EXP---e.g., '((guix build utils) (guix build gnu-build-system)).
 
+GRAFT? determines whether packages referred to by EXP should be grafted when
+applicable.
+
 When REFERENCES-GRAPHS is true, it must be a list of tuples of one of the
 following forms:
 
@@ -194,10 +202,10 @@ The other arguments are as for 'derivation'."
             (cons file-name thing)))
          graphs))
 
-  (mlet* %store-monad (;; The following binding is here to force
-                       ;; '%current-system' and '%current-target-system' to be
-                       ;; looked up at >>= time.
-                       (unused    (return #f))
+  (mlet* %store-monad (;; The following binding forces '%current-system' and
+                       ;; '%current-target-system' to be looked up at >>=
+                       ;; time.
+                       (graft?    (set-grafting graft?))
 
                        (system -> (or system (%current-system)))
                        (target -> (if (eq? target 'current)
@@ -241,30 +249,32 @@ The other arguments are as for 'derivation'."
                                      (return guile-for-build)
                                      (package->derivation (default-guile)
                                                           system))))
-    (raw-derivation name
-                    (string-append (derivation->output-path guile)
-                                   "/bin/guile")
-                    `("--no-auto-compile"
-                      ,@(if (pair? %modules)
-                            `("-L" ,(derivation->output-path modules)
-                              "-C" ,(derivation->output-path compiled))
-                            '())
-                      ,builder)
-                    #:outputs outputs
-                    #:env-vars env-vars
-                    #:system system
-                    #:inputs `((,guile)
-                               (,builder)
-                               ,@(if modules
-                                     `((,modules) (,compiled) ,@inputs)
-                                     inputs)
-                               ,@(match graphs
-                                   (((_ . inputs) ...) inputs)
-                                   (_ '())))
-                    #:hash hash #:hash-algo hash-algo #:recursive? recursive?
-                    #:references-graphs (and=> graphs graphs-file-names)
-                    #:allowed-references allowed
-                    #:local-build? local-build?)))
+    (mbegin %store-monad
+      (set-grafting graft?)                       ;restore the initial setting
+      (raw-derivation name
+                      (string-append (derivation->output-path guile)
+                                     "/bin/guile")
+                      `("--no-auto-compile"
+                        ,@(if (pair? %modules)
+                              `("-L" ,(derivation->output-path modules)
+                                "-C" ,(derivation->output-path compiled))
+                              '())
+                        ,builder)
+                      #:outputs outputs
+                      #:env-vars env-vars
+                      #:system system
+                      #:inputs `((,guile)
+                                 (,builder)
+                                 ,@(if modules
+                                       `((,modules) (,compiled) ,@inputs)
+                                       inputs)
+                                 ,@(match graphs
+                                     (((_ . inputs) ...) inputs)
+                                     (_ '())))
+                      #:hash hash #:hash-algo hash-algo #:recursive? recursive?
+                      #:references-graphs (and=> graphs graphs-file-names)
+                      #:allowed-references allowed
+                      #:local-build? local-build?))))
 
 (define* (gexp-inputs exp #:optional (references gexp-references))
   "Return the input list for EXP, using REFERENCES to get its list of
@@ -502,6 +512,157 @@ package/derivation references."
 
 
 ;;;
+;;; Module handling.
+;;;
+
+(define %mkdir-p-definition
+  ;; The code for 'mkdir-p' is copied from (guix build utils).  We use it in
+  ;; derivations that cannot use the #:modules argument of 'gexp->derivation'
+  ;; precisely because they implement that functionality.
+  (gexp
+   (define (mkdir-p dir)
+     (define absolute?
+       (string-prefix? "/" dir))
+
+     (define not-slash
+       (char-set-complement (char-set #\/)))
+
+     (let loop ((components (string-tokenize dir not-slash))
+                (root       (if absolute? "" ".")))
+       (match components
+         ((head tail ...)
+          (let ((path (string-append root "/" head)))
+            (catch 'system-error
+              (lambda ()
+                (mkdir path)
+                (loop tail path))
+              (lambda args
+                (if (= EEXIST (system-error-errno args))
+                    (loop tail path)
+                    (apply throw args))))))
+         (() #t))))))
+
+(define* (imported-files files
+                         #:key (name "file-import")
+                         (system (%current-system))
+                         (guile (%guile-for-build)))
+  "Return a derivation that imports FILES into STORE.  FILES must be a list
+of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file
+system, imported, and appears under FINAL-PATH in the resulting store path."
+  (define file-pair
+    (match-lambda
+     ((final-path . file-name)
+      (mlet %store-monad ((file (interned-file file-name
+                                               (basename final-path))))
+        (return (list final-path file))))))
+
+  (mlet %store-monad ((files (sequence %store-monad
+                                       (map file-pair files))))
+    (define build
+      (gexp
+       (begin
+         (use-modules (ice-9 match))
+
+         (ungexp %mkdir-p-definition)
+
+         (mkdir (ungexp output)) (chdir (ungexp output))
+         (for-each (match-lambda
+                    ((final-path store-path)
+                     (mkdir-p (dirname final-path))
+                     (symlink store-path final-path)))
+                   '(ungexp files)))))
+
+    ;; TODO: Pass FILES as an environment variable so that BUILD remains
+    ;; exactly the same regardless of FILES: less disk space, and fewer
+    ;; 'add-to-store' RPCs.
+    (gexp->derivation name build
+                      #:system system
+                      #:guile-for-build guile
+                      #:local-build? #t)))
+
+(define search-path*
+  ;; A memoizing version of 'search-path' so 'imported-modules' does not end
+  ;; up looking for the same files over and over again.
+  (memoize search-path))
+
+(define* (imported-modules modules
+                           #:key (name "module-import")
+                           (system (%current-system))
+                           (guile (%guile-for-build))
+                           (module-path %load-path))
+  "Return a derivation that contains the source files of MODULES, a list of
+module names such as `(ice-9 q)'.  All of MODULES must be in the MODULE-PATH
+search path."
+  ;; TODO: Determine the closure of MODULES, build the `.go' files,
+  ;; canonicalize the source files through read/write, etc.
+  (let ((files (map (lambda (m)
+                      (let ((f (string-append
+                                (string-join (map symbol->string m) "/")
+                                ".scm")))
+                        (cons f (search-path* module-path f))))
+                    modules)))
+    (imported-files files #:name name #:system system
+                    #:guile guile)))
+
+(define* (compiled-modules modules
+                           #:key (name "module-import-compiled")
+                           (system (%current-system))
+                           (guile (%guile-for-build))
+                           (module-path %load-path))
+  "Return a derivation that builds a tree containing the `.go' files
+corresponding to MODULES.  All the MODULES are built in a context where
+they can refer to each other."
+  (mlet %store-monad ((modules (imported-modules modules
+                                                 #:system system
+                                                 #:guile guile
+                                                 #:module-path
+                                                 module-path)))
+    (define build
+      (gexp
+       (begin
+         (use-modules (ice-9 ftw)
+                      (ice-9 match)
+                      (srfi srfi-26)
+                      (system base compile))
+
+         (ungexp %mkdir-p-definition)
+
+         (define (regular? file)
+           (not (member file '("." ".."))))
+
+         (define (process-directory directory output)
+           (let ((entries (map (cut string-append directory "/" <>)
+                               (scandir directory regular?))))
+             (for-each (lambda (entry)
+                         (if (file-is-directory? entry)
+                             (let ((output (string-append output "/"
+                                                          (basename entry))))
+                               (mkdir-p output)
+                               (process-directory entry output))
+                             (let* ((base   (string-drop-right
+                                             (basename entry)
+                                             4)) ;.scm
+                                    (output (string-append output "/" base
+                                                           ".go")))
+                               (compile-file entry
+                                             #:output-file output
+                                             #:opts
+                                             %auto-compilation-options))))
+                       entries)))
+
+         (set! %load-path (cons (ungexp modules) %load-path))
+         (mkdir (ungexp output))
+         (chdir (ungexp modules))
+         (process-directory "." (ungexp output)))))
+
+    ;; TODO: Pass MODULES as an environment variable.
+    (gexp->derivation name build
+                      #:system system
+                      #:guile-for-build guile
+                      #:local-build? #t)))
+
+
+;;;
 ;;; Convenience procedures.
 ;;;
 
@@ -562,7 +723,6 @@ and store file names; the resulting store file holds references to all these."
 
   (gexp->derivation name builder))
 
-
 
 ;;;
 ;;; Syntactic sugar.
diff --git a/guix/http-client.scm b/guix/http-client.scm
index 4770628e45..aad7656e19 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2012 Free Software Foundation, Inc.
 ;;;
 ;;; This file is part of GNU Guix.
@@ -29,6 +30,7 @@
   #:use-module (rnrs bytevectors)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module ((guix build download) #:select (resolve-uri-reference))
   #:export (&http-get-error
             http-get-error?
             http-get-error-uri
@@ -227,7 +229,7 @@ Raise an '&http-get-error' condition if downloading fails."
                     (values data len)))))
           ((301                                   ; moved permanently
             302)                                  ; found (redirection)
-           (let ((uri (response-location resp)))
+           (let ((uri (resolve-uri-reference (response-location resp) uri)))
              (close-port port)
              (format #t (_ "following redirection to `~a'...~%")
                      (uri->string uri))
diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index 5f4602a8d2..37dd3b162c 100644
--- a/guix/import/cpan.scm
+++ b/guix/import/cpan.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,6 +20,8 @@
 (define-module (guix import cpan)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module ((ice-9 popen) #:select (open-pipe* close-pipe))
+  #:use-module ((ice-9 rdelim) #:select (read-line))
   #:use-module (srfi srfi-1)
   #:use-module (json)
   #:use-module (guix hash)
@@ -27,6 +30,9 @@
   #:use-module ((guix download) #:select (download-to-store))
   #:use-module (guix import utils)
   #:use-module (guix import json)
+  #:use-module (guix packages)
+  #:use-module (guix derivations)
+  #:use-module (gnu packages perl)
   #:export (cpan->guix-package))
 
 ;;; Commentary:
@@ -44,7 +50,7 @@
    ;; apache_1_1
    ("apache_2_0" 'asl2.0)
    ;; artistic_1_0
-   ;; artistic_2_0
+   ("artistic_2_0" 'artistic2.0)
    ("bsd" 'bsd-3)
    ("freebsd" 'bsd-2)
    ;; gfdl_1_2
@@ -58,7 +64,7 @@
    ;; mozilla_1_0
    ("mozilla_1_1" 'mpl1.1)
    ("openssl" 'openssl)
-   ("perl_5" 'gpl1+)                    ;and Artistic 1
+   ("perl_5" '(package-license perl))   ;GPL1+ and Artistic 1
    ("qpl_1_0" 'qpl)
    ;; ssleay
    ;; sun
@@ -71,6 +77,14 @@
   "Transform a 'module' name into a 'release' name"
   (regexp-substitute/global #f "::" module 'pre "-" 'post))
 
+(define (module->dist-name module)
+  "Return the base distribution module for a given module.  E.g. the 'ok'
+module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would
+return \"Test-Simple\""
+  (assoc-ref (json-fetch (string-append "http://api.metacpan.org/module/"
+                                        module))
+             "distribution"))
+
 (define (cpan-fetch module)
   "Return an alist representation of the CPAN metadata for the perl module MODULE,
 or #f on failure.  MODULE should be e.g. \"Test::Script\""
@@ -84,6 +98,15 @@ or #f on failure.  MODULE should be e.g. \"Test::Script\""
 (define (cpan-home name)
   (string-append "http://search.cpan.org/dist/" name))
 
+(define %corelist
+  (delay
+    (let* ((perl (with-store store
+                   (derivation->output-path
+                    (package-derivation store perl))))
+           (core (string-append perl "/bin/corelist")))
+      (and (access? core X_OK)
+           core))))
+
 (define (cpan-module->sexp meta)
   "Return the `package' s-expression for a CPAN module from the metadata in
 META."
@@ -98,6 +121,17 @@ META."
   (define version
     (assoc-ref meta "version"))
 
+  (define (core-module? name)
+    (and (force %corelist)
+         (parameterize ((current-error-port (%make-void-port "w")))
+           (let* ((corelist (open-pipe* OPEN_READ (force %corelist) name)))
+             (let loop ((line (read-line corelist)))
+               (if (eof-object? line)
+                   (begin (close-pipe corelist) #f)
+                   (if (string-contains line "first released with perl")
+                       (begin (close-pipe corelist) #t)
+                       (loop (read-line corelist)))))))))
+
   (define (convert-inputs phases)
     ;; Convert phase dependencies into a list of name/variable pairs.
     (match (flatten
@@ -109,19 +143,22 @@ META."
       (#f
        '())
       ((inputs ...)
-       (delete-duplicates
-        ;; Listed dependencies may include core modules.  Filter those out.
-        (filter-map (match-lambda
-                     ((or (module . "0") ("perl" . _))
-                      ;; TODO: A stronger test might to run MODULE through
-                      ;; `corelist' from our perl package.  This current test
-                      ;; seems to be only a loose convention.
-                      #f)
-                     ((module . _)
-                      (let ((name (guix-name (module->name module))))
-                        (list name
-                              (list 'unquote (string->symbol name))))))
-                    inputs)))))
+       (sort
+        (delete-duplicates
+         ;; Listed dependencies may include core modules.  Filter those out.
+         (filter-map (match-lambda
+                      (("perl" . _)     ;implicit dependency
+                       #f)
+                      ((module . _)
+                       (and (not (core-module? module))
+                            (let ((name (guix-name (module->dist-name module))))
+                              (list name
+                                    (list 'unquote (string->symbol name)))))))
+                     inputs))
+        (lambda args
+          (match args
+            (((a _ ...) (b _ ...))
+             (string<? a b))))))))
 
   (define (maybe-inputs guix-name inputs)
     (match inputs
@@ -132,7 +169,9 @@ META."
                    (list 'quasiquote inputs))))))
 
   (define source-url
-    (assoc-ref meta "download_url"))
+    (regexp-substitute/global #f "http://cpan.metacpan.org"
+                              (assoc-ref meta "download_url")
+                              'pre "mirror://cpan" 'post))
 
   (let ((tarball (with-store store
                    (download-to-store store source-url))))
@@ -147,12 +186,12 @@ META."
                    ,(bytevector->nix-base32-string (file-sha256 tarball))))))
        (build-system perl-build-system)
        ,@(maybe-inputs 'native-inputs
-                       ;; "runtime" and "test" may also be needed here.  See
+                       ;; "runtime" may also be needed here.  See
                        ;; https://metacpan.org/pod/CPAN::Meta::Spec#Phases,
                        ;; which says they are required during building.  We
                        ;; have not yet had a need for cross-compiled perl
-                       ;; modules, however, so we leave them out.
-                       (convert-inputs '("configure" "build")))
+                       ;; modules, however, so we leave it out.
+                       (convert-inputs '("configure" "build" "test")))
        ,@(maybe-inputs 'inputs
                        (convert-inputs '("runtime")))
        (home-page ,(string-append "http://search.cpan.org/dist/" name))
diff --git a/guix/licenses.scm b/guix/licenses.scm
index 86f3ae4e82..157e74bf37 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2014 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2013, 2015 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -28,7 +28,7 @@
             cc0
             cddl1.0
             cecill-c
-            clarified-artistic
+            artistic2.0 clarified-artistic
             cpl1.0
             epl1.0
             expat
@@ -39,6 +39,7 @@
             ijg
             ibmpl1.0
             imlib2
+            ipa
             lgpl2.0 lgpl2.0+ lgpl2.1 lgpl2.1+ lgpl3 lgpl3+
             mpl1.1 mpl2.0
             ncsa
@@ -129,6 +130,11 @@ which may be a file:// URI pointing the package's tree."
            "http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.html"
            "https://www.gnu.org/licenses/license-list.html#CeCILL"))
 
+(define artistic2.0
+  (license "Artistic License 2.0"
+           "http://www.perlfoundation.org/artistic_license_2_0"
+           "http://www.gnu.org/licenses/license-list.html#ArtisticLicense2"))
+
 (define clarified-artistic
   (license "Clarified Artistic"
            ;; http://directory.fsf.org/wiki/User:Jgay/license-categorization#Clarified_Artistic_License
@@ -210,6 +216,11 @@ which may be a file:// URI pointing the package's tree."
            "http://directory.fsf.org/wiki/License:Imlib2"
            "https://www.gnu.org/licenses/license-list#imlib"))
 
+(define ipa
+  (license "IPA Font License"
+           "http://directory.fsf.org/wiki/License:IPA_Font_License"
+           "https://www.gnu.org/licenses/license-list#IPAFONT"))
+
 (define lgpl2.0
   (license "LGPL 2.0"
            "https://www.gnu.org/licenses/old-licenses/lgpl-2.0.html"
diff --git a/guix/packages.scm b/guix/packages.scm
index 96f3adfc32..5b686a122f 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -114,6 +114,7 @@
             default-guile
 
             set-guile-for-build
+            set-grafting
             package-file
             package->derivation
             package->cross-derivation
@@ -906,6 +907,12 @@ code of derivations to GUILE, a package object."
     (let ((guile (package-derivation store guile)))
       (values (%guile-for-build guile) store))))
 
+(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)))
+
 (define* (package-file package
                        #:optional file
                        #:key
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index b85119a0ff..ea6801a6eb 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -297,20 +297,6 @@ the input port."
         (cut write-acl acl <>)))))
 
 (define (guix-archive . args)
-  (define (parse-options)
-    ;; Return the alist of option values.
-    (append (parse-options-from args)
-            (parse-options-from (environment-build-options))))
-
-  (define (parse-options-from args)
-    ;; Actual parsing takes place here.
-    (args-fold* args %options
-                (lambda (opt name arg result)
-                  (leave (_ "~A: unrecognized option~%") name))
-                (lambda (arg result)
-                  (alist-cons 'argument arg result))
-                %default-options))
-
   (define (lines port)
     ;; Return lines read from PORT.
     (let loop ((line   (read-line port))
@@ -324,7 +310,7 @@ the input port."
     ;; Ask for absolute file names so that .drv file names passed from the
     ;; user to 'read-derivation' are absolute when it returns.
     (with-fluids ((%file-port-name-canonicalization 'absolute))
-      (let ((opts (parse-options)))
+      (let ((opts (parse-command-line args %options (list %default-options))))
         (cond ((assoc-ref opts 'generate-key)
                =>
                generate-key-pair)
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 07ced30484..370c2a37ff 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -405,25 +405,12 @@ arguments with packages that use the specified source."
 ;;;
 
 (define (guix-build . args)
-  (define (parse-options)
-    ;; Return the alist of option values.
-    (append (parse-options-from args)
-            (parse-options-from (environment-build-options))))
-
-  (define (parse-options-from args)
-    ;; Actual parsing takes place here.
-    (args-fold* args %options
-                (lambda (opt name arg result)
-                  (leave (_ "~A: unrecognized option~%") name))
-                (lambda (arg result)
-                  (alist-cons 'argument arg result))
-                %default-options))
-
   (with-error-handling
     ;; Ask for absolute file names so that .drv file names passed from the
     ;; user to 'read-derivation' are absolute when it returns.
     (with-fluids ((%file-port-name-canonicalization 'absolute))
-      (let* ((opts  (parse-options))
+      (let* ((opts  (parse-command-line args %options
+                                        (list %default-options)))
              (store (open-connection))
              (drv   (options->derivations store opts))
              (roots (filter-map (match-lambda
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index bb2ce53caf..c96ca351c4 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -217,22 +217,12 @@ packages."
 
 ;; Entry point.
 (define (guix-environment . args)
-  (define (parse-options)
-    ;; Return the alist of option values.
-    (append (parse-options-from args)
-            (parse-options-from (environment-build-options))))
-
-  (define (parse-options-from args)
-    ;; Actual parsing takes place here.
-    (args-fold* args %options
-                (lambda (opt name arg result)
-                  (leave (_ "~A: unrecognized option~%") name))
-                (lambda (arg result)
-                  (alist-cons 'package arg result))
-                %default-options))
+  (define (handle-argument arg result)
+    (alist-cons 'package arg result))
 
   (with-store store
-    (let* ((opts (parse-options))
+    (let* ((opts  (parse-command-line args %options (list %default-options)
+                                      #:argument-handler handle-argument))
            (pure? (assoc-ref opts 'pure))
            (command (assoc-ref opts 'exec))
            (inputs (packages->transitive-inputs
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index fc116d8f6c..c27207f29a 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -692,22 +692,11 @@ doesn't need it."
 ;;;
 
 (define (guix-package . args)
-  (define (parse-options)
-    ;; Return the alist of option values.
-    (append (parse-options-from args)
-            (parse-options-from (environment-build-options))))
-
-  (define (parse-options-from args)
-    ;; Actual parsing takes place here.
-    (args-fold* args %options
-                (lambda (opt name arg result arg-handler)
-                  (leave (_ "~A: unrecognized option~%") name))
-                (lambda (arg result arg-handler)
-                  (if arg-handler
-                      (arg-handler arg result)
-                      (leave (_ "~A: extraneous argument~%") arg)))
-                %default-options
-                #f))
+  (define (handle-argument arg result arg-handler)
+    ;; Process non-option argument ARG by calling back ARG-HANDLER.
+    (if arg-handler
+        (arg-handler arg result)
+        (leave (_ "~A: extraneous argument~%") arg)))
 
   (define (ensure-default-profile)
     ;; Ensure the default profile symlink and directory exist and are
@@ -987,7 +976,8 @@ more information.~%"))
 
         (_ #f))))
 
-  (let ((opts (parse-options)))
+  (let ((opts (parse-command-line args %options (list %default-options #f)
+                                  #:argument-handler handle-argument)))
     (with-error-handling
       (or (process-query opts)
           (parameterize ((%store (open-connection)))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 3eea872fe8..1b64e6fb92 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -446,7 +446,7 @@ Build the operating system declared in FILE according to ACTION.\n"))
                                result)))
          (option '("no-grub") #f #f
                  (lambda (opt name arg result)
-                   (alist-delete 'install-grub? result)))
+                   (alist-cons 'install-grub? #f result)))
          (option '("full-boot") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'full-boot? #t result)))
@@ -487,26 +487,15 @@ Build the operating system declared in FILE according to ACTION.\n"))
 ;;;
 
 (define (guix-system . args)
-  (define (parse-options)
-    ;; Return the alist of option values.
-    (append (parse-options-from args)
-            (parse-options-from (environment-build-options))))
-
-  (define (parse-options-from args)
-    ;; Actual parsing takes place here.
-    (args-fold* args %options
-                (lambda (opt name arg result)
-                  (leave (_ "~A: unrecognized option~%") name))
-                (lambda (arg result)
-                  (if (assoc-ref result 'action)
-                      (alist-cons 'argument arg result)
-                      (let ((action (string->symbol arg)))
-                        (case action
-                          ((build vm vm-image disk-image reconfigure init)
-                           (alist-cons 'action action result))
-                          (else (leave (_ "~a: unknown action~%")
-                                       action))))))
-                %default-options))
+  (define (parse-sub-command arg result)
+    ;; Parse sub-command ARG and augment RESULT accordingly.
+    (if (assoc-ref result 'action)
+        (alist-cons 'argument arg result)
+        (let ((action (string->symbol arg)))
+          (case action
+            ((build vm vm-image disk-image reconfigure init)
+             (alist-cons 'action action result))
+            (else (leave (_ "~a: unknown action~%") action))))))
 
   (define (match-pair car)
     ;; Return a procedure that matches a pair with CAR.
@@ -534,7 +523,10 @@ Build the operating system declared in FILE according to ACTION.\n"))
       args))
 
   (with-error-handling
-    (let* ((opts     (parse-options))
+    (let* ((opts     (parse-command-line args %options
+                                         (list %default-options)
+                                         #:argument-handler
+                                         parse-sub-command))
            (args     (option-arguments opts))
            (file     (first args))
            (action   (assoc-ref opts 'action))
diff --git a/guix/store.scm b/guix/store.scm
index 02d84eb517..d88fb3ea54 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -890,11 +890,13 @@ taking the store as its first argument."
 ;; Store monad operators.
 ;;
 
-(define* (text-file name text)
+(define* (text-file name text
+                    #:optional (references '()))
   "Return as a monadic value the absolute file name in the store of the file
-containing TEXT, a string."
+containing TEXT, a string.  REFERENCES is a list of store items that the
+resulting text file refers to; it defaults to the empty list."
   (lambda (store)
-    (values (add-text-to-store store name text '())
+    (values (add-text-to-store store name text references)
             store)))
 
 (define* (interned-file file #:optional name
diff --git a/guix/tests.scm b/guix/tests.scm
index 451c1ba4bb..0896e842da 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -23,6 +23,7 @@
   #:use-module (guix base32)
   #:use-module (guix serialization)
   #:use-module (guix hash)
+  #:use-module (guix build-system gnu)
   #:use-module (gnu packages bootstrap)
   #:use-module (srfi srfi-34)
   #:use-module (rnrs bytevectors)
@@ -30,6 +31,8 @@
   #:export (open-connection-for-tests
             random-text
             random-bytevector
+            network-reachable?
+            shebang-too-long?
             mock
             %substitute-directory
             with-derivation-narinfo
@@ -76,6 +79,10 @@
             (loop (1+ i)))
           bv))))
 
+(define (network-reachable?)
+  "Return true if we can reach the Internet."
+  (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)))
+
 (define-syntax-rule (mock (module proc replacement) body ...)
   "Within BODY, replace the definition of PROC from MODULE with the definition
 given by REPLACEMENT."
@@ -179,6 +186,17 @@ CONTENTS."
       (delete-file (string-append dir "/example.out"))
       (delete-file (string-append dir "/example.nar")))))
 
+(define (shebang-too-long?)
+  "Return true if the typical shebang in the current store would exceed
+Linux's static limit---the BINPRM_BUF_SIZE constant, normally 128 characters
+all included."
+  (define shebang
+    (string-append "#!" (%store-prefix) "/"
+                   (make-string 32 #\a)
+                   "-bootstrap-binaries-0/bin/bash\0"))
+
+  (> (string-length shebang) 128))
+
 (define-syntax with-derivation-substitute
   (syntax-rules (sha256 =>)
     "Evaluate BODY in a context where DRV is substitutable with the given
diff --git a/guix/ui.scm b/guix/ui.scm
index 382b5b1e0d..ae37c8e6ca 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
+;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -66,7 +67,7 @@
             string->generations
             string->duration
             args-fold*
-            environment-build-options
+            parse-command-line
             run-guix-command
             program-name
             guix-warning-port
@@ -754,6 +755,36 @@ reporting."
   "Return additional build options passed as environment variables."
   (arguments-from-environment-variable "GUIX_BUILD_OPTIONS"))
 
+(define %default-argument-handler
+  ;; The default handler for non-option command-line arguments.
+  (lambda (arg result)
+    (alist-cons 'argument arg result)))
+
+(define* (parse-command-line args options seeds
+                             #:key
+                             (argument-handler %default-argument-handler))
+  "Parse the command-line arguments ARGS as well as arguments passed via the
+'GUIX_BUILD_OPTIONS' environment variable according to OPTIONS (a list of
+SRFI-37 options) and return the result, seeded by SEEDS.
+Command-line options take precedence those passed via 'GUIX_BUILD_OPTIONS'.
+
+ARGUMENT-HANDLER is called for non-option arguments, like the 'operand-proc'
+parameter of 'args-fold'."
+  (define (parse-options-from args seeds)
+    ;; Actual parsing takes place here.
+    (apply args-fold* args options
+           (lambda (opt name arg . rest)
+             (leave (_ "~A: unrecognized option~%") name))
+           argument-handler
+           seeds))
+
+  (call-with-values
+      (lambda ()
+        (parse-options-from (environment-build-options) seeds))
+    (lambda seeds
+      ;; ARGS take precedence over what the environment variable specifies.
+      (parse-options-from args seeds))))
+
 (define (show-guix-usage)
   (format (current-error-port)
           (_ "Try `guix --help' for more information.~%"))