diff options
Diffstat (limited to 'guix/build')
| -rw-r--r-- | guix/build/pack.scm | 111 |
1 files changed, 109 insertions, 2 deletions
diff --git a/guix/build/pack.scm b/guix/build/pack.scm index 3b73d1b227..fcb1da2a6c 100644 --- a/guix/build/pack.scm +++ b/guix/build/pack.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2021, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,8 +17,25 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix build pack) + #:use-module (gnu build install) #:use-module (guix build utils) - #:export (tar-base-options)) + #:use-module (guix build store-copy) + #:use-module ((guix build union) #:select (relative-file-name)) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (tar-base-options + populate-profile-root + build-self-contained-tarball)) + +;;; Commentary: + +;;; This module contains build-side common procedures used by the host-side +;;; (guix scripts pack) module, mostly to allow for code reuse. Due to making +;;; use of the (guix build store-copy) module, it transitively requires the +;;; sqlite and gcrypt extensions to be available. + +;;; Code: (define* (tar-base-options #:key tar compressor) "Return the base GNU tar options required to produce deterministic archives @@ -52,3 +69,93 @@ the `-I' option." ;; process. Use '--hard-dereference' to eliminate it. "--hard-dereference" "--check-links")) + +(define (assert-utf8-locale) + "Verify the current process is using the en_US.utf8 locale." + (unless (string=? "unset for tests" (getenv "GUIX_LOCPATH")) + (unless (false-if-exception (setlocale LC_ALL "en_US.utf8")) + (error "environment not configured for en_US.utf8 locale")))) + +(define* (populate-profile-root profile + #:key (profile-name "guix-profile") + localstatedir? + store-database + deduplicate? + (symlinks '())) + "Populate the root profile directory with SYMLINKS and a Guix database, when +LOCALSTATEDIR? is set, and a pre-computed STORE-DATABASE is provided. The +directory is created as \"root\" in the current working directory. When +DEDUPLICATE? is true, deduplicate the store items, which relies on hard +links. It needs to run in an environment where " + (define symlink->directives + ;; Return "populate directives" to make the given symlink and its + ;; parent directories. + (match-lambda + ((source '-> target) + (let ((target (string-append profile "/" target)) + (parent (dirname source))) + ;; Never add a 'directory' directive for "/" so as to + ;; preserve its ownership when extracting the archive (see + ;; below), and also because this would lead to adding the + ;; same entries twice in the tarball. + `(,@(if (string=? parent "/") + '() + `((directory ,parent))) + ;; Use a relative file name for compatibility with + ;; relocatable packs. + (,source -> ,(relative-file-name parent target))))))) + + (define directives + ;; Fully-qualified symlinks. + (append-map symlink->directives symlinks)) + + (define %root "root") + + (when localstatedir? + (unless store-database + (error "missing STORE-DATABASE argument"))) + + (assert-utf8-locale) + + ;; Note: there is not much to gain here with deduplication and there + ;; is the overhead of the '.links' directory, so turn it off by + ;; default. Furthermore GNU tar < 1.30 sometimes fails to extract + ;; tarballs with hard links: + ;; <http://lists.gnu.org/archive/html/bug-tar/2017-11/msg00009.html>. + (populate-store (list "profile") %root #:deduplicate? deduplicate?) + + (when localstatedir? + (install-database-and-gc-roots %root store-database + profile #:profile-name profile-name)) + + ;; Create SYMLINKS. + (for-each (cut evaluate-populate-directive <> %root) directives)) + +(define* (build-self-contained-tarball profile + tarball-file-name + #:key (profile-name "guix-profile") + localstatedir? + store-database + deduplicate? + symlinks + compressor-command) + "Create a self-contained tarball TARBALL-FILE-NAME from PROFILE, optionally +compressing it with COMPRESSOR-COMMAND, the complete command-line string to +use for the compressor." + (populate-profile-root profile + #:profile-name profile-name + #:localstatedir? localstatedir? + #:store-database store-database + #:deduplicate? deduplicate? + #:symlinks symlinks) + + (assert-utf8-locale) + + ;; GNU Tar recurses directories by default. Simply add the whole root + ;; directory, which contains all the files to be archived. This avoids + ;; creating duplicate files in the archives that would be stored as hard + ;; links by GNU Tar. + (apply invoke "tar" "-cvf" tarball-file-name "-C" "root" "." + (tar-base-options + #:tar "tar" + #:compressor compressor-command))) |