From patchwork Fri Feb 17 01:49:33 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 47028 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 7DCC716952; Fri, 17 Feb 2023 01:52:04 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_INVALID,DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 7AC1B1693E for ; Fri, 17 Feb 2023 01:52:03 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pSpu5-0007jG-DV; Thu, 16 Feb 2023 20:51:13 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pSptv-0007eF-U5 for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pSptv-0004NZ-MP for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pSptv-0007VW-G8 for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#61255] [PATCH v2 4/8] pack: Extract populate-profile-root from self-contained-tarball/builder. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 17 Feb 2023 01:51:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 61255 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 61255@debbugs.gnu.org Cc: Josselin Poiret , Tobias Geerinckx-Rice , Maxim Cournoyer , Simon Tournier , Mathieu Othacehe , ludo@gnu.org, Christopher Baines , Ricardo Wurmus Received: via spool by 61255-submit@debbugs.gnu.org id=B61255.167659862228738 (code B ref 61255); Fri, 17 Feb 2023 01:51:03 +0000 Received: (at 61255) by debbugs.gnu.org; 17 Feb 2023 01:50:22 +0000 Received: from localhost ([127.0.0.1]:38079 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pSptF-0007TR-Tv for submit@debbugs.gnu.org; Thu, 16 Feb 2023 20:50:22 -0500 Received: from mail-qt1-f179.google.com ([209.85.160.179]:36646) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pSptB-0007SL-OK for 61255@debbugs.gnu.org; Thu, 16 Feb 2023 20:50:18 -0500 Received: by mail-qt1-f179.google.com with SMTP id t16so1643382qto.3 for <61255@debbugs.gnu.org>; Thu, 16 Feb 2023 17:50:17 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=8VLxJVE57sZmOJ+oUoHvH7thL7kwQUzlNFV9XRValZs=; b=GcixnO65hnGgz2J6PisOryWe/i22YkpB9tLl66cqAL01RWsnierEfCvCG7f92hpKvj 3kOQq+yKJTv9M5vLehTO5I/Uqc1kgTrVetJfmSnz18OIihkFbAabaC8zzPnNLAERBjVc 8Hzdr+FZfZSB9FccD7JUQl5tSC4xjj8HmBC8Ya2+BQSmLIMqEsRiH/CTq0peSurExkfi R2Brfy00n9iolWKOLJRF7Tny/8KPBDWKxBttEiyPfM+4gBInhiD/ge9f78fUR10cKWM7 5jgyEhubL2S8cDTM3GiFutecCKGQhtRtPZUgrq9s84zI26Y4VE5rue4xS7Uz0GaxXcpz wqsg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=8VLxJVE57sZmOJ+oUoHvH7thL7kwQUzlNFV9XRValZs=; b=VUIbxYYenknsmMZlwgotD+npGqHB9Kp2BAzjcmNqSrVhDH70GSNXWL+YCAGYFe8eG5 Yle9q3OplmtfAqq5W89JExkG6qYS278ygW3pzixDuylA7ZLetkHp6EU6vmZCJGke37HU 8/zqMrBocSjGBbVcqko5bArjM8PQAAnH0d2hxnLBZ7kKNA+Zb5nd62joVLaj/Wh5xf90 UZnvc7aWIzykbEO9sKJcGY10MfH1Ilow2OlUh74+a8QCuquyOFmZrNWx2RvF7N2lXSpN n4EYd0kK+ttQ6LyoPQJDjaqOfYZuErzsPrVkSqQQ/1YQscziBXCaJ7oybrIbZ/2iUlXB 2FWQ== X-Gm-Message-State: AO0yUKX4RUPDBrLLQSIn3QZnykc/3C5G75rSnM78o1yzowKLXWEV1p9L Av89azvNrv4Vv0xVGOdi/HCOUDWnwv/QZjAO X-Google-Smtp-Source: AK7set8FQlg32saswZBu/Nb+dsKTtyR2ps28au2UbFRv3bEyNNxeERwOQkPWR0UZzbzuMNgRzjUzyw== X-Received: by 2002:ac8:57cf:0:b0:3ac:fba0:cde with SMTP id w15-20020ac857cf000000b003acfba00cdemr12581276qta.22.1676598612100; Thu, 16 Feb 2023 17:50:12 -0800 (PST) Received: from localhost.localdomain (dsl-152-188.b2b2c.ca. [66.158.152.188]) by smtp.gmail.com with ESMTPSA id g66-20020a37b645000000b0073b425f6e33sm2316242qkf.100.2023.02.16.17.50.11 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 16 Feb 2023 17:50:11 -0800 (PST) From: Maxim Cournoyer Date: Fri, 17 Feb 2023 02:49:33 +0100 Message-Id: <20230217014938.20919-5-maxim.cournoyer@gmail.com> X-Mailer: git-send-email 2.39.1 In-Reply-To: <20230217014938.20919-1-maxim.cournoyer@gmail.com> References: <20230217014938.20919-1-maxim.cournoyer@gmail.com> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches This allows more code to be reused between the various archive writers. * guix/scripts/pack.scm (set-utf8-locale): New top-level procedure, extracted from... (populate-profile-root): New procedure, extracted from... (self-contained-tarball/builder): ... here. Add #:target argument. Call populate-profile-root. [LOCALSTATEDIR?]: Set db.sqlite file permissions. (self-contained-tarball): Call self-contained-tarball/builder with the TARGET argument, and set #:local-build? to #f for the gexp-derivation call. Remove now extraneous #:target and #:references-graphs arguments from the gexp->derivation call. (debian-archive): Call self-contained-tarball/builder with the #:target argument. Fix indentation. Remove now extraneous #:target and #:references-graphs arguments from the gexp->derivation call. --- (no changes since v1) guix/scripts/pack.scm | 230 ++++++++++++++++++++++++------------------ 1 file changed, 134 insertions(+), 96 deletions(-) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index e552cb108a..77425e5b0f 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -194,104 +194,144 @@ (define (symlink-spec-option-parser opt name arg result) (leave (G_ "~a: invalid symlink specification~%") arg)))) - -;;; -;;; Tarball format. -;;; -(define* (self-contained-tarball/builder profile - #:key (profile-name "guix-profile") - (compressor (first %compressors)) - localstatedir? - (symlinks '()) - (archiver tar) - (extra-options '())) - "Return the G-Expression of the builder used for self-contained-tarball." +(define (set-utf8-locale profile) + "Configure the environment to use the \"en_US.utf8\" locale provided by the +GLIBC-UT8-LOCALES package." + ;; Arrange to not depend on 'glibc-utf8-locales' when using '--bootstrap'. + (and (or (not (profile? profile)) + (profile-locales? profile)) + #~(begin + (setenv "GUIX_LOCPATH" + #+(file-append glibc-utf8-locales "/lib/locale")) + (setlocale LC_ALL "en_US.utf8")))) + +(define* (populate-profile-root profile + #:key (profile-name "guix-profile") + target + localstatedir? + deduplicate? + (symlinks '())) + "Populate the root profile directory with SYMLINKS and a Guix database, when +LOCALSTATEDIR? is set. When DEDUPLICATE? is true, deduplicate the store +items, which relies on hard links." (define database (and localstatedir? (file-append (store-database (list profile)) "/db/db.sqlite"))) - (define set-utf8-locale - ;; Arrange to not depend on 'glibc-utf8-locales' when using '--bootstrap'. - (and (or (not (profile? profile)) - (profile-locales? profile)) - #~(begin - (setenv "GUIX_LOCPATH" - #+(file-append glibc-utf8-locales "/lib/locale")) - (setlocale LC_ALL "en_US.utf8")))) - (define (import-module? module) ;; Since we don't use deduplication support in 'populate-store', don't ;; import (guix store deduplication) and its dependencies, which includes - ;; Guile-Gcrypt. That way we can run tests with '--bootstrap'. + ;; Guile-Gcrypt, unless DEDUPLICATE? is #t. This makes it possible to run + ;; tests with '--bootstrap'. (and (not-config? module) - (not (equal? '(guix store deduplication) module)))) - - (with-imported-modules (source-module-closure - `((guix build pack) - (guix build store-copy) - (guix build utils) - (guix build union) - (gnu build install)) - #:select? import-module?) + (or deduplicate? (not (equal? '(guix store deduplication) module))))) + + (computed-file "profile-directory" + (with-imported-modules (source-module-closure + `((guix build pack) + (guix build store-copy) + (guix build utils) + (guix build union) + (gnu build install)) + #:select? import-module?) + #~(begin + (use-modules (guix build pack) + (guix build store-copy) + (guix build utils) + ((guix build union) #:select (relative-file-name)) + (gnu build install) + (srfi srfi-1) + (srfi srfi-26) + (ice-9 match)) + + (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)) + + ;; Make sure non-ASCII file names are properly handled. + #+(set-utf8-locale profile) + + ;; 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: + ;; . + (populate-store (list "profile") #$output + #:deduplicate? #$deduplicate?) + + (when #+localstatedir? + (install-database-and-gc-roots #$output #+database #$profile + #:profile-name #$profile-name)) + + ;; Create SYMLINKS. + (for-each (cut evaluate-populate-directive <> #$output) + directives))) + #:local-build? #f + #:options (list #:references-graphs `(("profile" ,profile)) + #:target target))) + + +;;; +;;; Tarball format. +;;; +(define* (self-contained-tarball/builder profile + #:key (profile-name "guix-profile") + target + localstatedir? + deduplicate? + symlinks + compressor + archiver) + "Return a GEXP that can build a self-contained tarball." + + (define root (populate-profile-root profile + #:profile-name profile-name + #:target target + #:localstatedir? localstatedir? + #:deduplicate? deduplicate? + #:symlinks symlinks)) + + (with-imported-modules (source-module-closure '((guix build pack) + (guix build utils))) #~(begin (use-modules (guix build pack) - (guix build store-copy) - (guix build utils) - ((guix build union) #:select (relative-file-name)) - (gnu build install) - (srfi srfi-1) - (srfi srfi-26) - (ice-9 match)) - - (define %root "root") - - (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)) + (guix build utils)) ;; Make sure non-ASCII file names are properly handled. - #+set-utf8-locale + #+(set-utf8-locale profile) (define tar #+(file-append archiver "/bin/tar")) - ;; Note: there is not much to gain here with deduplication and there - ;; is the overhead of the '.links' directory, so turn it off. - ;; Furthermore GNU tar < 1.30 sometimes fails to extract tarballs - ;; with hard links: - ;; . - (populate-store (list "profile") %root #:deduplicate? #f) - - (when #+localstatedir? - (install-database-and-gc-roots %root #+database #$profile - #:profile-name #$profile-name)) + (define %root (if #$localstatedir? "." #$root)) - ;; Create SYMLINKS. - (for-each (cut evaluate-populate-directive <> %root) - directives) + (when #$localstatedir? + ;; Fix the permission of the Guix database file, which was made + ;; read-only when copied to the store in populate-profile-root. + (copy-recursively #$root %root) + (chmod (string-append %root "/var/guix/db/db.sqlite") #o644)) - ;; Create the tarball. (with-directory-excursion %root ;; GNU Tar recurses directories by default. Simply add the whole - ;; current directory, which contains all the generated files so far. + ;; current 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" #$output "." @@ -320,17 +360,16 @@ (define* (self-contained-tarball name profile (warning (G_ "entry point not supported in the '~a' format~%") 'tarball)) - (gexp->derivation - (string-append name ".tar" - (compressor-extension compressor)) - (self-contained-tarball/builder profile - #:profile-name profile-name - #:compressor compressor - #:localstatedir? localstatedir? - #:symlinks symlinks - #:archiver archiver) - #:target target - #:references-graphs `(("profile" ,profile)))) + (gexp->derivation (string-append name ".tar" + (compressor-extension compressor)) + (self-contained-tarball/builder profile + #:profile-name profile-name + #:target target + #:localstatedir? localstatedir? + #:deduplicate? deduplicate? + #:symlinks symlinks + #:compressor compressor + #:archiver archiver))) ;;; @@ -676,13 +715,15 @@ (define %valid-compressors '("gzip" "xz" "none")) 'deb)) (define data-tarball - (computed-file (string-append "data.tar" - (compressor-extension compressor)) + (computed-file (string-append "data.tar" (compressor-extension + compressor)) (self-contained-tarball/builder profile + #:target target #:profile-name profile-name - #:compressor compressor #:localstatedir? localstatedir? + #:deduplicate? deduplicate? #:symlinks symlinks + #:compressor compressor #:archiver archiver) #:local-build? #f ;allow offloading #:options (list #:references-graphs `(("profile" ,profile)) @@ -811,10 +852,7 @@ (define tar (string-append #+archiver "/bin/tar")) "debian-binary" control-tarball-file-name data-tarball-file-name)))))) - (gexp->derivation (string-append name ".deb") - build - #:target target - #:references-graphs `(("profile" ,profile)))) + (gexp->derivation (string-append name ".deb") build)) ;;;