[bug#34223] Fixing timestamps in archives.

[Tim Gesthuizen <tim.gesthuizen@yahoo.de>]

[-- Attachment #1: Type: text/plain, Size: 599 bytes --]

Hi Ludo,

Sorry for the delay!

Ludovic Courtès writes:
> In that case though, it probably doesn’t buy us much to use libarchive
> in a separate C program, WDYT?  Should we just stick to the current
> approach that invokes ‘unzip’ and ‘zip’?

This seems to be the best choice.
Maybe we want to reevaluate when there is a proper ZIP-library for
guile.

I have attached patches that isolate repack-archive from the
ant-build-system and use it for pwsafe.
I only builded some java packages so I don't know if something
else might be broken because of the changes.

Tim.


[-- Attachment #2: 0001-guix-Generalize-zip-repacking.patch --]
[-- Type: text/x-patch, Size: 10308 bytes --]

From fe8e4da34a0806d6f444d2fce572a2a39533f0fc Mon Sep 17 00:00:00 2001
From: Tim Gesthuizen <tim.gesthuizen@yahoo.de>
Date: Fri, 1 Mar 2019 23:39:14 +0100
Subject: [PATCH 1/2] guix: Generalize zip repacking

Move repack-archive into an own module and change ant-build-system
and icedtea accordingly.

* Makefile.am: Add archives.scm.
* gnu/packages/java.scm (icedtea-8): Add unzip to the native-inputs.
* guix/build-system/ant.scm (default-unzip): New function.
  (lower): Add unzip parameter and add it to the build-inputs.
* guix/build/ant-build-system.scm (strip-jar-timestamps): Remove
  repack-archive declaration.
* guix/build/archives.scm: New file.
  (repack-archive): New function.
---
 Makefile.am                     |  2 ++
 gnu/packages/java.scm           |  5 ++-
 guix/build-system/ant.scm       | 10 ++++++
 guix/build/ant-build-system.scm | 38 +++-------------------
 guix/build/archives.scm         | 56 +++++++++++++++++++++++++++++++++
 5 files changed, 77 insertions(+), 34 deletions(-)
 create mode 100644 guix/build/archives.scm

diff --git a/Makefile.am b/Makefile.am
index fec9800ce..c6dad9bb5 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -13,6 +13,7 @@
 # Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
 # Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 # Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
+# Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
 #
 # This file is part of GNU Guix.
 #
@@ -153,6 +154,7 @@ MODULES =					\
   guix/build/font-build-system.scm		\
   guix/build/go-build-system.scm		\
   guix/build/asdf-build-system.scm		\
+  guix/build/archives.scm                       \
   guix/build/git.scm				\
   guix/build/hg.scm				\
   guix/build/glib-or-gtk-build-system.scm	\
diff --git a/gnu/packages/java.scm b/gnu/packages/java.scm
index 974756900..fea7d20b7 100644
--- a/gnu/packages/java.scm
+++ b/gnu/packages/java.scm
@@ -10,6 +10,7 @@
 ;;; Copyright © 2018 Gábor Boskovits <boskovits@gmail.com>
 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1549,6 +1550,7 @@ IcedTea build harness.")
        `(#:imported-modules
          ((guix build ant-build-system)
           (guix build syscalls)
+          (guix build archives)
           ,@%gnu-build-system-modules)
          ,@(substitute-keyword-arguments (package-arguments icedtea-7)
              ((#:modules modules)
@@ -1672,7 +1674,8 @@ new Date();"))
                  "0k33anxdzw1icn072wynfmmdjhsv50hay0j1sfkfxny12rb3vgdy"))
          ,@(fold alist-delete (package-native-inputs icedtea-7)
                  '("jdk" "openjdk-src" "corba-drop" "jaxp-drop" "jaxws-drop"
-                   "jdk-drop" "langtools-drop" "hotspot-drop")))))))
+                   "jdk-drop" "langtools-drop" "hotspot-drop"))
+         ("unzip" ,unzip))))))
 
 (define-public openjdk9
   (package
diff --git a/guix/build-system/ant.scm b/guix/build-system/ant.scm
index b5626bd42..e4cd4c1f7 100644
--- a/guix/build-system/ant.scm
+++ b/guix/build-system/ant.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -41,6 +42,7 @@
   `((guix build ant-build-system)
     (guix build java-utils)
     (guix build syscalls)
+    (guix build archives)
     ,@%gnu-build-system-modules))
 
 (define (default-jdk)
@@ -61,11 +63,18 @@
   (let ((zip-mod (resolve-interface '(gnu packages compression))))
     (module-ref zip-mod 'zip)))
 
+(define (default-unzip)
+  "Return the default UNZIP package."
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (let ((zip-mod (resolve-interface '(gnu packages compression))))
+    (module-ref zip-mod 'unzip)))
+
 (define* (lower name
                 #:key source inputs native-inputs outputs system target
                 (jdk (default-jdk))
                 (ant (default-ant))
                 (zip (default-zip))
+                (unzip (default-unzip))
                 #:allow-other-keys
                 #:rest arguments)
   "Return a bag for NAME."
@@ -86,6 +95,7 @@
          (build-inputs `(("jdk" ,jdk "jdk")
                          ("ant" ,ant)
                          ("zip" ,zip)
+                         ("unzip" ,unzip)
                          ,@native-inputs))
          (outputs outputs)
          (build ant-build)
diff --git a/guix/build/ant-build-system.scm b/guix/build/ant-build-system.scm
index d79a2d55e..fbde6fae7 100644
--- a/guix/build/ant-build-system.scm
+++ b/guix/build/ant-build-system.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,6 +21,7 @@
   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
   #:use-module (guix build syscalls)
   #:use-module (guix build utils)
+  #:use-module (guix build archives)
   #:use-module (sxml simple)
   #:use-module (ice-9 match)
   #:use-module (ice-9 ftw)
@@ -185,44 +187,14 @@ dependencies of this jar file."
             outputs)
   #t)
 
-(define* (strip-jar-timestamps #:key outputs
+(define* (strip-jar-timestamps #:key outputs (unzip "unzip") (zip "zip")
                                #:allow-other-keys)
   "Unpack all jar archives, reset the timestamp of all contained files, and
 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))
-
-      ;; 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))
-
   (for-each (match-lambda
               ((output . directory)
-               (for-each repack-archive (find-files directory "\\.jar$"))))
+               (for-each repack-archive
+                         (find-files directory "\\.jar$"))))
             outputs)
   #t)
 
diff --git a/guix/build/archives.scm b/guix/build/archives.scm
new file mode 100644
index 000000000..d2c4815bd
--- /dev/null
+++ b/guix/build/archives.scm
@@ -0,0 +1,56 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (guix build archives)
+  #:use-module (ice-9 format)
+  #:use-module (guix build utils)
+  #:use-module (guix build syscalls)
+  #:export (repack-archive))
+
+(define* (repack-archive archive
+                         #:key (unzip "unzip") (zip "zip"))
+  (format #t "repacking ~a\n" archive)
+  (let* ((dir (mkdtemp! "archive-contents.XXXXXX"))
+         (manifest (string-append dir "/META-INF/MANIFEST.MF")))
+    (with-directory-excursion dir
+      (invoke unzip archive))
+    (delete-file archive)
+    ;; 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))
+
+    ;; The archive 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 "archive".  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 archives we disable compression
+             ;; with the "-0" option.
+             (command (if (file-exists? manifest)
+                          `(,zip "-0" "-X" ,archive ,manifest ,@files)
+                          `(,zip "-0" "-X" ,archive ,@files))))
+        (apply invoke command)))
+    (utime archive 0 0)
+    #t))
-- 
2.20.1


[-- Attachment #3: 0002-gnu-pwsafe-Make-zip-archives-deterministic.patch --]
[-- Type: text/x-patch, Size: 3079 bytes --]

From 0bb0420dfdeb992b3ceafc815d42e6f403520b8d Mon Sep 17 00:00:00 2001
From: Tim Gesthuizen <tim.gesthuizen@yahoo.de>
Date: Sat, 2 Mar 2019 00:10:19 +0100
Subject: [PATCH 2/2] gnu: pwsafe: Make zip archives deterministic

* gnu/packages/password-utils.scm (pwsafe):
  [native-inputs]: Add unzip.
  [arguments]: Add a phase for resetting zip timestamps.
---
 gnu/packages/password-utils.scm | 17 ++++++++++++++---
 1 file changed, 14 insertions(+), 3 deletions(-)

diff --git a/gnu/packages/password-utils.scm b/gnu/packages/password-utils.scm
index 9fd5a6ff0..52870050e 100644
--- a/gnu/packages/password-utils.scm
+++ b/gnu/packages/password-utils.scm
@@ -21,7 +21,7 @@
 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2018 Pierre Neidhardt <mail@ambrevar.xyz>
 ;;; Copyright © 2018 Amirouche Boubekki <amirouche@hypermove.net>
-;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
+;;; Copyright © 2018, 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -190,7 +190,8 @@ algorithms AES or Twofish.")
     (build-system cmake-build-system)
     (native-inputs `(("gettext" ,gettext-minimal)
                      ("perl" ,perl)
-                     ("zip" ,zip)))
+                     ("zip" ,zip)
+                     ("unzip" ,unzip)))
     (inputs `(("curl" ,curl)
               ("file" ,file)
               ("gtest" ,googletest)
@@ -201,7 +202,10 @@ algorithms AES or Twofish.")
               ("qrencode" ,qrencode)
               ("wxwidgets" ,wxwidgets)
               ("xerces-c" ,xerces-c)))
-    (arguments '(#:configure-flags (list "-DNO_GTEST=YES")
+    (arguments `(#:configure-flags (list "-DNO_GTEST=YES")
+                 #:imported-modules ((guix build syscalls)
+                                     (guix build archives)
+                                     ,@%cmake-build-system-modules)
                  #:phases (modify-phases %standard-phases
                             (add-after 'unpack 'add-gtest
                               (lambda* (#:key inputs #:allow-other-keys)
@@ -219,6 +223,13 @@ add_subdirectory(src/test)\n" cmake-port)
                                   (("/usr/bin/file")
                                    (string-append (assoc-ref inputs "file")
                                                   "/bin/file")))
+                                #t))
+                            (add-after 'install 'repack-archives
+                              (lambda* (#:key outputs #:allow-other-keys)
+                                (use-modules ((guix build archives)))
+                                (for-each repack-archive
+                                          (find-files (assoc-ref outputs "out")
+                                                      "\\.zip$"))
                                 #t)))))
     (synopsis "Password safe with automatic input and key generation")
     (description "pwsafe is a password manager originally designed by Bruce
-- 
2.20.1