Subject: Re: bug#45675: Zip-based archives store timestamps

From: Miguel Ángel Arruga Vivas <[email-masked]>
Date: Wed, 06 Jan 2021 23:34:01 +0100

Hi,

Julien Lepiller <[email-masked]> writes:

> For java packages, we have a strip-jar-timestamps phase in the ant-build-system.

Thanks for the pointer.  Do you think could be worth to extract that
into (guix build utils) as the attached patch (WIP) does?  It rebuilds
the world and replaces all of "old usages", so I'm still waiting to
reach ant-bootstrap...

Happy hacking!
Miguel
>From dd2e78badad805cff8be940411994533aed8b059 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miguel=20=C3=81ngel=20Arruga=20Vivas?=
 <[email-masked]>
Date: Wed, 6 Jan 2021 23:29:36 +0100
Subject: [PATCH] wip-build-utils: Extract reset-zip-timestamp and use it
 everywhere.

---
 gnu/packages/java.scm           | 73 ++++++++-------------------------
 guix/build/ant-build-system.scm | 32 ++++-----------
 guix/build/utils.scm            | 48 ++++++++++++++++++++++
 3 files changed, 73 insertions(+), 80 deletions(-)

diff --git a/gnu/packages/java.scm b/gnu/packages/java.scm
index 758f8f1859..82d18bf62a 100644
--- a/gnu/packages/java.scm
+++ b/gnu/packages/java.scm
@@ -411,28 +411,11 @@ JNI.")
          (add-after 'build 'strip-jar-timestamps ;based on ant-build-system
            (lambda* (#:key outputs #:allow-other-keys)
              (define (repack-archive jar)
-               (let* ((dir (mkdtemp! "jar-contents.XXXXXX"))
-                      (manifest (string-append dir "/META-INF/MANIFESTS.MF")))
-                 (with-directory-excursion dir
-                   (invoke "unzip" jar))
-                 (delete-file jar)
-                 ;; XXX: copied from (gnu build install)
-                 (for-each (lambda (file)
-                             (let ((s (lstat file)))
-                               (unless (eq? (stat:type s) 'symlink)
-                                 (utime file  0 0 0 0))))
-                           (find-files dir #:directories? #t))
-                 ;; It is important that the manifest appears first.
-                 (with-directory-excursion dir
-                   (let* ((files (find-files "." ".*" #:directories? #t))
-                          ;; To ensure that the reference scanner can
-                          ;; detect all store references in the jars
-                          ;; we disable compression with the "-0" option.
-                          (command (if (file-exists? manifest)
-                                       `("zip" "-0" "-X" ,jar ,manifest
-                                         ,@files)
-                                       `("zip" "-0" "-X" ,jar ,@files))))
-                     (apply invoke command)))))
+               (let ((mktempdir (lambda ()
+                                  (mkdtemp! "jar-contents.XXXXXX"))))
+                 (reset-zip-timestamp jar mktempdir
+                                      #:first-file "/META-INF/MANIFEST.MF"
+                                      #:compression-level "-0")))
              (for-each repack-archive
                     (find-files
                      (string-append (assoc-ref %outputs "out") "/lib")
@@ -1962,21 +1945,10 @@ new Date();"))
          (add-after 'install 'strip-zip-timestamps
            (lambda* (#:key outputs #:allow-other-keys)
              (use-modules (guix build syscalls))
-             (for-each (lambda (zip)
-                         (let ((dir (mkdtemp! "zip-contents.XXXXXX")))
-                           (with-directory-excursion dir
-                             (invoke "unzip" zip))
-                           (delete-file zip)
-                           (for-each (lambda (file)
-                                       (let ((s (lstat file)))
-                                         (unless (eq? (stat:type s) 'symlink)
-                                           (format #t "reset ~a~%" file)
-                                           (utime file 0 0 0 0))))
-                             (find-files dir #:directories? #t))
-                           (with-directory-excursion dir
-                             (let ((files (find-files "." ".*" #:directories? #t)))
-                               (apply invoke "zip" "-0" "-X" zip files)))))
-               (find-files (assoc-ref outputs "doc") ".*.zip$"))
+             (let ((mktempdir (lambda () (mkdtemp! "zip-contents.XXXXXX"))))
+               (for-each (lambda (zip)
+                           (reset-zip-timestamp zip mktempdir))
+                        (find-files (assoc-ref outputs "doc") ".*.zip$")))
              #t)))))
     (inputs
      `(("alsa-lib" ,alsa-lib)
@@ -2197,25 +2169,14 @@ new Date();"))
              (use-modules (guix build syscalls)
                           (ice-9 binary-ports)
                           (rnrs bytevectors))
-             (letrec ((repack-archive
-                    (lambda (archive)
-                      (let ((dir (mkdtemp! "zip-contents.XXXXXX")))
-                        (with-directory-excursion dir
-                          (invoke "unzip" archive))
-                        (delete-file archive)
-                        (for-each (compose repack-archive canonicalize-path)
-                                  (find-files dir "(ct.sym|.*.jar)$"))
-                        (let ((reset-file-timestamp
-                               (lambda (file)
-                                 (let ((s (lstat file)))
-                                   (unless (eq? (stat:type s) 'symlink)
-                                     (format #t "reset ~a~%" file)
-                                     (utime file 0 0 0 0))))))
-                          (for-each reset-file-timestamp
-                                    (find-files dir #:directories? #t)))
-                        (with-directory-excursion dir
-                          (let ((files (find-files "." ".*" #:directories? #t)))
-                            (apply invoke "zip" "-0" "-X" archive files)))))))
+             (let* ((mktempdir (lambda ()
+                                 (mkdtemp! "zip-contents.XXXXXX")))
+                    (repack-archive
+                     (lambda (archive)
+                       (reset-zip-timestamp archive mktempdir
+                                            #:compression-level "-0"
+                                            #:recursion-regexp
+                                            "(ct.sym|.*.jar)$"))))
                (for-each repack-archive
                          (find-files (assoc-ref outputs "doc") ".*.zip$"))
                (for-each repack-archive
diff --git a/guix/build/ant-build-system.scm b/guix/build/ant-build-system.scm
index fae1b47ec5..d6c8b71abc 100644
--- a/guix/build/ant-build-system.scm
+++ b/guix/build/ant-build-system.scm
@@ -201,35 +201,19 @@ dependencies of this jar file."
 repack them.  This is necessary to ensure that archives are reproducible."
   (define (repack-archive jar)
     (format #t "repacking ~a\n" jar)
-    (let* ((dir (mkdtemp! "jar-contents.XXXXXX"))
-           (manifest (string-append dir "/META-INF/MANIFEST.MF")))
-      (with-directory-excursion dir
-        (invoke "jar" "xf" jar))
-      (delete-file jar)
-      ;; XXX: copied from (gnu build install)
-      (for-each (lambda (file)
-                  (let ((s (lstat file)))
-                    (unless (eq? (stat:type s) 'symlink)
-                      (utime file 0 0 0 0))))
-                (find-files dir #:directories? #t))
-
+    (let ((manifest "/META-INF/MANIFEST.MF")
+          (mktmpdir (lambda () (mkdtemp! "jar-contents.XXXXXX"))))
       ;; The jar tool will always set the timestamp on the manifest file
       ;; and the containing directory to the current time, even when we
       ;; reuse an existing manifest file.  To avoid this we use "zip"
       ;; instead of "jar".  It is important that the manifest appears
       ;; first.
-      (with-directory-excursion dir
-        (let* ((files (find-files "." ".*" #:directories? #t))
-               ;; To ensure that the reference scanner can detect all
-               ;; store references in the jars we disable compression
-               ;; with the "-0" option.
-               (command (if (file-exists? manifest)
-                            `("zip" "-0" "-X" ,jar ,manifest ,@files)
-                            `("zip" "-0" "-X" ,jar ,@files))))
-          (apply invoke command)))
-      (utime jar 0 0)
-      #t))
-
+      (reset-zip-timestamp jar mktmpdir
+                           #:first-file manifest
+                           ;; To ensure that the reference scanner can detect
+                           ;; all store references in the jars we disable
+                           ;; compression with the "-0" option.
+                           #:compression-level "-0")))
   (for-each (match-lambda
               ((output . directory)
                (for-each repack-archive
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 419c10195b..3f82d87732 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -56,7 +56,9 @@
             elf-file?
             ar-file?
             gzip-file?
+            zip-file?
             reset-gzip-timestamp
+            reset-zip-timestamp
             with-directory-excursion
             mkdir-p
             install-file
@@ -282,6 +284,52 @@ preserve FILE's modification time."
      (lambda ()
        (chdir init)))))
 
+(define %zip-magic-bytes
+  ;; Magic bytes of zip file.  Beware, it's a small header so there could be
+  ;; false positives.
+  #vu8(#x50 #x4b))
+
+(define zip-file?
+  (file-header-match %zip-magic-bytes))
+
+(define* (reset-zip-timestamp zip-file tmp-dir-generator
+                              #:key (first-file #f)
+                              (compression-level "-6")
+                              (recursion-regexp #f))
+  "Reset the timestamps inside ZIP-FILE, regenerating it with the
+COMPRESSION-LEVEL provided, and optionally placing FIRST-FILE at the
+beginning of the archive when it exists.
+
+TMP-DIR-GENERATOR must return a different directory each time it is called
+when RECURSION-REGEXP is provided."
+  (let* ((dir (tmp-dir-generator))
+         (first-file (string-append dir first-file)))
+    (with-directory-excursion dir
+      (invoke "unzip" zip-file))
+    (delete-file zip-file)
+    (when recursion-regexp
+      (for-each (lambda (file)
+                  (reset-zip-timestamp (canonicalize-path file)
+                                       tmp-dir-generator
+                                       #:first-file first-file
+                                       #:compression-level compression-level
+                                       #:recursion-regexp recursion-regexp))
+                (find-files dir recursion-regexp)))
+    (for-each (lambda (file)
+                (let ((s (lstat file)))
+                  (unless (eq? (stat:type s) 'symlink)
+                    (utime file 0 0 0 0))))
+              (find-files dir #:directories? #t))
+
+    (with-directory-excursion dir
+      (let* ((files (find-files "." ".*" #:directories? #t))
+             (call-zip `("zip" ,compression-level "-X" ,zip-file))
+             (command (if (file-exists? first-file)
+                          `(,@call-zip ,first-file ,@files)
+                          `(,@call-zip ,@files))))
+        (apply invoke command)))
+    (utime zip-file 0 0)))
+
 (define (mkdir-p dir)
   "Create directory DIR and all its ancestors."
   (define absolute?
-- 
2.30.0