utils: Add 'gzip-file?' and 'reset-gzip-timestamp'.

* guix/build/utils.scm (%gzip-magic-bytes): New variable.
(gzip-file?, reset-gzip-timestamp): New procedures.
This commit is contained in:
Ludovic Courtès 2017-01-26 21:58:37 +01:00
parent 0363474a0b
commit 95e7be9728
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5

@ -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)))