Merge branch 'core-updates'

8 files changed, 113 insertions, 147 deletions

diff --git a/guix/build-system/glib-or-gtk.scm b/guix/build-system/glib-or-gtk.scm
index a1f0a9b8a4..d585d84f20 100644
--- a/guix/build-system/glib-or-gtk.scm
+++ b/guix/build-system/glib-or-gtk.scm
@@ -36,7 +36,7 @@
 ;; This build system is an extension of the 'gnu-build-system'.  It
 ;; accomodates the needs of applications making use of glib or gtk+ (with "or"
 ;; to be interpreted in the mathematical sense).  This is achieved by adding
-;; three phases run after the 'install' phase:
+;; two phases run after the 'install' phase:
 ;;
 ;; 'glib-or-gtk-wrap' phase:
 ;;
@@ -57,11 +57,6 @@
 ;; exists and does not include a file named "gschemas.compiled", then
 ;; "glib-compile-schemas" is run in that directory.
 ;;
-;; 'glib-or-gtk-icon-cache' phase:
-;;
-;; Looks for the existence of icon themes and, if no cache exists, generate
-;; the "icon-theme.cache" file.
-;;
 ;; Code:
 
 (define %default-modules
@@ -81,22 +76,16 @@
   (let ((module (resolve-interface '(gnu packages glib))))
     (module-ref module 'glib)))
 
-(define (default-gtk+)
-  "Return the default gtk+ package from which we use
-\"gtk-update-icon-cache\"."
-  (let ((module (resolve-interface '(gnu packages gtk))))
-    (module-ref module 'gtk+)))
-
 (define* (lower name
                 #:key source inputs native-inputs outputs system target
-                (glib (default-glib)) (gtk+ (default-gtk+))
+                (glib (default-glib))
                 (implicit-inputs? #t)
                 (strip-binaries? #t)
                 #:allow-other-keys
                 #:rest arguments)
   "Return a bag for NAME."
   (define private-keywords
-    '(#:source #:target #:glib #:gtk+ #:inputs #:native-inputs
+    '(#:source #:target #:glib #:inputs #:native-inputs
       #:outputs #:implicit-inputs?))
 
   (and (not target)                               ;XXX: no cross-compilation
@@ -108,7 +97,6 @@
                               '())
                         ,@inputs))
          (build-inputs `(("glib:bin" ,glib "bin") ; to compile schemas
-                         ("gtk+" ,gtk+)           ; to generate icon cache
                          ,@(if implicit-inputs?
                                (standard-packages)
                                '())
diff --git a/guix/build/emacs-build-system.scm b/guix/build/emacs-build-system.scm
index c01b24fe9a..f0a9a6e125 100644
--- a/guix/build/emacs-build-system.scm
+++ b/guix/build/emacs-build-system.scm
@@ -83,7 +83,8 @@ store in '.el' files."
   (let* ((out (assoc-ref outputs "out"))
          (elpa-name-ver (store-directory->elpa-name-version out))
          (el-dir (string-append out %install-suffix "/" elpa-name-ver))
-         (info-dir (string-append out "/share/info"))
+         (name-ver (strip-store-file-name out))
+         (info-dir (string-append out "/share/info/"))
          (info-files (find-files el-dir "\\.info$")))
     (unless (null? info-files)
       (mkdir-p info-dir)
@@ -115,7 +116,7 @@ store in '.el' files."
   (filter (match-lambda
             ((label . directory)
              (emacs-package? ((compose package-name->name+version
-                                       store-directory->name-version)
+                                       strip-store-file-name)
                               directory)))
             (_ #f))
           inputs))
@@ -137,47 +138,17 @@ DIRS."
 (define (package-name-version->elpa-name-version name-ver)
   "Convert the Guix package NAME-VER to the corresponding ELPA name-version
 format.  Essnetially drop the prefix used in Guix."
-  (let ((name (store-directory->name-version name-ver)))
-    (if (emacs-package? name-ver)
-        (store-directory->name-version name-ver)
-        name-ver)))
+  (if (emacs-package? name-ver)  ; checks for "emacs-" prefix
+      (string-drop name-ver (string-length "emacs-"))
+      name-ver))
 
 (define (store-directory->elpa-name-version store-dir)
   "Given a store directory STORE-DIR return the part of the basename after the
 second hyphen.  This corresponds to 'name-version' as used in ELPA packages."
   ((compose package-name-version->elpa-name-version
-            store-directory->name-version)
+            strip-store-file-name)
    store-dir))
 
-(define (store-directory->name-version store-dir)
-  "Given a store directory STORE-DIR return the part of the basename
-after the first hyphen.  This corresponds to 'name-version' of the package."
-  (let* ((base (basename store-dir)))
-    (string-drop base
-                 (+ 1 (string-index base #\-)))))
-
-;; from (guix utils).  Should we put it in (guix build utils)?
-(define (package-name->name+version name)
-  "Given NAME, a package name like \"foo-0.9.1b\", return two values:
-\"foo\" and \"0.9.1b\".  When the version part is unavailable, NAME and
-#f are returned.  The first hyphen followed by a digit is considered to
-introduce the version part."
-  ;; See also `DrvName' in Nix.
-
-  (define number?
-    (cut char-set-contains? char-set:digit <>))
-
-  (let loop ((chars   (string->list name))
-             (prefix '()))
-    (match chars
-      (()
-       (values name #f))
-      ((#\- (? number? n) rest ...)
-       (values (list->string (reverse prefix))
-               (list->string (cons n rest))))
-      ((head tail ...)
-       (loop tail (cons head prefix))))))
-
 (define %standard-phases
   (modify-phases gnu:%standard-phases
     (delete 'configure)
diff --git a/guix/build/glib-or-gtk-build-system.scm b/guix/build/glib-or-gtk-build-system.scm
index 15d7de2236..b6291e735b 100644
--- a/guix/build/glib-or-gtk-build-system.scm
+++ b/guix/build/glib-or-gtk-build-system.scm
@@ -213,37 +213,9 @@ if needed."
                  #t))))
          outputs))
 
-(define* (generate-icon-cache #:key outputs #:allow-other-keys)
-  "Implement phase \"glib-or-gtk-icon-cache\": generate icon cache if
-needed."
-  (every (match-lambda
-          ((output . directory)
-           (let ((iconsdir (string-append directory
-                                            "/share/icons")))
-             (when (file-exists? iconsdir)
-               (with-directory-excursion iconsdir
-                 (for-each
-                  (lambda (dir)
-                    (unless (file-exists?
-                             (string-append iconsdir "/" dir "/"
-                                            "icon-theme.cache"))
-                      (system* "gtk-update-icon-cache"
-                               "--ignore-theme-index"
-                               (string-append iconsdir "/" dir))))
-                  (scandir "."
-                           (lambda (name)
-                             (and
-                              (not (equal? name "."))
-                              (not (equal? name ".."))
-                              (equal? 'directory
-                                      (stat:type (stat name)))))))))
-             #t)))
-         outputs))
-
 (define %standard-phases
   (modify-phases gnu:%standard-phases
     (add-after 'install 'glib-or-gtk-compile-schemas compile-glib-schemas)
-    (add-after 'install 'glib-or-gtk-icon-cache generate-icon-cache)
     (add-after 'install 'glib-or-gtk-wrap wrap-all-programs)))
 
 (define* (glib-or-gtk-build #:key inputs (phases %standard-phases)
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 102207b022..0a774e1e84 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -25,6 +25,7 @@
   #:use-module (ice-9 regex)
   #:use-module (ice-9 format)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (rnrs io ports)
   #:export (%standard-phases
@@ -576,6 +577,11 @@ DOCUMENTATION-COMPRESSOR-FLAGS."
                     #:rest args)
   "Build from SOURCE to OUTPUTS, using INPUTS, and by running all of PHASES
 in order.  Return #t if all the PHASES succeeded, #f otherwise."
+  (define (elapsed-time end start)
+    (let ((diff (time-difference end start)))
+      (+ (time-second diff)
+         (/ (time-nanosecond diff) 1e9))))
+
   (setvbuf (current-output-port) _IOLBF)
   (setvbuf (current-error-port) _IOLBF)
 
@@ -586,12 +592,13 @@ in order.  Return #t if all the PHASES succeeded, #f otherwise."
   ;; PHASES can pick the keyword arguments it's interested in.
   (every (match-lambda
           ((name . proc)
-           (let ((start (gettimeofday)))
+           (let ((start (current-time time-monotonic)))
              (format #t "starting phase `~a'~%" name)
              (let ((result (apply proc args))
-                   (end    (gettimeofday)))
-               (format #t "phase `~a' ~:[failed~;succeeded~] after ~a seconds~%"
-                       name result (- (car end) (car start)))
+                   (end    (current-time time-monotonic)))
+               (format #t "phase `~a' ~:[failed~;succeeded~] after ~,1f seconds~%"
+                       name result
+                       (elapsed-time end start))
 
                ;; Dump the environment variables as a shell script, for handy debugging.
                (system "export > $NIX_BUILD_TOP/environment-variables")
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 676a0120e3..971929621a 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +22,7 @@
 (define-module (guix build utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-60)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
@@ -33,6 +35,8 @@
                alist-delete)
   #:export (%store-directory
             store-file-name?
+            strip-store-file-name
+            package-name->name+version
             parallel-job-count
 
             directory-exists?
@@ -43,6 +47,7 @@
             ar-file?
             with-directory-excursion
             mkdir-p
+            install-file
             copy-recursively
             delete-file-recursively
             file-name-predicate
@@ -86,6 +91,33 @@
   "Return true if FILE is in the store."
   (string-prefix? (%store-directory) file))
 
+(define (strip-store-file-name file)
+  "Strip the '/gnu/store' and hash from FILE, a store file name.  The result
+is typically a \"PACKAGE-VERSION\" string."
+  (string-drop file
+               (+ 34 (string-length (%store-directory)))))
+
+(define (package-name->name+version name)
+  "Given NAME, a package name like \"foo-0.9.1b\", return two values:
+\"foo\" and \"0.9.1b\".  When the version part is unavailable, NAME and
+#f are returned.  The first hyphen followed by a digit is considered to
+introduce the version part."
+  ;; See also `DrvName' in Nix.
+
+  (define number?
+    (cut char-set-contains? char-set:digit <>))
+
+  (let loop ((chars   (string->list name))
+             (prefix '()))
+    (match chars
+      (()
+       (values name #f))
+      ((#\- (? number? n) rest ...)
+       (values (list->string (reverse prefix))
+               (list->string (cons n rest))))
+      ((head tail ...)
+       (loop tail (cons head prefix))))))
+
 (define parallel-job-count
   ;; Number of processes to be passed next to GNU Make's `-j' argument.
   (make-parameter
@@ -197,6 +229,12 @@ with the bytes in HEADER, a bytevector."
                  (apply throw args))))))
       (() #t))))
 
+(define (install-file file directory)
+  "Create DIRECTORY if it does not exist and copy FILE in there under the same
+name."
+  (mkdir-p directory)
+  (copy-file file (string-append directory "/" (basename file))))
+
 (define* (copy-recursively source destination
                            #:key
                            (log (current-output-port))
@@ -279,13 +317,16 @@ name matches REGEXP."
       (regexp-exec file-rx (basename file)))))
 
 (define* (find-files dir #:optional (pred (const #t))
-                     #:key (stat lstat))
+                     #:key (stat lstat)
+                     directories?
+                     fail-on-error?)
   "Return the lexicographically sorted list of files under DIR for which PRED
 returns true.  PRED is passed two arguments: the absolute file name, and its
 stat buffer; the default predicate always returns true.  PRED can also be a
 regular expression, in which case it is equivalent to (file-name-predicate
 PRED).  STAT is used to obtain file information; using 'lstat' means that
-symlinks are not followed."
+symlinks are not followed.  If DIRECTORIES? is true, then directories will
+also be included.  If FAIL-ON-ERROR? is true, raise an exception upon error."
   (let ((pred (if (procedure? pred)
                   pred
                   (file-name-predicate pred))))
@@ -296,7 +337,10 @@ symlinks are not followed."
                                   (cons file result)
                                   result))
                             (lambda (dir stat result) ; down
-                              result)
+                              (if (and directories?
+                                       (pred dir stat))
+                                  (cons dir result)
+                                  result))
                             (lambda (dir stat result) ; up
                               result)
                             (lambda (file stat result) ; skip
@@ -304,6 +348,8 @@ symlinks are not followed."
                             (lambda (file stat errno result)
                               (format (current-error-port) "find-files: ~a: ~a~%"
                                       file (strerror errno))
+                              (when fail-on-error?
+                                (error "find-files failed"))
                               result)
                             '()
                             dir
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 63af40aed9..de49fef088 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -717,32 +717,11 @@ and in the current monad setting (system type, etc.)"
 ;;; 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 %utils-module
+  ;; This file provides 'mkdir-p', needed to implement 'imported-files' and
+  ;; other primitives below.
+  (local-file (search-path %load-path "guix/build/utils.scm")
+              "build-utils.scm"))
 
 (define* (imported-files files
                          #:key (name "file-import")
@@ -763,10 +742,9 @@ system, imported, and appears under FINAL-PATH in the resulting store path."
     (define build
       (gexp
        (begin
+         (primitive-load (ungexp %utils-module))  ;for 'mkdir-p'
          (use-modules (ice-9 match))
 
-         (ungexp %mkdir-p-definition)
-
          (mkdir (ungexp output)) (chdir (ungexp output))
          (for-each (match-lambda
                     ((final-path store-path)
@@ -822,13 +800,12 @@ they can refer to each other."
     (define build
       (gexp
        (begin
+         (primitive-load (ungexp %utils-module))  ;for 'mkdir-p'
+
          (use-modules (ice-9 ftw)
-                      (ice-9 match)
                       (srfi srfi-26)
                       (system base compile))
 
-         (ungexp %mkdir-p-definition)
-
          (define (regular? file)
            (not (member file '("." ".."))))
 
diff --git a/guix/packages.scm b/guix/packages.scm
index edcb53ec93..72822b8c97 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -99,6 +99,7 @@
             transitive-input-references
 
             %supported-systems
+            %hurd-systems
             %hydra-supported-systems
             supported-package?
 
@@ -215,9 +216,13 @@ name of its URI."
   ;; expect all packages to build successfully here.
   '("x86_64-linux" "i686-linux" "armhf-linux" "mips64el-linux"))
 
+(define %hurd-systems
+  ;; The GNU/Hurd systems for which support is being developed.
+  '("i585-gnu" "i686-gnu"))
+
 (define %hydra-supported-systems
   ;; This is the list of system types for which build slaves are available.
-  (delete "armhf-linux" %supported-systems))
+  %supported-systems)
 
 
 ;; A package.
@@ -445,6 +450,13 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
                        (srfi srfi-1)
                        (guix build utils))
 
+          ;; The --sort option was added to GNU tar in version 1.28, released
+          ;; 2014-07-28.  During bootstrap we must cope with older versions.
+          (define tar-supports-sort?
+            (zero? (system* (string-append #+tar "/bin/tar")
+                            "cf" "/dev/null" "--files-from=/dev/null"
+                            "--sort=name")))
+
           (define (apply-patch patch)
             (format (current-error-port) "applying '~a'...~%" patch)
 
@@ -504,12 +516,25 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
                              #~())
 
                       (begin (chdir "..") #t)
-                      (zero? (system* (string-append #+tar "/bin/tar")
-                                      "cvfa" #$output directory
-                                      ;; avoid non-determinism in the archive
-                                      "--mtime=@0"
-                                      "--owner=root:0"
-                                      "--group=root:0")))))))
+
+                      (unless tar-supports-sort?
+                        (call-with-output-file ".file_list"
+                          (lambda (port)
+                            (for-each (lambda (name) (format port "~a~%" name))
+                                      (find-files directory
+                                                  #:directories? #t
+                                                  #:fail-on-error? #t)))))
+                      (zero? (apply system* (string-append #+tar "/bin/tar")
+                                    "cvfa" #$output
+                                    ;; avoid non-determinism in the archive
+                                    "--mtime=@0"
+                                    "--owner=root:0"
+                                    "--group=root:0"
+                                    (if tar-supports-sort?
+                                        `("--sort=name"
+                                          ,directory)
+                                        '("--no-recursion"
+                                          "--files-from=.file_list")))))))))
 
     (let ((name    (tarxz-name original-file-name))
           (modules (delete-duplicates (cons '(guix build utils) modules))))
diff --git a/guix/utils.scm b/guix/utils.scm
index 1fe11f52f5..b6df5d9cc9 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -29,7 +29,8 @@
   #:use-module (srfi srfi-60)
   #:use-module (rnrs bytevectors)
   #:use-module ((rnrs io ports) #:select (put-bytevector))
-  #:use-module ((guix build utils) #:select (dump-port))
+  #:use-module ((guix build utils)
+                #:select (dump-port package-name->name+version))
   #:use-module ((guix build syscalls) #:select (errno mkdtemp!))
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 format)
@@ -39,6 +40,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module (system foreign)
+  #:re-export (package-name->name+version)
   #:export (bytevector->base16-string
             base16-string->bytevector
 
@@ -71,7 +73,6 @@
             version-prefix
             version-major+minor
             guile-version>?
-            package-name->name+version
             string-replace-substring
             arguments-from-environment-variable
             file-extension
@@ -578,27 +579,6 @@ minor version numbers from version-string."
                             (micro-version))
              str))
 
-(define (package-name->name+version name)
-  "Given NAME, a package name like \"foo-0.9.1b\", return two values:
-\"foo\" and \"0.9.1b\".  When the version part is unavailable, NAME and
-#f are returned.  The first hyphen followed by a digit is considered to
-introduce the version part."
-  ;; See also `DrvName' in Nix.
-
-  (define number?
-    (cut char-set-contains? char-set:digit <>))
-
-  (let loop ((chars   (string->list name))
-             (prefix '()))
-    (match chars
-      (()
-       (values name #f))
-      ((#\- (? number? n) rest ...)
-       (values (list->string (reverse prefix))
-               (list->string (cons n rest))))
-      ((head tail ...)
-       (loop tail (cons head prefix))))))
-
 (define (file-extension file)
   "Return the extension of FILE or #f if there is none."
   (let ((dot (string-rindex file #\.)))