summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
Diffstat (limited to 'guix')
-rw-r--r--guix/build/gnu-build-system.scm34
-rw-r--r--guix/build/make-bootstrap.scm2
-rw-r--r--guix/build/perl-build-system.scm6
-rw-r--r--guix/build/profiles.scm24
-rw-r--r--guix/build/utils.scm44
-rw-r--r--guix/scripts/package.scm2
-rw-r--r--guix/search-paths.scm28
7 files changed, 112 insertions, 28 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/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
generated by cgit v1.2.3 (git 2.46.2) at 2024-11-11 23:22:01 +0000