summaryrefslogtreecommitdiff
path: root/guix/build
diff options
context:
space:
mode:
Diffstat (limited to 'guix/build')
-rw-r--r--guix/build/gnu-build-system.scm34
-rw-r--r--guix/build/perl-build-system.scm6
-rw-r--r--guix/build/profiles.scm24
-rw-r--r--guix/build/utils.scm44
4 files changed, 90 insertions, 18 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/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