diff options
| -rw-r--r-- | guix/build/utils.scm | 25 |
1 files changed, 25 insertions, 0 deletions
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))) |