From 95e7be97282f136190d7007f34d355a9691a16fa Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 26 Jan 2017 21:58:37 +0100 Subject: utils: Add 'gzip-file?' and 'reset-gzip-timestamp'. * guix/build/utils.scm (%gzip-magic-bytes): New variable. (gzip-file?, reset-gzip-timestamp): New procedures. --- guix/build/utils.scm | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) (limited to 'guix/build') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index cf09326393..9e9ac90050 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -45,6 +45,8 @@ call-with-ascii-input-file elf-file? ar-file? + gzip-file? + reset-gzip-timestamp with-directory-excursion mkdir-p install-file @@ -195,6 +197,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))) -- cgit v1.2.3