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:
parent
0363474a0b
commit
95e7be9728
@ -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)))
|
||||
|
Loading…
Reference in New Issue
Block a user