Merge branch 'core-updates'

8 files changed, 117 insertions, 30 deletions

diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 1dfd85450c..1786e2e3c9 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -389,15 +389,23 @@ makefiles."
               debug-output objcopy-command))
 
     (for-each (lambda (file)
-                (and (file-exists? file)          ;discard dangling symlinks
-                     (or (elf-file? file) (ar-file? file))
+                (and (or (elf-file? file) (ar-file? file))
                      (or (not debug-output)
                          (make-debug-file file))
+
+                     ;; Ensure the file is writable.
+                     (begin (make-file-writable file) #t)
+
                      (zero? (apply system* strip-command
                                    (append strip-flags (list file))))
                      (or (not debug-output)
                          (add-debug-link file))))
-              (find-files dir)))
+              (find-files dir
+                          (lambda (file stat)
+                            ;; Ignore symlinks such as:
+                            ;; libfoo.so -> libfoo.so.0.0.
+                            (eq? 'regular (stat:type stat)))
+                          #:stat lstat)))
 
   (or (not strip-binaries?)
       (every strip-dir
@@ -476,6 +484,23 @@ and 'man/'.  This phase moves directories to the right place if needed."
      (for-each validate-output directories)))
   #t)
 
+(define* (reset-gzip-timestamps #:key outputs #:allow-other-keys)
+  "Reset embedded timestamps in gzip files found in OUTPUTS."
+  (define (process-directory directory)
+    (let ((files (find-files directory
+                             (lambda (file stat)
+                               (and (eq? 'regular (stat:type stat))
+                                    (or (string-suffix? ".gz" file)
+                                        (string-suffix? ".tgz" file))
+                                    (gzip-file? file)))
+                             #:stat lstat)))
+      (for-each reset-gzip-timestamp files)))
+
+  (match outputs
+    (((names . directories) ...)
+     (for-each process-directory directories)))
+  #t)
+
 (define* (compress-documentation #:key outputs
                                  (compress-documentation? #t)
                                  (documentation-compressor "gzip")
@@ -598,6 +623,7 @@ which cannot be found~%"
             validate-documentation-location
             delete-info-dir-file
             patch-dot-desktop-files
+            reset-gzip-timestamps
             compress-documentation)))
 
 
diff --git a/guix/build/make-bootstrap.scm b/guix/build/make-bootstrap.scm
index 21c78cc8f5..43b136248f 100644
--- a/guix/build/make-bootstrap.scm
+++ b/guix/build/make-bootstrap.scm
@@ -55,7 +55,7 @@ when producing a bootstrap libc."
                                 (string-append incdir "/linux")))
                 '("limits.h" "errno.h" "socket.h" "kernel.h"
                   "sysctl.h" "param.h" "ioctl.h" "types.h"
-                  "posix_types.h" "stddef.h"))
+                  "posix_types.h" "stddef.h" "falloc.h"))
 
       (copy-recursively (string-append kernel-headers "/include/asm")
                         (string-append incdir "/asm"))
diff --git a/guix/build/perl-build-system.scm b/guix/build/perl-build-system.scm
index 8f480eae16..b2024e4406 100644
--- a/guix/build/perl-build-system.scm
+++ b/guix/build/perl-build-system.scm
@@ -42,7 +42,11 @@
                    "--installdirs=site" ,@module-build-flags))
                 ((file-exists? "Makefile.PL")
                  `("Makefile.PL" ,(string-append "PREFIX=" out)
-                   "INSTALLDIRS=site" ,@make-maker-flags))
+                   ;; Prevent installation of 'perllocal.pod' files for
+                   ;; determinism.  These are typically used to build a
+                   ;; catalogue of installed packages, but does not provide
+                   ;; any useful information when installed with a module.
+                   "INSTALLDIRS=site" "NO_PERLLOCAL=1" ,@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))))
diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm
index 6e316d5d2c..42eabfaf19 100644
--- a/guix/build/profiles.scm
+++ b/guix/build/profiles.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,17 +39,21 @@
 'GUIX_PROFILE' environment variable.  This allows users to specify what the
 user-friendly name of the profile is, for instance ~/.guix-profile rather than
 /gnu/store/...-profile."
-  (let ((replacement (string-append "${GUIX_PROFILE:-" profile "}")))
+  (let ((replacement (string-append "${GUIX_PROFILE:-" profile "}"))
+        (crop        (cute string-drop <> (string-length profile))))
     (match-lambda
       ((search-path . value)
-       (let* ((separator (search-path-specification-separator search-path))
-              (items     (string-tokenize* value separator))
-              (crop      (cute string-drop <> (string-length profile))))
-         (cons search-path
-               (string-join (map (lambda (str)
-                                   (string-append replacement (crop str)))
-                                 items)
-                            separator)))))))
+       (match (search-path-specification-separator search-path)
+         (#f
+          (cons search-path
+                (string-append replacement (crop value))))
+         ((? string? separator)
+          (let ((items (string-tokenize* value separator)))
+            (cons search-path
+                  (string-join (map (lambda (str)
+                                      (string-append replacement (crop str)))
+                                    items)
+                               separator)))))))))
 
 (define (write-environment-variable-definition port)
   "Write the given environment variable definition to PORT."
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index bc6f114152..e8efb0653a 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 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>
@@ -45,9 +45,12 @@
             call-with-ascii-input-file
             elf-file?
             ar-file?
+            gzip-file?
+            reset-gzip-timestamp
             with-directory-excursion
             mkdir-p
             install-file
+            make-file-writable
             copy-recursively
             delete-file-recursively
             file-name-predicate
@@ -195,6 +198,29 @@ with the bytes in HEADER, a bytevector."
 (define ar-file?
   (file-header-match %ar-magic-bytes))
 
+(define %gzip-magic-bytes
+  ;; Magic bytes of gzip file.  Beware, it's a small header so there could be
+  ;; false positives.
+  #vu8(#x1f #x8b))
+
+(define gzip-file?
+  (file-header-match %gzip-magic-bytes))
+
+(define* (reset-gzip-timestamp file #:key (keep-mtime? #t))
+  "If FILE is a gzip file, reset its embedded timestamp (as with 'gzip
+--no-name') and return true.  Otherwise return #f.  When KEEP-MTIME? is true,
+preserve FILE's modification time."
+  (let ((stat (stat file))
+        (port (open file O_RDWR)))
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        (and (= 4 (seek port 4 SEEK_SET))
+             (put-bytevector port #vu8(0 0 0 0))))
+      (lambda ()
+        (close-port port)
+        (set-file-time file stat)))))
+
 (define-syntax-rule (with-directory-excursion dir body ...)
   "Run BODY with DIR as the process's current directory."
   (let ((init (getcwd)))
@@ -237,6 +263,11 @@ name."
   (mkdir-p directory)
   (copy-file file (string-append directory "/" (basename file))))
 
+(define (make-file-writable file)
+  "Make FILE writable for its owner."
+  (let ((stat (lstat file)))                      ;XXX: symlinks
+    (chmod file (logior #o600 (stat:perms stat)))))
+
 (define* (copy-recursively source destination
                            #:key
                            (log (current-output-port))
@@ -400,10 +431,17 @@ for under the directories designated by FILES.  For example:
               (delete-duplicates input-dirs)))
 
 (define (list->search-path-as-string lst separator)
-  (string-join lst separator))
+  (if separator
+      (string-join lst separator)
+      (match lst
+        ((head rest ...) head)
+        (() ""))))
 
 (define* (search-path-as-string->list path #:optional (separator #\:))
-  (string-tokenize path (char-set-complement (char-set separator))))
+  (if separator
+      (string-tokenize path
+                       (char-set-complement (char-set separator)))
+      (list path)))
 
 (define* (set-path-environment-variable env-var files input-dirs
                                         #:key
diff --git a/guix/packages.scm b/guix/packages.scm
index 4bc4b017f4..61171b8342 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -230,8 +230,11 @@ name of its URI."
   '("i585-gnu" "i686-gnu"))
 
 (define %hydra-supported-systems
-  ;; This is the list of system types for which build slaves are available.
-  %supported-systems)
+  ;; This is the list of system types for which build machines are available.
+  ;;
+  ;; XXX: MIPS is temporarily unavailable on Hydra:
+  ;; <https://lists.gnu.org/archive/html/guix-devel/2017-03/msg00790.html>.
+  (delete "mips64el-linux" %supported-systems))
 
 
 ;; A package.
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 9e5b7f3c75..6be9d00aec 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -667,7 +667,7 @@ processed, #f otherwise."
                                         (_              #f))
                                       opts)
                      (() (list %current-profile))
-                     (lst lst)))
+                     (lst (reverse lst))))
          (profile  (match profiles
                      ((head tail ...) head))))
     (match (assoc-ref opts 'query)
diff --git a/guix/search-paths.scm b/guix/search-paths.scm
index 7a6fe67959..4bf0e44389 100644
--- a/guix/search-paths.scm
+++ b/guix/search-paths.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -55,7 +55,7 @@
   search-path-specification?
   (variable     search-path-specification-variable) ;string
   (files        search-path-specification-files)    ;list of strings
-  (separator    search-path-specification-separator ;string
+  (separator    search-path-specification-separator ;string | #f
                 (default ":"))
   (file-type    search-path-specification-file-type ;symbol
                 (default 'directory))
@@ -131,11 +131,23 @@ like `string-tokenize', but SEPARATOR is a string."
 DIRECTORIES, a list of directory names, and return a list of
 specification/value pairs.  Use GETENV to determine the current settings and
 report only settings not already effective."
-  (define search-path-definition
-    (match-lambda
-      ((and spec
-            ($ <search-path-specification> variable files separator
-                                           type pattern))
+  (define (search-path-definition spec)
+    (match spec
+      (($ <search-path-specification> variable files #f type pattern)
+       ;; Separator is #f so return the first match.
+       (match (with-null-error-port
+               (search-path-as-list files directories
+                                    #:type type
+                                    #:pattern pattern))
+         (()
+          #f)
+         ((head . _)
+          (let ((value (getenv variable)))
+            (if (and value (string=? value head))
+                #f                         ;VARIABLE already set appropriately
+                (cons spec head))))))
+      (($ <search-path-specification> variable files separator
+                                      type pattern)
        (let* ((values (or (and=> (getenv variable)
                                  (cut string-tokenize* <> separator))
                           '()))
@@ -164,7 +176,7 @@ current value), or 'suffix (return the definition where VALUE is added as a
 suffix to VARIABLE's current value.)  In the case of 'prefix and 'suffix,
 SEPARATOR is used as the separator between VARIABLE's current value and its
 prefix/suffix."
-  (match kind
+  (match (if (not separator) 'exact kind)
     ('exact
      (format #f "export ~a=\"~a\"" variable value))
     ('prefix