From patchwork Fri Feb 3 22:14:06 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 46660 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 08CAC27BBEB; Fri, 3 Feb 2023 22:16:02 +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 E7CC627BBE9 for ; Fri, 3 Feb 2023 22:16:00 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pO4Kz-00079t-67; Fri, 03 Feb 2023 17:15:17 -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 1pO4Kl-000763-UH for guix-patches@gnu.org; Fri, 03 Feb 2023 17:15: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 1pO4Kl-0002zA-LM for guix-patches@gnu.org; Fri, 03 Feb 2023 17:15:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pO4Kl-00057l-D8 for guix-patches@gnu.org; Fri, 03 Feb 2023 17:15:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#61255] [PATCH 3/5] 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, 03 Feb 2023 22:15: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 , Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Ricardo Wurmus Received: via spool by 61255-submit@debbugs.gnu.org id=B61255.167546249119622 (code B ref 61255); Fri, 03 Feb 2023 22:15:03 +0000 Received: (at 61255) by debbugs.gnu.org; 3 Feb 2023 22:14:51 +0000 Received: from localhost ([127.0.0.1]:40088 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pO4KY-00056Q-MV for submit@debbugs.gnu.org; Fri, 03 Feb 2023 17:14:51 -0500 Received: from mail-qt1-f174.google.com ([209.85.160.174]:39685) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pO4KX-00055t-8n for 61255@debbugs.gnu.org; Fri, 03 Feb 2023 17:14:49 -0500 Received: by mail-qt1-f174.google.com with SMTP id g18so4890401qtb.6 for <61255@debbugs.gnu.org>; Fri, 03 Feb 2023 14:14:49 -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=JYBFH/72eg1bIqkD/1ebVbLu0Pu9JuFuuEnFfy5QpCA=; b=jj8S4MqB8AVDFVH4qbW8bP7IUlGr4KRthH3MqkM21k5udbqiwjTOAx3WZLbsQOaP/F uKMoiyKP0Jygs7r5zIRUDojHFNKyBuWnRkvJFaVCQhSlaiMu4O+38445dnK+kx8ZqwWj S3cwt3i1Tm87V+8XqYruPGzxUnU+Q1eELxpJt+5DaBw3FalMli4vWWPye8jg9JaHdBzU 2uDG31mI5FNfenseWVBWPgFja5+lBsIwaNoMUyMrBMXMOOE1IBNmQJbfbVH/QhTAlk7t OCSV1ZzCaQkWAqLKG3mAsmODjk5uqDlEeFaSHuXMeaRFDyVbgHc/KEwNqyWbbl5eopKn fiwg== 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=JYBFH/72eg1bIqkD/1ebVbLu0Pu9JuFuuEnFfy5QpCA=; b=GBILs9L3Yd0vXg0vgBvh8/wmtSJ7r7d+3bQBejBYshPJBEl6LL+6fiQSA3JbML+k16 zBxqtAZ/DioRrH9jHdtDTVUMHS8q1mL2OhAzuan2z8mL3bOPsuMg5+Ut3CrVyOf84N2Z uByRC/Cm3bQnR7/y0ahdO5sQ4Atx/lZY2ZvpQ8JLpZh7wM6L8bMPOB9z8STVOcGqWvUa PzysbJqQyuFbZ8VoFs0x9m5KObUhqSzvZRkTQSLQ69c5+7AlTdceYSoPBQK1WzcDQMhO 0T3OSlrmmGNW6GvZzSDySDG2E5Xwk4qUq3TXeo0fK83KjBMoVPmlboqClgF87sOhis/p 343A== X-Gm-Message-State: AO0yUKVXn///BFOdL6StGA6TFacJmuirkK3Q6oZTNAAglZyf2wISc6as h1HW8a9Qx5u5ZghhEgxXMZjuZrEFhvw= X-Google-Smtp-Source: AK7set8DOE79J/8XnMifrfzb5lAHO2pGZSbZPSEvoybfk0jCAlCQAR+whNnYScigT19wDwHNCQ9A0Q== X-Received: by 2002:ac8:7d45:0:b0:3b6:35a2:bb04 with SMTP id h5-20020ac87d45000000b003b635a2bb04mr23687128qtb.7.1675462483424; Fri, 03 Feb 2023 14:14:43 -0800 (PST) Received: from localhost.localdomain (dsl-10-136-177.b2b2c.ca. [72.10.136.177]) by smtp.gmail.com with ESMTPSA id bp41-20020a05620a45a900b00725d8d6983asm1430594qkb.61.2023.02.03.14.14.42 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 03 Feb 2023 14:14:42 -0800 (PST) From: Maxim Cournoyer Date: Fri, 3 Feb 2023 17:14:06 -0500 Message-Id: <20230203221409.15886-4-maxim.cournoyer@gmail.com> X-Mailer: git-send-email 2.39.1 In-Reply-To: <20230203221409.15886-2-maxim.cournoyer@gmail.com> References: <20230203221409.15886-2-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. --- guix/scripts/pack.scm | 247 ++++++++++++++++++++++++------------------ 1 file changed, 142 insertions(+), 105 deletions(-) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 7e466a2be7..7a5fb9bd0d 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -200,104 +200,144 @@ (define (keyword-ref lst keyword) ((_ value . _) value) (#f #f))) - -;;; -;;; 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) + (define %root (if #$localstatedir? "." #$root)) - (when #+localstatedir? - (install-database-and-gc-roots %root #+database #$profile - #:profile-name #$profile-name)) + (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 SYMLINKS. - (for-each (cut evaluate-populate-directive <> %root) - directives) - - ;; 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 "." @@ -326,17 +366,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))) ;;; @@ -682,18 +721,19 @@ (define %valid-compressors '("gzip" "xz" "none")) 'deb)) (define data-tarball - (computed-file (string-append "data.tar" - (compressor-extension compressor)) - (self-contained-tarball/builder - profile - #:profile-name profile-name - #:compressor compressor - #:localstatedir? localstatedir? - #:symlinks symlinks - #:archiver archiver) - #:local-build? #f ;allow offloading - #:options (list #:references-graphs `(("profile" ,profile)) - #:target target))) + (computed-file (string-append "data.tar" (compressor-extension + compressor)) + (self-contained-tarball/builder profile + #:target target + #:profile-name profile-name + #:localstatedir? localstatedir? + #:deduplicate? deduplicate? + #:symlinks symlinks + #:compressor compressor + #:archiver archiver) + #:local-build? #f ;allow offloading + #:options (list #:references-graphs `(("profile" ,profile)) + #:target target))) (define build (with-extensions (list guile-gcrypt) @@ -821,10 +861,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)) ;;;