From: "Miguel Ángel Arruga Vivas" <rosen644835@gmail.com>
To: Julien Lepiller <julien@lepiller.eu>
Cc: 45675@debbugs.gnu.org
Subject: bug#45675: Zip-based archives store timestamps
Date: Wed, 06 Jan 2021 23:34:01 +0100 [thread overview]
Message-ID: <87a6tl1yqu.fsf@gmail.com> (raw)
In-Reply-To: <A31236B2-CEEC-4E96-89B8-29CB40147E2C@lepiller.eu> (Julien Lepiller's message of "Tue, 05 Jan 2021 10:17:53 -0500")
[-- Attachment #1: Type: text/plain, Size: 389 bytes --]
Hi,
Julien Lepiller <julien@lepiller.eu> 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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: wip.patch --]
[-- Type: text/x-patch, Size: 11032 bytes --]
From dd2e78badad805cff8be940411994533aed8b059 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miguel=20=C3=81ngel=20Arruga=20Vivas?=
<rosen644835@gmail.com>
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
next prev parent reply other threads:[~2021-01-06 22:35 UTC|newest]
Thread overview: 4+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-01-05 13:10 bug#45675: Zip-based archives store timestamps Miguel Ángel Arruga Vivas
2021-01-05 15:17 ` Julien Lepiller
2021-01-06 22:34 ` Miguel Ángel Arruga Vivas [this message]
2021-01-06 23:10 ` Julien Lepiller
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87a6tl1yqu.fsf@gmail.com \
--to=rosen644835@gmail.com \
--cc=45675@debbugs.gnu.org \
--cc=julien@lepiller.eu \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).