amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

docker: Build tarballs reproducibly.

Browse source 
Fixes <https://issues.guix.gnu.org/75090>.

* guix/docker.scm (tar): New procedure.
(create-empty-tar, build-docker-image): Use it instead of calling
‘invoke’ directly.

Reported-by: Simon Josefsson <simon@josefsson.org>
Change-Id: Ia899c43ed6a3809ff845de0953e3d38cccf24609
This commit is contained in:
Ludovic Courtès 2025-01-07 23:52:17 +01:00
parent 35c6ae6e58
commit 646202bf73
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 16 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

25
guix/docker.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017-2019, 2021, 2025 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com>
@ -171,8 +171,15 @@ Return a version of TAG that follows these rules."
(1- items-length))))) (1- items-length)))))
(list head tail))) (list head tail)))
(define (tar . arguments)
"Invoke 'tar' with the given ARGUMENTS together with options to build
tarballs in a reproducible fashion."
(apply invoke "tar" "--mtime=@1"
"--owner=0" "--group=0" "--numeric-owner"
"--sort=name" "--mode=go+u,go-w" arguments))
(define (create-empty-tar file) (define (create-empty-tar file)
(invoke "tar" "-cf" file "--files-from" "/dev/null")) (tar "-cf" file "--files-from" "/dev/null"))
(define* (build-docker-image image paths prefix (define* (build-docker-image image paths prefix
#:key #:key
@ -256,7 +263,7 @@ added to image as a layer."
(file-name (string-append file-hash "/layer.tar"))) (file-name (string-append file-hash "/layer.tar")))
(mkdir file-hash) (mkdir file-hash)
(rename-file "layer.tar" file-name) (rename-file "layer.tar" file-name)
(invoke "tar" "-rf" "image.tar" file-name) (tar "-rf" "image.tar" file-name)
(delete-file file-name) (delete-file file-name)
file-hash)) file-hash))
(define layers-hashes (define layers-hashes
@ -269,20 +276,20 @@ added to image as a layer."
(let* ((head-layers (let* ((head-layers
(map (map
(lambda (file) (lambda (file)
(invoke "tar" "cf" "layer.tar" file) (tar "cf" "layer.tar" file)
(seal-layer)) (seal-layer))
head)) head))
(tail-layer (tail-layer
(begin (begin
(create-empty-tar "layer.tar") (create-empty-tar "layer.tar")
(for-each (lambda (file) (for-each (lambda (file)
(invoke "tar" "-rf" "layer.tar" file)) (tar "-rf" "layer.tar" file))
tail) tail)
(let* ((file-hash (layer-diff-id "layer.tar")) (let* ((file-hash (layer-diff-id "layer.tar"))
(file-name (string-append file-hash "/layer.tar"))) (file-name (string-append file-hash "/layer.tar")))
(mkdir file-hash) (mkdir file-hash)
(rename-file "layer.tar" file-name) (rename-file "layer.tar" file-name)
(invoke "tar" "-rf" "image.tar" file-name) (tar "-rf" "image.tar" file-name)
(delete-file file-name) (delete-file file-name)
file-hash))) file-hash)))
(customization-layer (customization-layer
@ -291,7 +298,7 @@ added to image as a layer."
(file-name (string-append file-hash "/layer.tar"))) (file-name (string-append file-hash "/layer.tar")))
(mkdir file-hash) (mkdir file-hash)
(rename-file file-id file-name) (rename-file file-id file-name)
(invoke "tar" "-rf" "image.tar" file-name) (tar "-rf" "image.tar" file-name)
file-hash)) file-hash))
(all-layers (all-layers
(append head-layers (list tail-layer customization-layer)))) (append head-layers (list tail-layer customization-layer))))
@ -301,7 +308,7 @@ added to image as a layer."
(map (cut string-append <> "/layer.tar") (map (cut string-append <> "/layer.tar")
all-layers) all-layers)
repository)))) repository))))
(invoke "tar" "-rf" "image.tar" "manifest.json") (tar "-rf" "image.tar" "manifest.json")
all-layers)))) all-layers))))
(let* ((directory "/tmp/docker-image") ;temporary working directory (let* ((directory "/tmp/docker-image") ;temporary working directory
(id (docker-id prefix)) (id (docker-id prefix))
@ -390,7 +397,7 @@ added to image as a layer."
#:entry-point entry-point)))) #:entry-point entry-point))))
(if max-layers (if max-layers
(begin (begin
(invoke "tar" "-rf" "image.tar" "config.json") (tar "-rf" "image.tar" "config.json")
(if compressor (if compressor
(begin (begin
(apply invoke `(,@compressor "image.tar")) (apply invoke `(,@compressor "image.tar"))