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

[Ludovic Courtès]

civodul pushed a commit to branch core-updates
in repository guix.

commit 95e7be97282f136190d7007f34d355a9691a16fa
Author: Ludovic Courtès <address@hidden>
Date:   Thu Jan 26 21:58:37 2017 +0100

    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(+)

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index cf09326..9e9ac90 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)))