diff options
author | Ludovic Courtès <ludo@gnu.org> | 2017-04-03 00:13:06 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2017-04-03 00:13:06 +0200 |
commit | 2a0d5de5a9decd785b22dafa69aae5320231f1b7 (patch) | |
tree | 6c532e278025fb46a94f4cb3c3a68063b7011fe1 /guix/build/utils.scm | |
parent | 41f6d18fb6ae7adebe72793c625ad4574991fa6d (diff) | |
parent | 245575eaf33801753ac8290e077c4397b2568540 (diff) | |
download | guix-patches-2a0d5de5a9decd785b22dafa69aae5320231f1b7.tar guix-patches-2a0d5de5a9decd785b22dafa69aae5320231f1b7.tar.gz |
Merge branch 'core-updates'
Diffstat (limited to 'guix/build/utils.scm')
-rw-r--r-- | guix/build/utils.scm | 44 |
1 files changed, 41 insertions, 3 deletions
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 |