From patchwork Fri Feb 17 01:49:30 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 47023 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 63AFD16958; Fri, 17 Feb 2023 01:51:30 +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 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 9E4A116951 for ; Fri, 17 Feb 2023 01:51:26 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pSptz-0007eP-Tz; Thu, 16 Feb 2023 20:51:08 -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 1pSptu-0007dV-K1 for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:02 -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 1pSptu-0004Mw-Bu for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pSptu-0007VA-8j for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#61255] [PATCH v2 1/8] .dir-locals: Add let-keywords indentation rules. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 17 Feb 2023 01:51:02 +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: ludo@gnu.org, Maxim Cournoyer Received: via spool by 61255-submit@debbugs.gnu.org id=B61255.167659861528686 (code B ref 61255); Fri, 17 Feb 2023 01:51:02 +0000 Received: (at 61255) by debbugs.gnu.org; 17 Feb 2023 01:50:15 +0000 Received: from localhost ([127.0.0.1]:38069 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pSpt8-0007SW-K5 for submit@debbugs.gnu.org; Thu, 16 Feb 2023 20:50:14 -0500 Received: from mail-qv1-f50.google.com ([209.85.219.50]:35604) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pSpt7-0007S5-1e for 61255@debbugs.gnu.org; Thu, 16 Feb 2023 20:50:13 -0500 Received: by mail-qv1-f50.google.com with SMTP id i12so2988906qvs.2 for <61255@debbugs.gnu.org>; Thu, 16 Feb 2023 17:50:13 -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=6ZNL08ABEkxGBdDodljea/DQiaO7ROOAavBgcnFozJ8=; b=bDpid3265KEI4YDI2DoeBo5pmwIo00YDAfz1qGjds7Ig6kn1u9pz5i/wAg4W2eZV4f Ffu3hHauqWQqftJlVAskZItp0MmhTkADM1AU+SZ5X2R9o5rDcLMs20UBhBw8QP27n3Pn GyVwy9pKqbsH9cePtXF50aI/Ng5OdZ2iCntukAjvjq+V2HPII+jpA+TVyURroHDIrw5E aGj8SQ34YgnyZIJt1a/CctdyYso1c3jzQXxwyLdpIbDvKm/RPJvquucu0FIDNZlPrJK+ rq3NJ5XaNv7taLgfeebS2YeiRw2Mqd01KDlzVX5gLHnE2ou2GWHv/fIh5ImdLDeOoA6Z d8bw== 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=6ZNL08ABEkxGBdDodljea/DQiaO7ROOAavBgcnFozJ8=; b=YkNNPGe4QbOmL71pZ1wnvyis2rtbwTVUpBmvjjgUzjM7KRoeJH97vkvd3SLmzMo7uZ WVC4dO7qd+lwXVTshHoOihKmahiCNPheSbbqYFqc+0PBNBHyC7beAzBxCzm/jVCnnnw2 ydKU8BzMGqjg170jYdfijIgheFdKozXLipzxtDIaFxnbb0/5gFeHj4wG6qGHPl/JVjMQ y5DO1om34uYKlIfVD6tljZ6hZOAURfsZGIIMwHcELm82yO5MDykeHCTMC2kMOiLVW3T7 3OWZLusxa5yK163XK0MpJOrJXIqnsDNtTkJKyf7zM4aFGKwvzY3QAHRpaknPB9UG8T2E g+Tg== X-Gm-Message-State: AO0yUKWAy6z+KfsfDhxT9h9M9XbkIekYIhVSqVHCSP1G8CS7sqh9un7B 7b9tEawvDghtVymQK0Onnc7We9V1g5JBtVO6 X-Google-Smtp-Source: AK7set/gIsG+RPwpDF+PHG0VDr+kRaYZx78YfixDBaS7+Lb6/isQufWdHM1MXS10LIMjr1/2kCYj1A== X-Received: by 2002:a05:6214:29c9:b0:56b:f113:307e with SMTP id gh9-20020a05621429c900b0056bf113307emr13382189qvb.42.1676598607368; Thu, 16 Feb 2023 17:50:07 -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.06 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 16 Feb 2023 17:50:07 -0800 (PST) From: Maxim Cournoyer Date: Fri, 17 Feb 2023 02:49:30 +0100 Message-Id: <20230217014938.20919-2-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 * .dir-locals.el (scheme-mode): Add let-keywords indentation rules. --- Changes in v2: - New commit .dir-locals.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.dir-locals.el b/.dir-locals.el index a331bde0f1..b8b0fec4ca 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -72,6 +72,9 @@ (eval . (put 'substitute* 'scheme-indent-function 1)) (eval . (put 'match-record 'scheme-indent-function 2)) + ;; TODO: Contribute these to Emacs' scheme-mode. + (eval . (put 'let-keywords 'scheme-indent-function 3)) + ;; 'modify-inputs' and its keywords. (eval . (put 'modify-inputs 'scheme-indent-function 1)) (eval . (put 'replace 'scheme-indent-function 1)) From patchwork Fri Feb 17 01:49:31 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 47029 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 5B1E416952; Fri, 17 Feb 2023 01:52:09 +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 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 9D95E1693E for ; Fri, 17 Feb 2023 01:52:08 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pSpu1-0007fb-AN; Thu, 16 Feb 2023 20:51:09 -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-0007dw-3D 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 1pSptu-0004NE-RJ for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pSptu-0007VH-MV for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#61255] [PATCH v2 2/8] pack: Use let-keywords instead of keyword-ref. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 17 Feb 2023 01:51:02 +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.167659861628699 (code B ref 61255); Fri, 17 Feb 2023 01:51:02 +0000 Received: (at 61255) by debbugs.gnu.org; 17 Feb 2023 01:50:16 +0000 Received: from localhost ([127.0.0.1]:38071 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pSptA-0007Sj-1u for submit@debbugs.gnu.org; Thu, 16 Feb 2023 20:50:16 -0500 Received: from mail-qv1-f50.google.com ([209.85.219.50]:33506) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pSpt8-0007SE-Ay for 61255@debbugs.gnu.org; Thu, 16 Feb 2023 20:50:14 -0500 Received: by mail-qv1-f50.google.com with SMTP id j9so3014345qvt.0 for <61255@debbugs.gnu.org>; Thu, 16 Feb 2023 17:50:14 -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=0qHTKOtyMhSw+KuYJe51SCUVMgqGcETF+XOOn/CziL8=; b=VPX5OcW6SKfx006wrAK0ijMb2VLPzFxZEK5iDwBLuHV34XKKrv66Pevkt8de0ttOxJ Ty+zVScfgQDb5wUMVw+Xd3l48XgKCaAJn4jwPmbqjotD10cXJwIV/oX/N4yv24gXITIc Qd4rDL4wjDtMYY1o+qX8vtmvDwdEWK0HEVtg7bAdtAjwPIMQ+vGgZWkZrBdjXd8YQv0Z lR4FSdnjv/UYQkyYrvoHa+GIv8XkLKQoycYW3LCGQQv/2j56jNtyNZk3ip8hZH4MBTqS 7RqUJvY4OnsW2uArCoLTeE/3oKS/aVkEJ4Zw/VuHana1StOtu0Cb3Bm9LQmLQ/SxWbjx SnkQ== 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=0qHTKOtyMhSw+KuYJe51SCUVMgqGcETF+XOOn/CziL8=; b=MNjIee8k7cjNg12T12mAclKVK2dvv4q+peQa9ttwCqGcINFQmb01qywNBS8u7aUVf9 Gl+dMk8YMotKtRV6FmUPgYqssu+jIeV6fzOWBreyffzFX0Y6Uz4GsSPmwGq+KuhAnPf3 2IWPiuUBWzK1wTUqZBRAi0+bSC3NHxfLMC+yNaoG3/X2ciG0Sk5vXziL0utRuIfMF6EP iro4BlIsiyoJAULBqEq0XBXanZBFuJESV0NZob/aaxpCxwXwdqTKs27bnml2T6I5UHp0 ljagUDNHctqFi1nCTQqsnYNi2I1lhAYnOAcgd1ynj/ucgZ97FvuGCbt5pVnExfFQ74Z3 MygA== X-Gm-Message-State: AO0yUKUmq3NdhC7f+y4+EHm0m0R+8VTlk80Q/y46LZ1Tyyd2IjrM8C/R NhhlFlGnZ1dWGsW+r9/Jnup6wX2FM1TdzZ2b X-Google-Smtp-Source: AK7set+a/bbs5EJg/5YM+jHV5aJGRZ1dOpjIJKJ+f9ERr696Uc1K553IBHnq9g+R27dvnAotJKDmoA== X-Received: by 2002:a05:6214:5296:b0:56e:b5a1:b52d with SMTP id kj22-20020a056214529600b0056eb5a1b52dmr13554460qvb.28.1676598608768; Thu, 16 Feb 2023 17:50:08 -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.07 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 16 Feb 2023 17:50:08 -0800 (PST) From: Maxim Cournoyer Date: Fri, 17 Feb 2023 02:49:31 +0100 Message-Id: <20230217014938.20919-3-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 * guix/scripts/pack.scm: (debian-archive): Bind extra-options keyword arguments via let-keywords. --- Changes in v2: - Use let-keywords instead of custom keyword-ref guix/scripts/pack.scm | 97 ++++++++++++++++++++----------------------- 1 file changed, 44 insertions(+), 53 deletions(-) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index f65642fb85..e552cb108a 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -678,16 +678,15 @@ (define %valid-compressors '("gzip" "xz" "none")) (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))) + (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))) (define build (with-extensions (list guile-gcrypt) @@ -702,6 +701,7 @@ (define build (guix build utils) (guix profiles) (ice-9 match) + (ice-9 optargs) (srfi srfi-1)) (define machine-type @@ -762,32 +762,23 @@ (define data-tarball-file-name (strip-store-file-name (copy-file #+data-tarball data-tarball-file-name) - (define (keyword-ref lst keyword) - (match (memq keyword lst) - ((_ value . _) value) - (#f #f))) - ;; Generate the control archive. - (define control-file - (keyword-ref '#$extra-options #:control-file)) - - (define postinst-file - (keyword-ref '#$extra-options #:postinst-file)) - - (define triggers-file - (keyword-ref '#$extra-options #:triggers-file)) - - (define control-tarball-file-name - (string-append "control.tar" - #$(compressor-extension compressor))) - - ;; Write the compressed control tarball. Only the control file is - ;; mandatory (see: 'man deb' and 'man deb-control'). - (if control-file - (copy-file control-file "control") - (call-with-output-file "control" - (lambda (port) - (format port "\ + (let-keywords '#$extra-options #f + ((control-file #f) + (postinst-file #f) + (triggers-file #f)) + + (define control-tarball-file-name + (string-append "control.tar" + #$(compressor-extension compressor))) + + ;; Write the compressed control tarball. Only the control file is + ;; mandatory (see: 'man deb' and 'man deb-control'). + (if control-file + (copy-file control-file "control") + (call-with-output-file "control" + (lambda (port) + (format port "\ Package: ~a Version: ~a Description: Debian archive generated by GNU Guix. @@ -797,28 +788,28 @@ (define control-tarball-file-name Section: misc ~%" package-name package-version architecture)))) - (when postinst-file - (copy-file postinst-file "postinst") - (chmod "postinst" #o755)) + (when postinst-file + (copy-file postinst-file "postinst") + (chmod "postinst" #o755)) - (when triggers-file - (copy-file triggers-file "triggers")) + (when triggers-file + (copy-file triggers-file "triggers")) - (define tar (string-append #+archiver "/bin/tar")) + (define tar (string-append #+archiver "/bin/tar")) - (apply invoke tar - `(,@(tar-base-options - #:tar tar - #:compressor #+(and=> compressor compressor-command)) - "-cvf" ,control-tarball-file-name - "control" - ,@(if postinst-file '("postinst") '()) - ,@(if triggers-file '("triggers") '()))) + (apply invoke tar + `(,@(tar-base-options + #:tar tar + #:compressor #+(and=> compressor compressor-command)) + "-cvf" ,control-tarball-file-name + "control" + ,@(if postinst-file '("postinst") '()) + ,@(if triggers-file '("triggers") '()))) - ;; Create the .deb archive using GNU ar. - (invoke (string-append #+binutils "/bin/ar") "-rv" #$output - "debian-binary" - control-tarball-file-name data-tarball-file-name))))) + ;; Create the .deb archive using GNU ar. + (invoke (string-append #+binutils "/bin/ar") "-rv" #$output + "debian-binary" + control-tarball-file-name data-tarball-file-name)))))) (gexp->derivation (string-append name ".deb") build From patchwork Fri Feb 17 01:49:32 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 47026 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 5ED7216952; Fri, 17 Feb 2023 01:51:46 +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 autolearn=ham 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 1DEF31693E for ; Fri, 17 Feb 2023 01:51:46 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pSpu3-0007fq-8p; Thu, 16 Feb 2023 20:51:11 -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-0007e6-Fb 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-0004NS-7Q 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-0007VP-4N for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#61255] [PATCH v2 3/8] gexp: computed-file: Honor %guile-for-build. 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.167659862228731 (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]:38077 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pSptF-0007TK-Iu for submit@debbugs.gnu.org; Thu, 16 Feb 2023 20:50:21 -0500 Received: from mail-qv1-f48.google.com ([209.85.219.48]:38714) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pSptA-0007SJ-2L for 61255@debbugs.gnu.org; Thu, 16 Feb 2023 20:50:16 -0500 Received: by mail-qv1-f48.google.com with SMTP id t8so2962505qvr.5 for <61255@debbugs.gnu.org>; Thu, 16 Feb 2023 17:50:16 -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=bKDybqOc/LxTbZoiKTfBCMuO2X8OO7B/1efhB9eM2VU=; b=FFfNLcrHlwwlyORP3ONqeHykZgZ6KvVgXcwJueDyBHacfSeDkXmDeRjgcClskJ/PeN IKSyDgmNVDCxxZhr7JY6Y+o1GBvZxaNDtmhghKzEZTfAmKzaVZiTQunCzIcdE2xmikM5 cinUfFHcafr14Zd/Fr2jWjVvysnlQ2e9JHDG/+Fvyu+gKuKv+MY3rtRvrbqMZRBgjYPC o7lzvdXdGkQxC3f5EFoI5+fFkK52DEnrMyDYphmFAexRE5P4pDrbRQQal0YddfU26dhx DRbZgyCxWwTlY8aBE8bL60hHYFvlx58z8Q9U/EVg50rVsmzsV1v5CZcrBFSyiqn3b2Gg 3jeA== 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=bKDybqOc/LxTbZoiKTfBCMuO2X8OO7B/1efhB9eM2VU=; b=6HInZX4XCqI1THiqDiRFkFaYQsoJPf0haszVGpi684AGUj5ZS0yLQSTlsQiycq3UbV 0xQXBSOzK7Z4P8uyOvLhHG4qqVVIXrRHB9+85CwM8lMq3w0+KBfm8IKDTNcDZBU6S1MW IGnEIK8VVK5KwJ2id+2Fb72xe0zPWCyNEAdYjKkl3Q5JdgkPXwfDah+XnlzHjeFDOuOf Ma90owOCzaqoeaWEGfBhplW9xAPyzS5qT7VoyPMD/Q3FoVboxmGhD5OSzpfRDBj9jeBq grK+jsZm5+GzDM28uyHxqNUxDLbGT885x1LL9Fq95ALu49lhlGY8qJNkHVVG1hWFrUcd V0xQ== X-Gm-Message-State: AO0yUKV1b6AFnGpaHHaFBRHLQ/W4DZv7TW3BTF6mWxKzh3DS38M2cypr VvVsP/E7JHUWsJP+4rAJjw5jGaJjySPBwdgS X-Google-Smtp-Source: AK7set9H2AE4ag4uzMcE5BQei0DumFogdlrnxFam6eTmSOH3tj8sc1QNHe3W4rI2dOCtKfdsFM6z/A== X-Received: by 2002:a05:6214:27cc:b0:56e:a7d1:4d65 with SMTP id ge12-20020a05621427cc00b0056ea7d14d65mr13074735qvb.52.1676598610474; Thu, 16 Feb 2023 17:50:10 -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.09 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 16 Feb 2023 17:50:10 -0800 (PST) From: Maxim Cournoyer Date: Fri, 17 Feb 2023 02:49:32 +0100 Message-Id: <20230217014938.20919-4-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 * guix/gexp.scm (computed-file-compiler): Honor %guile-for-build. --- (no changes since v1) guix/gexp.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/guix/gexp.scm b/guix/gexp.scm index 5f92174a2c..cabf163076 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -584,7 +584,8 @@ (define-record-type (options computed-file-options)) ;list of arguments (define* (computed-file name gexp - #:key guile (local-build? #t) (options '())) + #:key guile + (local-build? #t) (options '())) "Return an object representing the store item NAME, a file or directory computed by GEXP. When LOCAL-BUILD? is #t (the default), it ensures the corresponding derivation is built locally. OPTIONS may be used to pass @@ -600,7 +601,8 @@ (define-gexp-compiler (computed-file-compiler (file ) ;; gexp. (match file (($ name gexp guile options) - (mlet %store-monad ((guile (lower-object (or guile (default-guile)) + (mlet %store-monad ((guile (lower-object (or guile (%guile-for-build) + (default-guile)) system #:target #f))) (apply gexp->derivation name gexp #:guile-for-build guile #:system system #:target target options))))) 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)) ;;; From patchwork Fri Feb 17 01:49:34 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 47025 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 8FBF916952; Fri, 17 Feb 2023 01:51:41 +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 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 1F2D016951 for ; Fri, 17 Feb 2023 01:51:39 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pSpu7-0007k6-1l; Thu, 16 Feb 2023 20:51:15 -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 1pSptx-0007eQ-1u for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:07 -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-0004Nj-VO for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:04 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pSptv-0007Ve-SD for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#61255] [PATCH v2 5/8] tests: pack: Fix indentation. 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: ludo@gnu.org, Maxim Cournoyer Received: via spool by 61255-submit@debbugs.gnu.org id=B61255.167659862328752 (code B ref 61255); Fri, 17 Feb 2023 01:51:03 +0000 Received: (at 61255) by debbugs.gnu.org; 17 Feb 2023 01:50:23 +0000 Received: from localhost ([127.0.0.1]:38082 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pSptG-0007TY-P4 for submit@debbugs.gnu.org; Thu, 16 Feb 2023 20:50:23 -0500 Received: from mail-qv1-f44.google.com ([209.85.219.44]:42691) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pSptD-0007ST-BN for 61255@debbugs.gnu.org; Thu, 16 Feb 2023 20:50:20 -0500 Received: by mail-qv1-f44.google.com with SMTP id mg2so2949346qvb.9 for <61255@debbugs.gnu.org>; Thu, 16 Feb 2023 17:50:19 -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=H28IU027B5mobg/w9lJc7r/jjUV6999My1fazfgY6hw=; b=g7CS0EJTXbJ/5nGEmxjXVw2Y6H9f9M/DGi4Pc/K9f8KV8LnLJdPlpPRklFrAPpIlXp JVYhjUtSUsuOyNCL8GSWXeKwOZcJcUxc+LsaJsnN2bA3HThhapLkWlmFS0y3Yh/jdyPs 2J0xmcAJLfTwJ7/AVMFcui8cvCSEFBZa3/krfRcRLtJeZKwm0ccZOlfscSWWyvgTWw2b jnWjNK1Sd8fJlOZ5RXuN5AAqx4BgU8NX/4D+jGK9wXNB9U9GBNCcbD5Idsaizzjy2h4d lMamrJH1y+6oar3ns8dVVnk5rJNpbrTKqr+1eji24bUREHFWXf9DdZs54E3nR9mx3Y+q EDYQ== 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=H28IU027B5mobg/w9lJc7r/jjUV6999My1fazfgY6hw=; b=QF0rIpXefRWd59lxt73TrOXpoPz+LTjSR0ylI6jgqXM7q4zzzuIrJXVbcQiuimszeI 6zr3PY0s2+FG79w6rdgRLK9tqsGu3H5PDZmCj98jiw2MuL2wP83BmVFr6CDwbQ3lTkKs Mf9oxG0oVVDOrvf74XOxOyvV0rTa0vznv7X2Eg9qQ4mhFPrSWwV+qmgh2/Lyh3ZU31Mr 4jXf0x9yADxvPUZmUzq60Syy7eyd+lCUXBqkKL66uBVfzJPhFrz0R7wcALx1nTriJpRG /PWreMW40gY13x6Z+XVURxBKhHSkCt343LVOyQfve21tSElPqvupOv7K46Unhx8EkArH YRNg== X-Gm-Message-State: AO0yUKWdDcwxNKJCQv0oAFXbKbM5lIRMQEJzICjuai8a+96CFn7ohHi5 JIL0sszCk845LxnWWZWcpHRNp/UCWFeQ+mHx X-Google-Smtp-Source: AK7set+uYLWE+vtJkWfIcK5tO8Da009msUYlpAYU0vimFtueOorRjsEYCzOV1VnZs017ZotM2R+KXg== X-Received: by 2002:a05:6214:c8b:b0:56e:b16d:ec9b with SMTP id r11-20020a0562140c8b00b0056eb16dec9bmr14151850qvr.21.1676598613569; Thu, 16 Feb 2023 17:50:13 -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.12 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 16 Feb 2023 17:50:13 -0800 (PST) From: Maxim Cournoyer Date: Fri, 17 Feb 2023 02:49:34 +0100 Message-Id: <20230217014938.20919-6-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 * tests/pack.scm: Fix indentation. --- Changes in v2: - Better make use of the new indentation rule tests/pack.scm | 279 ++++++++++++++++++++++++------------------------- 1 file changed, 137 insertions(+), 142 deletions(-) diff --git a/tests/pack.scm b/tests/pack.scm index a4c388d93e..a02924b7d2 100644 --- a/tests/pack.scm +++ b/tests/pack.scm @@ -74,44 +74,43 @@ (define %ar-bootstrap %bootstrap-binutils) -> "bin/guile")) #:compressor %gzip-compressor #:archiver %tar-bootstrap)) - (check (gexp->derivation - "check-tarball" - (with-imported-modules '((guix build utils)) - #~(begin - (use-modules (guix build utils) - (srfi srfi-1)) - - (define store - ;; The unpacked store. - (string-append "." (%store-directory) "/")) - - (define (canonical? file) - ;; Return #t if FILE is read-only and its mtime is 1. - (let ((st (lstat file))) - (or (not (string-prefix? store file)) - (eq? 'symlink (stat:type st)) - (and (= 1 (stat:mtime st)) - (zero? (logand #o222 - (stat:mode st))))))) - - (define bin - (string-append "." #$profile "/bin")) - - (setenv "PATH" - (string-append #$%tar-bootstrap "/bin")) - (system* "tar" "xvf" #$tarball) - (mkdir #$output) - (exit - (and (file-exists? (string-append bin "/guile")) - (file-exists? store) - (every canonical? - (find-files "." (const #t) - #:directories? #t)) - (string=? (string-append #$%bootstrap-guile "/bin") - (readlink bin)) - (string=? (string-append ".." #$profile - "/bin/guile") - (readlink "bin/Guile"))))))))) + (check (gexp->derivation "check-tarball" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (srfi srfi-1)) + + (define store + ;; The unpacked store. + (string-append "." (%store-directory) "/")) + + (define (canonical? file) + ;; Return #t if FILE is read-only and its mtime is 1. + (let ((st (lstat file))) + (or (not (string-prefix? store file)) + (eq? 'symlink (stat:type st)) + (and (= 1 (stat:mtime st)) + (zero? (logand #o222 + (stat:mode st))))))) + + (define bin + (string-append "." #$profile "/bin")) + + (setenv "PATH" + (string-append #$%tar-bootstrap "/bin")) + (system* "tar" "xvf" #$tarball) + (mkdir #$output) + (exit + (and (file-exists? (string-append bin "/guile")) + (file-exists? store) + (every canonical? + (find-files "." (const #t) + #:directories? #t)) + (string=? (string-append #$%bootstrap-guile "/bin") + (readlink bin)) + (string=? (string-append ".." #$profile + "/bin/guile") + (readlink "bin/Guile"))))))))) (built-derivations (list check)))) ;; The following test needs guile-sqlite3, libgcrypt, etc. as a consequence of @@ -131,17 +130,16 @@ (define bin #:locales? #f)) (tarball (self-contained-tarball "tar-pack" profile #:localstatedir? #t)) - (check (gexp->derivation - "check-tarball" - #~(let ((bin (string-append "." #$profile "/bin"))) - (setenv "PATH" - (string-append #$%tar-bootstrap "/bin")) - (system* "tar" "xvf" #$tarball) - (mkdir #$output) - (exit - (and (file-exists? "var/guix/db/db.sqlite") - (string=? (string-append #$%bootstrap-guile "/bin") - (readlink bin)))))))) + (check (gexp->derivation "check-tarball" + #~(let ((bin (string-append "." #$profile "/bin"))) + (setenv "PATH" + (string-append #$%tar-bootstrap "/bin")) + (system* "tar" "xvf" #$tarball) + (mkdir #$output) + (exit + (and (file-exists? "var/guix/db/db.sqlite") + (string=? (string-append #$%bootstrap-guile "/bin") + (readlink bin)))))))) (built-derivations (list check)))) (unless store (test-skip 1)) @@ -154,45 +152,44 @@ (define bin ("λ" regular (data "lambda"))))) (tarball (self-contained-tarball "tar-pack" tree #:localstatedir? #t)) - (check (gexp->derivation - "check-tarball" - (with-extensions (list guile-sqlite3 guile-gcrypt) - (with-imported-modules (source-module-closure - '((guix store database))) - #~(begin - (use-modules (guix store database) - (rnrs io ports) - (srfi srfi-1)) - - (define (valid-file? basename data) - (define file - (string-append "./" #$tree "/" basename)) - - (string=? (call-with-input-file (pk 'file file) - get-string-all) - data)) - - (setenv "PATH" - (string-append #$%tar-bootstrap "/bin")) - (system* "tar" "xvf" #$tarball) - - (sql-schema - #$(local-file (search-path %load-path - "guix/store/schema.sql"))) - (with-database "var/guix/db/db.sqlite" db - ;; Make sure non-ASCII file names are properly - ;; handled. - (setenv "GUIX_LOCPATH" - #+(file-append glibc-utf8-locales - "/lib/locale")) - (setlocale LC_ALL "en_US.utf8") - - (mkdir #$output) - (exit - (and (every valid-file? - '("α" "λ") - '("alpha" "lambda")) - (integer? (path-id db #$tree))))))))))) + (check (gexp->derivation "check-tarball" + (with-extensions (list guile-sqlite3 guile-gcrypt) + (with-imported-modules (source-module-closure + '((guix store database))) + #~(begin + (use-modules (guix store database) + (rnrs io ports) + (srfi srfi-1)) + + (define (valid-file? basename data) + (define file + (string-append "./" #$tree "/" basename)) + + (string=? (call-with-input-file (pk 'file file) + get-string-all) + data)) + + (setenv "PATH" + (string-append #$%tar-bootstrap "/bin")) + (system* "tar" "xvf" #$tarball) + + (sql-schema + #$(local-file (search-path %load-path + "guix/store/schema.sql"))) + (with-database "var/guix/db/db.sqlite" db + ;; Make sure non-ASCII file names are properly + ;; handled. + (setenv "GUIX_LOCPATH" + #+(file-append glibc-utf8-locales + "/lib/locale")) + (setlocale LC_ALL "en_US.utf8") + + (mkdir #$output) + (exit + (and (every valid-file? + '("α" "λ") + '("alpha" "lambda")) + (integer? (path-id db #$tree))))))))))) (built-derivations (list check)))) (unless store (test-skip 1)) @@ -206,34 +203,33 @@ (define file (tarball (docker-image "docker-pack" profile #:symlinks '(("/bin/Guile" -> "bin/guile")) #:localstatedir? #t)) - (check (gexp->derivation - "check-tarball" - (with-imported-modules '((guix build utils)) - #~(begin - (use-modules (guix build utils) - (ice-9 match)) - - (define bin - (string-append "." #$profile "/bin")) - - (setenv "PATH" (string-append #$%tar-bootstrap "/bin")) - (mkdir "base") - (with-directory-excursion "base" - (invoke "tar" "xvf" #$tarball)) - - (match (find-files "base" "layer.tar") - ((layer) - (invoke "tar" "xvf" layer))) - - (when - (and (file-exists? (string-append bin "/guile")) - (file-exists? "var/guix/db/db.sqlite") - (file-is-directory? "tmp") - (string=? (string-append #$%bootstrap-guile "/bin") - (pk 'binlink (readlink bin))) - (string=? (string-append #$profile "/bin/guile") - (pk 'guilelink (readlink "bin/Guile")))) - (mkdir #$output))))))) + (check (gexp->derivation "check-tarball" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (ice-9 match)) + + (define bin + (string-append "." #$profile "/bin")) + + (setenv "PATH" (string-append #$%tar-bootstrap "/bin")) + (mkdir "base") + (with-directory-excursion "base" + (invoke "tar" "xvf" #$tarball)) + + (match (find-files "base" "layer.tar") + ((layer) + (invoke "tar" "xvf" layer))) + + (when + (and (file-exists? (string-append bin "/guile")) + (file-exists? "var/guix/db/db.sqlite") + (file-is-directory? "tmp") + (string=? (string-append #$%bootstrap-guile "/bin") + (pk 'binlink (readlink bin))) + (string=? (string-append #$profile "/bin/guile") + (pk 'guilelink (readlink "bin/Guile")))) + (mkdir #$output))))))) (built-derivations (list check)))) (unless store (test-skip 1)) @@ -247,32 +243,31 @@ (define bin (image (squashfs-image "squashfs-pack" profile #:symlinks '(("/bin" -> "bin")) #:localstatedir? #t)) - (check (gexp->derivation - "check-tarball" - (with-imported-modules '((guix build utils)) - #~(begin - (use-modules (guix build utils) - (ice-9 match)) - - (define bin - (string-append "." #$profile "/bin")) - - (setenv "PATH" - (string-append #$squashfs-tools "/bin")) - (invoke "unsquashfs" #$image) - (with-directory-excursion "squashfs-root" - (when (and (file-exists? (string-append bin - "/guile")) - (file-exists? "var/guix/db/db.sqlite") - (string=? (string-append #$%bootstrap-guile "/bin") - (pk 'binlink (readlink bin))) - - ;; This is a relative symlink target. - (string=? (string-drop - (string-append #$profile "/bin") - 1) - (pk 'guilelink (readlink "bin")))) - (mkdir #$output)))))))) + (check (gexp->derivation "check-tarball" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (ice-9 match)) + + (define bin + (string-append "." #$profile "/bin")) + + (setenv "PATH" + (string-append #$squashfs-tools "/bin")) + (invoke "unsquashfs" #$image) + (with-directory-excursion "squashfs-root" + (when (and (file-exists? (string-append bin + "/guile")) + (file-exists? "var/guix/db/db.sqlite") + (string=? (string-append #$%bootstrap-guile "/bin") + (pk 'binlink (readlink bin))) + + ;; This is a relative symlink target. + (string=? (string-drop + (string-append #$profile "/bin") + 1) + (pk 'guilelink (readlink "bin")))) + (mkdir #$output)))))))) (built-derivations (list check)))) (unless store (test-skip 1)) From patchwork Fri Feb 17 01:49:35 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 47024 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 16DB316951; Fri, 17 Feb 2023 01:51:33 +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 A8BB616952 for ; Fri, 17 Feb 2023 01:51:29 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pSpu2-0007fn-56; Thu, 16 Feb 2023 20:51:10 -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 1pSptx-0007eR-1R for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:07 -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 1pSptw-0004Nq-B3 for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:04 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pSptw-0007Vl-7T for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#61255] [PATCH v2 6/8] pack: Add RPM format. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 17 Feb 2023 01:51:04 +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.167659862628766 (code B ref 61255); Fri, 17 Feb 2023 01:51:04 +0000 Received: (at 61255) by debbugs.gnu.org; 17 Feb 2023 01:50:26 +0000 Received: from localhost ([127.0.0.1]:38084 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pSptH-0007Th-GC for submit@debbugs.gnu.org; Thu, 16 Feb 2023 20:50:26 -0500 Received: from mail-qt1-f179.google.com ([209.85.160.179]:41948) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pSptB-0007RV-HW for 61255@debbugs.gnu.org; Thu, 16 Feb 2023 20:50:20 -0500 Received: by mail-qt1-f179.google.com with SMTP id z5so4150479qtn.8 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=FxZh5C5H5Ti/EsCYT6/qCXEoU7R3AOxI0YpFHpwGGts=; b=guSKT9IK4WdH18i38Pq8+AvO3eZeKzxK5bng0wl49PvTjd7rp+NT4JUnT1Cmcnw/UY DxnyEtqH3yQox2HGams5Bk61ZzDHqKFQt6MRR5snriHHvsG/Tyk0Z+6uuNr3e2krjl3p FcMd5HRpKenWKLUPAclARhySfm63Q5mDJ/GV+l7fqiOFn5s9+hrqGIxW4/yaCKWT0uJR zHly6O6P4744imNoKJR9XjJHxharzvtH4wUC/sGNXeSKvq/pL/czqkxfwH65ccGXrOHe hXGtp5MGMyRFKdJaVSZzLHHIrGv+NO9zPQva+pIo40FNBfGM7/FjU9oIxhIOXvG8+WoJ +ICg== 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=FxZh5C5H5Ti/EsCYT6/qCXEoU7R3AOxI0YpFHpwGGts=; b=5P4VSH40qHx7mYosVPvuMP59PN2Rw9s91p0GhXl2UO4okCo0hR1YNrGf4KtZXKVbv7 BjfQH0Z4oW8/Hlkp1PcpKbSNy4YTuhbJemdKjI/JiKqrYNHSvxApINGG2JmmoH3v8c25 L9j5+zd8XDqBust5+owDQ7w/x9uM8Rpig/3e0gcUQVxfeN5d9Goi8WMez8Q/TlidKVHf YYL7GkJAaqqoBlvxUw5FWNgbBrXmSruv4ArRMlJ+FjKgHVVl3JDSfFyZ60dsiB8Mq+2Q 6DlZOPKetkBoUyY8JBwchnuOagJ1etw3G0C7Q3sBd+m98o5FKQnO406kMO9u8TTx1XLs ciNA== X-Gm-Message-State: AO0yUKXsTeFocYc+nYp9F2YnCPxKzJ2iX+nVl6nVrSIERpWOJRbT7RKt 0mOHw2FucyhZJG2ceN9lMUKiL9S+BPyw8Ued X-Google-Smtp-Source: AK7set+YzC8rE6XoXWPzDREkW/4prcMOWjeHsyM5UDbKnH5cR6jtfG3pzj0ajIxdUtNgAqdbieheig== X-Received: by 2002:a05:622a:246:b0:3b8:6814:ea20 with SMTP id c6-20020a05622a024600b003b86814ea20mr11975241qtx.67.1676598615625; Thu, 16 Feb 2023 17:50:15 -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.14 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 16 Feb 2023 17:50:15 -0800 (PST) From: Maxim Cournoyer Date: Fri, 17 Feb 2023 02:49:35 +0100 Message-Id: <20230217014938.20919-7-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 * guix/rpm.scm: New file. * guix/scripts/pack.scm (rpm-archive): New procedure. (%formats): Register it. (show-formats): Add it. (guix-pack): Register supported extra-options for the rpm format. * tests/pack.scm (rpm-for-tests): New variable. ("rpm archive can be installed/uninstalled"): New test. * tests/rpm.scm: New test. * doc/guix.texi (Invoking guix pack): Document it. --- Changes in v2: - Use let-keywords instead of custom keyword-ref - Adjust commentary block in (guix rpm) - Adjust long define indentation in (guix scripts pack) - Separate guix pack / rpm --install example blocks Makefile.am | 2 + doc/guix.texi | 48 +++- guix/rpm.scm | 623 ++++++++++++++++++++++++++++++++++++++++++ guix/scripts/pack.scm | 230 +++++++++++++++- tests/pack.scm | 57 +++- tests/rpm.scm | 86 ++++++ 6 files changed, 1033 insertions(+), 13 deletions(-) create mode 100644 guix/rpm.scm create mode 100644 tests/rpm.scm diff --git a/Makefile.am b/Makefile.am index 5ce6cc84f4..8e3815b9c2 100644 --- a/Makefile.am +++ b/Makefile.am @@ -111,6 +111,7 @@ MODULES = \ guix/derivations.scm \ guix/grafts.scm \ guix/repl.scm \ + guix/rpm.scm \ guix/transformations.scm \ guix/inferior.scm \ guix/describe.scm \ @@ -535,6 +536,7 @@ SCM_TESTS = \ tests/pypi.scm \ tests/read-print.scm \ tests/records.scm \ + tests/rpm.scm \ tests/scripts.scm \ tests/search-paths.scm \ tests/services.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 44e2165a82..11f6b3636f 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6896,6 +6896,7 @@ such file or directory'' message. @end quotation @item deb +@cindex Debian, build a .deb package with guix pack This produces a Debian archive (a package with the @samp{.deb} file extension) containing all the specified binaries and symbolic links, that can be installed on top of any dpkg-based GNU(/Linux) distribution. @@ -6912,7 +6913,8 @@ guix pack -f deb -C xz -S /usr/bin/hello=bin/hello hello Because archives produced with @command{guix pack} contain a collection of store items and because each @command{dpkg} package must not have conflicting files, in practice that means you likely won't be able to -install more than one such archive on a given system. +install more than one such archive on a given system. You can +nonetheless pack as many Guix packages as you want in one such archive. @end quotation @quotation Warning @@ -6923,6 +6925,50 @@ shared by other software, such as a Guix installation or other, non-deb packs. @end quotation +@item rpm +@cindex RPM, build an RPM archive with guix pack +This produces an RPM archive (a package with the @samp{.rpm} file +extension) containing all the specified binaries and symbolic links, +that can be installed on top of any RPM-based GNU/Linux distribution. +The RPM format embeds checksums for every file it contains, which the +@command{rpm} command uses to validate the integrity of the archive. + +Advanced RPM-related options are revealed via the +@option{--help-rpm-format} option. These options allow embedding +maintainer scripts that can run before or after the installation of the +RPM archive, for example. + +The RPM format supports relocatable packages via the @option{--prefix} +option of the @command{rpm} command, which can be handy to install an +RPM package to a specific prefix, making installing multiple +Guix-produced RPM packages side by side possible. + +@example +guix pack -f rpm -R -C xz -S /usr/bin/hello=bin/hello hello +@end example + +@example +sudo rpm --install --prefix=/opt /gnu/store/...-hello.rpm +@end example + +@quotation Note +Similarly to Debian packages, two RPM packages with conflicting files +cannot be installed simultaneously. Contrary to Debian packages, RPM +supports relocatable packages, so file conflicts can be avoided by +installing the RPM packages under different installation prefixes, as +shown in the above example. +@end quotation + +@quotation Warning +@command{rpm} assumes ownership of any files contained in the pack, +which means it will remove @file{/gnu/store} upon uninstalling a +Guix-generated RPM package, unless the RPM package was installed with +the @option{--prefix} option of the @command{rpm} command. It is unwise +to install Guix-produced @samp{.rpm} packages on a system where +@file{/gnu/store} is shared by other software, such as a Guix +installation or other, non-rpm packs. +@end quotation + @end table @cindex relocatable binaries diff --git a/guix/rpm.scm b/guix/rpm.scm new file mode 100644 index 0000000000..1cb8326a9b --- /dev/null +++ b/guix/rpm.scm @@ -0,0 +1,623 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2023 Maxim Cournoyer +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix rpm) + #:autoload (gcrypt hash) (hash-algorithm file-hash md5) + #:use-module (guix build utils) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (ice-9 textual-ports) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-71) + #:use-module (srfi srfi-171) + #:export (generate-lead + generate-signature + generate-header + assemble-rpm-metadata + + ;; XXX: These are internals, but the inline disabling trick + ;; doesn't work on them. + make-header-entry + header-entry? + header-entry-tag + header-entry-count + header-entry-value + + bytevector->hex-string + + fhs-directory?)) + +;;; Commentary: +;;; +;;; This module provides the building blocks required to construct RPM +;;; archives. It is intended to be importable on the build side, so shouldn't +;;; depend on (guix diagnostics) or other host-side-only modules. +;;; +;;; Code: + +(define (gnu-system-triplet->machine-type triplet) + "Return the machine component of TRIPLET, a GNU system triplet." + (first (string-split triplet #\-))) + +(define (gnu-machine-type->rpm-arch type) + "Return the canonical RPM architecture string, given machine TYPE." + (match type + ("arm" "armv7hl") + ("powerpc" "ppc") + ("powerpc64le" "ppc64le") + (machine machine))) ;unchanged + +(define (gnu-machine-type->rpm-number type) + "Translate machine TYPE to its corresponding RPM integer value." + ;; Refer to the rpmrc.in file in the RPM source for the complete + ;; translation tables. + (match type + ((or "i486" "i586" "i686" "x86_64") 1) + ((? (cut string-prefix? "powerpc" <>)) 5) + ("mips64el" 11) + ((? (cut string-prefix? "arm" <>)) 12) + ("aarch64" 19) + ((? (cut string-prefix? "riscv" <>)) 22) + (_ (error "no RPM number known for machine type" type)))) + +(define (u16-number->u8-list number) + "Return a list of byte values made of NUMBER, a 16 bit unsigned integer." + (let ((bv (uint-list->bytevector (list number) (endianness big) 2))) + (bytevector->u8-list bv))) + +(define (u32-number->u8-list number) + "Return a list of byte values made of NUMBER, a 32 bit unsigned integer." + (let ((bv (uint-list->bytevector (list number) (endianness big) 4))) + (bytevector->u8-list bv))) + +(define (s32-number->u8-list number) + "Return a list of byte values made of NUMBER, a 32 bit signed integer." + (let ((bv (sint-list->bytevector (list number) (endianness big) 4))) + (bytevector->u8-list bv))) + +(define (u8-list->u32-number lst) + "Return the 32 bit unsigned integer corresponding to the 4 bytes in LST." + (bytevector-u32-ref (u8-list->bytevector lst) 0 (endianness big))) + + +;;; +;;; Lead section. +;;; + +;; Refer to the docs/manual/format.md file of the RPM source for the details +;; regarding the binary format of an RPM archive. +(define* (generate-lead name-version #:key (target %host-type)) + "Generate a RPM lead u8-list that uses NAME-VERSION, the name and version +string of the package, and TARGET, a GNU triplet used to derive the target +machine type." + (define machine-type (gnu-system-triplet->machine-type target)) + (define magic (list #xed #xab #xee #xdb)) + (define file-format-version (list 3 0)) ;3.0 + (define type (list 0 0)) ;0 for binary packages + (define arch-number (u16-number->u8-list + (gnu-machine-type->rpm-number machine-type))) + ;; The 66 bytes from 10 to 75 are for the name-version-release string. + (define name + (let ((padding-bytes (make-list (- 66 (string-length name-version)) 0))) + (append (bytevector->u8-list (string->utf8 name-version)) + padding-bytes))) + ;; There is no OS number corresponding to GNU/Hurd (GNU), only Linux, per + ;; rpmrc.in. + (define os-number (list 0 1)) + + ;; For RPM format 3.0, the signature type is 5, which means a "Header-style" + ;; signature. + (define signature-type (list 0 5)) + + (define reserved-bytes (make-list 16 0)) + + (append magic file-format-version type arch-number name + os-number signature-type reserved-bytes)) + + +;;; +;;; Header section. +;;; + +(define header-magic (list #x8e #xad #xe8)) +(define header-version (list 1)) +(define header-reserved (make-list 4 0)) ;4 reserved bytes +;;; Every header starts with 8 bytes made by the header magic number, the +;;; header version and 4 reserved bytes. +(define header-intro (append header-magic header-version header-reserved)) + +;;; Header entry data types. +(define NULL 0) +(define CHAR 1) +(define INT8 2) +(define INT16 3) ;2-bytes aligned +(define INT32 4) ;4-bytes aligned +(define INT64 5) ;8-bytes aligned +(define STRING 6) +(define BIN 7) +(define STRING_ARRAY 8) +(define I18NSTRIN_TYPE 9) + +;;; Header entry tags. +(define-record-type + (make-rpm-tag number type) + rpm-tag? + (number rpm-tag-number) + (type rpm-tag-type)) + +;;; The following are internal tags used to identify the data sections. +(define RPMTAG_HEADERSIGNATURES (make-rpm-tag 62 BIN)) ;signature header +(define RPMTAG_HEADERIMMUTABLE (make-rpm-tag 63 BIN)) ;main/data header +(define RPMTAG_HEADERI18NTABLE (make-rpm-tag 100 STRING_ARRAY)) + +;;; Subset of RPM tags from include/rpm/rpmtag.h. +(define RPMTAG_NAME (make-rpm-tag 1000 STRING)) +(define RPMTAG_VERSION (make-rpm-tag 1001 STRING)) +(define RPMTAG_RELEASE (make-rpm-tag 1002 STRING)) +(define RPMTAG_SUMMARY (make-rpm-tag 1004 STRING)) +(define RPMTAG_SIZE (make-rpm-tag 1009 INT32)) +(define RPMTAG_LICENSE (make-rpm-tag 1014 STRING)) +(define RPMTAG_OS (make-rpm-tag 1021 STRING)) +(define RPMTAG_ARCH (make-rpm-tag 1022 STRING)) +(define RPMTAG_PREIN (make-rpm-tag 1023 STRING)) +(define RPMTAG_POSTIN (make-rpm-tag 1024 STRING)) +(define RPMTAG_PREUN (make-rpm-tag 1025 STRING)) +(define RPMTAG_POSTUN (make-rpm-tag 1026 STRING)) +(define RPMTAG_FILESIZES (make-rpm-tag 1028 INT32)) +(define RPMTAG_FILEMODES (make-rpm-tag 1030 INT16)) +(define RPMTAG_FILEDIGESTS (make-rpm-tag 1035 STRING_ARRAY)) +(define RPMTAG_FILELINKTOS (make-rpm-tag 1036 STRING_ARRAY)) +(define RPMTAG_FILEUSERNAME (make-rpm-tag 1039 STRING_ARRAY)) +(define RPMTAG_GROUPNAME (make-rpm-tag 1040 STRING_ARRAY)) +(define RPMTAG_PREFIXES (make-rpm-tag 1098 STRING_ARRAY)) +(define RPMTAG_DIRINDEXES (make-rpm-tag 1116 INT32)) +(define RPMTAG_BASENAMES (make-rpm-tag 1117 STRING_ARRAY)) +(define RPMTAG_DIRNAMES (make-rpm-tag 1118 STRING_ARRAY)) +(define RPMTAG_PAYLOADFORMAT (make-rpm-tag 1124 STRING)) +(define RPMTAG_PAYLOADCOMPRESSOR (make-rpm-tag 1125 STRING)) +(define RPMTAG_LONGFILESIZES (make-rpm-tag 5008 INT64)) +(define RPMTAG_LONGSIZE (make-rpm-tag 5009 INT64)) +;;; The algorithm used to compute the digest of each file, e.g. RPM_HASH_MD5. +(define RPMTAG_FILEDIGESTALGO (make-rpm-tag 5011 INT32)) +;;; RPMTAG_ENCODING specifies the encoding used for strings, e.g. "utf-8". +(define RPMTAG_ENCODING (make-rpm-tag 5062 STRING)) +;;; Compressed payload digest. Its type is a string array, but currently in +;;; practice it is equivalent to STRING, since only the first element is used. +(define RPMTAG_PAYLOADDIGEST (make-rpm-tag 5092 STRING_ARRAY)) +;;; The algorithm used to compute the payload digest, e.g. RPM_HASH_SHA256. +(define RPMTAG_PAYLOADDIGESTALGO (make-rpm-tag 5093 INT32)) +;;; The following are taken from the rpmHashAlgo_e enum in rpmcrypto.h. +(define RPM_HASH_MD5 1) +(define RPM_HASH_SHA256 8) + +;;; Other useful internal definitions. +(define REGION_TAG_COUNT 16) ;number of bytes +(define INT32_MAX (1- (expt 2 32))) ;4294967295 bytes (unsigned) + +(define (rpm-tag->u8-list tag) + "Return the u8 list corresponding to RPM-TAG, a object." + (append (u32-number->u8-list (rpm-tag-number tag)) + (u32-number->u8-list (rpm-tag-type tag)))) + +(define-record-type + (make-header-entry tag count value) + header-entry? + (tag header-entry-tag) ; + (count header-entry-count) ;number (u32) + (value header-entry-value)) ;string|number|list|... + +(define (entry-type->alignement type) + "Return the byte alignment of TYPE, an RPM header entry type." + (cond ((= INT16 type) 2) + ((= INT32 type) 4) + ((= INT64 type) 8) + (else 1))) + +(define (next-aligned-offset offset alignment) + "Return the next position from OFFSET which satisfies ALIGNMENT." + (if (= 0 (modulo offset alignment)) + offset + (next-aligned-offset (1+ offset) alignment))) + +(define (header-entry->data entry) + "Return the data of ENTRY, a object, as a u8 list." + (let* ((tag (header-entry-tag entry)) + (count (header-entry-count entry)) + (value (header-entry-value entry)) + (number (rpm-tag-number tag)) + (type (rpm-tag-type tag))) + (cond + ((= STRING type) + (unless (string? value) + (error "expected string value for STRING type, got" value)) + (unless (= 1 count) + (error "count must be 1 for STRING type")) + (let ((value (cond ((= (rpm-tag-number RPMTAG_VERSION) number) + ;; Hyphens are not allowed in version strings. + (string-map (match-lambda + (#\- #\+) + (c c)) + value)) + (else value)))) + (append (bytevector->u8-list (string->utf8 value)) + (list 0)))) ;strings must end with null byte + ((= STRING_ARRAY type) + (unless (list? value) + (error "expected a list of strings for STRING_ARRAY type, got" value)) + (unless (= count (length value)) + (error "expected count to be equal to" (length value) 'got count)) + (append-map (lambda (s) + (append (bytevector->u8-list (string->utf8 s)) + (list 0))) ;null byte separated + value)) + ((member type (list INT8 INT16 INT32)) + (if (= 1 count) + (unless (number? value) + (error "expected number value for scalar INT type; got" value)) + (unless (list? value) + (error "expected list value for array INT type; got" value))) + (if (list? value) + (cond ((= INT8 type) value) + ((= INT16 type) (append-map u16-number->u8-list value)) + ((= INT32 type) (append-map u32-number->u8-list value)) + (else (error "unexpected type" type))) + (cond ((= INT8 type) (list value)) + ((= INT16 type) (u16-number->u8-list value)) + ((= INT32 type) (u32-number->u8-list value)) + (else (error "unexpected type" type))))) + ((= BIN type) + (unless (list? value) + (error "expected list value for BIN type; got" value)) + value) + (else (error "unimplemented type" type))))) + +(define (make-header-index+data entries) + "Return the index and data sections as u8 number lists, via multiple values. +An index is composed of four u32 (16 bytes total) quantities, in order: tag, +type, offset and count." + (match (fold (match-lambda* + ((entry (offset . (index . data))) + (let* ((tag (header-entry-tag entry)) + (tag-number (rpm-tag-number tag)) + (tag-type (rpm-tag-type tag)) + (count (header-entry-count entry)) + (data* (header-entry->data entry)) + (alignment (entry-type->alignement tag-type)) + (aligned-offset (next-aligned-offset offset alignment)) + (padding (make-list (- aligned-offset offset) 0))) + (cons (+ aligned-offset (length data*)) + (cons (append index + (u32-number->u8-list tag-number) + (u32-number->u8-list tag-type) + (u32-number->u8-list aligned-offset) + (u32-number->u8-list count)) + (append data padding data*)))))) + '(0 . (() . ())) + entries) + ((offset . (index . data)) + (values index data)))) + +;; Prevent inlining of the variables/procedures accessed by unit tests. +(set! make-header-index+data make-header-index+data) +(set! RPMTAG_ARCH RPMTAG_ARCH) +(set! RPMTAG_LICENSE RPMTAG_LICENSE) +(set! RPMTAG_NAME RPMTAG_NAME) +(set! RPMTAG_OS RPMTAG_OS) +(set! RPMTAG_RELEASE RPMTAG_RELEASE) +(set! RPMTAG_SUMMARY RPMTAG_SUMMARY) +(set! RPMTAG_VERSION RPMTAG_VERSION) + +(define (wrap-in-region-tags header region-tag) + "Wrap HEADER, a header provided as u8-list with REGION-TAG." + (let* ((type (rpm-tag-type region-tag)) + (header-intro (take header 16)) + (header-rest (drop header 16)) + ;; Increment the existing index value to account for the added region + ;; tag index. + (index-length (1+ (u8-list->u32-number + (drop-right (drop header-intro 8) 4)))) ;bytes 8-11 + ;; Increment the data length value to account for the added region + ;; tag data. + (data-length (+ REGION_TAG_COUNT + (u8-list->u32-number + (take-right header-intro 4))))) ;last 4 bytes of intro + (unless (member region-tag (list RPMTAG_HEADERSIGNATURES + RPMTAG_HEADERIMMUTABLE)) + (error "expected RPMTAG_HEADERSIGNATURES or RPMTAG_HEADERIMMUTABLE, got" + region-tag)) + (append (drop-right header-intro 8) ;strip existing index and data lengths + (u32-number->u8-list index-length) + (u32-number->u8-list data-length) + ;; Region tag (16 bytes). + (u32-number->u8-list (rpm-tag-number region-tag)) ;number + (u32-number->u8-list type) ;type + (u32-number->u8-list (- data-length REGION_TAG_COUNT)) ;offset + (u32-number->u8-list REGION_TAG_COUNT) ;count + ;; Immutable region. + header-rest + ;; Region tag trailer (16 bytes). Note: the trailer offset value + ;; is an enforced convention; it has no practical use. + (u32-number->u8-list (rpm-tag-number region-tag)) ;number + (u32-number->u8-list type) ;type + (s32-number->u8-list (* -1 index-length 16)) ;negative offset + (u32-number->u8-list REGION_TAG_COUNT)))) ;count + +(define (bytevector->hex-string bv) + (format #f "~{~2,'0x~}" (bytevector->u8-list bv))) + +(define (files->md5-checksums files) + "Return the MD5 checksums (formatted as hexadecimal strings) for FILES." + (let ((file-md5 (cut file-hash (hash-algorithm md5) <>))) + (map (lambda (f) + (or (and=> (false-if-exception (file-md5 f)) + bytevector->hex-string) + ;; Only regular files (e.g., not directories) can have their + ;; checksum computed. + "")) + files))) + +(define (strip-leading-dot name) + "Remove the leading \".\" from NAME, if present. If a single \".\" is +encountered, translate it to \"/\"." + (match name + ("." "/") ;special case + ((? (cut string-prefix? "." <>)) + (string-drop name 1)) + (x name))) + +;;; An extensive list of required and optional FHS directories, per its 3.0 +;;; revision. +(define %fhs-directories + (list "/bin" "/boot" "/dev" + "/etc" "/etc/opt" "/etc/X11" "/etc/sgml" "/etc/xml" + "/home" "/root" "/lib" "/media" "/mnt" + "/opt" "/opt/bin" "/opt/doc" "/opt/include" + "/opt/info" "/opt/lib" "/opt/man" + "/run" "/sbin" "/srv" "/sys" "/tmp" + "/usr" "/usr/bin" "/usr/include" "/usr/libexec" + "/usr/share/color" "/usr/share/dict" "/usr/share/doc" "/usr/share/games" + "/usr/share/info" "/usr/share/locale" "/usr/share/man" "/usr/share/misc" + "/usr/share/nls" "/usr/share/ppd" "/usr/share/sgml" + "/usr/share/terminfo" "/usr/share/tmac" "/usr/share/xml" + "/usr/share/zoneinfo" "/usr/local" "/usr/local/bin" "/usr/local/etc" + "/usr/local/games" "/usr/local/include" "/usr/local/lib" + "/usr/local/man" "/usr/local/sbin" "/usr/local/sbin" "/usr/local/share" + "/usr/local/src" "/var" "/var/account" "/var/backups" + "/var/cache" "/var/cache/fonts" "/var/cache/man" "/var/cache/www" + "/var/crash" "/var/cron" "/var/games" "/var/mail" "/var/msgs" + "/var/lib" "/var/lib/color" "/var/lib/hwclock" "/var/lib/misc" + "/var/local" "/var/lock" "/var/log" "/var/opt" "/var/preserve" + "/var/run" "/var/spool" "/var/spool/lpd" "/var/spool/mqueue" + "/var/spool/news" "/var/spool/rwho" "/var/spool/uucp" + "/var/tmp" "/var/yp")) + +(define (fhs-directory? file-name) + "Predicate to check if FILE-NAME is a known File Hierarchy Standard (FHS) +directory." + (member (strip-leading-dot file-name) %fhs-directories)) + +(define (directory->file-entries directory) + "Return the file lists triplet header entries for the files found under +DIRECTORY." + (with-directory-excursion directory + ;; Skip the initial "." directory, as its name would get concatenated with + ;; the "./" dirname and fail to match "." in the payload. + (let* ((files (cdr (find-files "." #:directories? #t))) + (file-stats (map lstat files)) + (directories + (append (list ".") + (filter-map (match-lambda + ((index . file) + (let ((st (list-ref file-stats index))) + (and (eq? 'directory (stat:type st)) + file)))) + (list-transduce (tenumerate) rcons files)))) + ;; Omit any FHS directories found in FILES to avoid the RPM package + ;; from owning them. This can occur when symlinks directives such + ;; as "/usr/bin/hello -> bin/hello" are used. + (package-files package-file-stats + (unzip2 (reverse + (fold (lambda (file stat res) + (if (fhs-directory? file) + res + (cons (list file stat) res))) + '() files file-stats)))) + + ;; When provided with the index of a file, the directory index must + ;; return the index of the corresponding directory entry. + (dirindexes (map (lambda (d) + (list-index (cut string=? <> d) directories)) + (map dirname package-files))) + ;; The files owned are those appearing in 'basenames'; own them + ;; all. + (basenames (map basename package-files)) + ;; The directory names must end with a trailing "/". + (dirnames (map (compose strip-leading-dot (cut string-append <> "/")) + directories)) + ;; Note: All the file-related entries must have the same length as + ;; the basenames entry. + (symlink-targets (map (lambda (f) + (if (symbolic-link? f) + (readlink f) + "")) ;unused + package-files)) + (file-modes (map stat:mode package-file-stats)) + (file-sizes (map stat:size package-file-stats)) + (file-md5s (files->md5-checksums package-files))) + (let ((basenames-length (length basenames)) + (dirindexes-length (length dirindexes))) + (unless (= basenames-length dirindexes-length) + (error "length mismatch for dirIndexes; expected/actual" + basenames-length dirindexes-length)) + (append + (if (> (apply max file-sizes) INT32_MAX) + (list (make-header-entry RPMTAG_LONGFILESIZES (length file-sizes) + file-sizes) + (make-header-entry RPMTAG_LONGSIZE 1 + (reduce + 0 file-sizes))) + (list (make-header-entry RPMTAG_FILESIZES (length file-sizes) + file-sizes) + (make-header-entry RPMTAG_SIZE 1 (reduce + 0 file-sizes)))) + (list + (make-header-entry RPMTAG_FILEMODES (length file-modes) file-modes) + (make-header-entry RPMTAG_FILEDIGESTS (length file-md5s) file-md5s) + (make-header-entry RPMTAG_FILEDIGESTALGO 1 RPM_HASH_MD5) + (make-header-entry RPMTAG_FILELINKTOS (length symlink-targets) + symlink-targets) + (make-header-entry RPMTAG_FILEUSERNAME basenames-length + (make-list basenames-length "root")) + (make-header-entry RPMTAG_GROUPNAME basenames-length + (make-list basenames-length "root")) + ;; The dirindexes, basenames and dirnames tags form the so-called RPM + ;; "path triplet". + (make-header-entry RPMTAG_DIRINDEXES dirindexes-length dirindexes) + (make-header-entry RPMTAG_BASENAMES basenames-length basenames) + (make-header-entry RPMTAG_DIRNAMES (length dirnames) dirnames))))))) + +(define (make-header entries) + "Return the u8 list of a RPM header containing ENTRIES, a list of + objects." + (let* ((entries (sort entries (lambda (x y) + (< (rpm-tag-number (header-entry-tag x)) + (rpm-tag-number (header-entry-tag y)))))) + (count (length entries)) + (index data (make-header-index+data entries))) + (append header-intro ;8 bytes + (u32-number->u8-list count) ;4 bytes + (u32-number->u8-list (length data)) ;4 bytes + ;; Now starts the header index, which can contain up to 32 entries + ;; of 16 bytes each. + index data))) + +(define* (generate-header name version + payload-digest + payload-directory + payload-compressor + #:key + relocatable? + prein-file postin-file + preun-file postun-file + (target %host-type) + (release "0") + (license "N/A") + (summary "RPM archive generated by GNU Guix.") + (os "Linux")) ;see rpmrc.in + "Return the u8 list corresponding to the Header section. PAYLOAD-DIGEST is +the SHA256 checksum string of the compressed payload. PAYLOAD-DIRECTORY is +the directory containing the payload files. PAYLOAD-COMPRESSOR is the name of +the compressor used to compress the CPIO payload, such as \"none\", \"gz\", +\"xz\" or \"zstd\"." + (let* ((rpm-arch (gnu-machine-type->rpm-arch + (gnu-system-triplet->machine-type target))) + (file->string (cut call-with-input-file <> get-string-all)) + (prein-script (and=> prein-file file->string)) + (postin-script (and=> postin-file file->string)) + (preun-script (and=> preun-file file->string)) + (postun-script (and=> postun-file file->string))) + (wrap-in-region-tags + (make-header (append + (list (make-header-entry RPMTAG_HEADERI18NTABLE 1 (list "C")) + (make-header-entry RPMTAG_NAME 1 name) + (make-header-entry RPMTAG_VERSION 1 version) + (make-header-entry RPMTAG_RELEASE 1 release) + (make-header-entry RPMTAG_SUMMARY 1 summary) + (make-header-entry RPMTAG_LICENSE 1 license) + (make-header-entry RPMTAG_OS 1 os) + (make-header-entry RPMTAG_ARCH 1 rpm-arch)) + (directory->file-entries payload-directory) + (if relocatable? + ;; Note: RPMTAG_PREFIXES must not have a trailing + ;; slash, unless it's '/'. This allows installing the + ;; package via 'rpm -i --prefix=/tmp', for example. + (list (make-header-entry RPMTAG_PREFIXES 1 (list "/"))) + '()) + (if prein-script + (list (make-header-entry RPMTAG_PREIN 1 prein-script)) + '()) + (if postin-script + (list (make-header-entry RPMTAG_POSTIN 1 postin-script)) + '()) + (if preun-script + (list (make-header-entry RPMTAG_PREUN 1 preun-script)) + '()) + (if postun-script + (list (make-header-entry RPMTAG_POSTUN 1 postun-script)) + '()) + (if (string=? "none" payload-compressor) + '() + (list (make-header-entry RPMTAG_PAYLOADCOMPRESSOR 1 + payload-compressor))) + (list (make-header-entry RPMTAG_ENCODING 1 "utf-8") + (make-header-entry RPMTAG_PAYLOADFORMAT 1 "cpio") + (make-header-entry RPMTAG_PAYLOADDIGEST 1 + (list payload-digest)) + (make-header-entry RPMTAG_PAYLOADDIGESTALGO 1 + RPM_HASH_SHA256)))) + RPMTAG_HEADERIMMUTABLE))) + + +;;; +;;; Signature section +;;; + +;;; Header sha256 checksum. +(define RPMSIGTAG_SHA256 (make-rpm-tag 273 STRING)) +;;; Uncompressed payload size. +(define RPMSIGTAG_PAYLOADSIZE (make-rpm-tag 1007 INT32)) +;;; Header and compressed payload combined size. +(define RPMSIGTAG_SIZE (make-rpm-tag 1000 INT32)) +;;; Uncompressed payload size (when size > max u32). +(define RPMSIGTAG_LONGARCHIVESIZE (make-rpm-tag 271 INT64)) +;;; Header and compressed payload combined size (when size > max u32). +(define RPMSIGTAG_LONGSIZE (make-rpm-tag 270 INT64)) +;;; Extra space reserved for signatures (typically 32 bytes). +(define RPMSIGTAG_RESERVEDSPACE (make-rpm-tag 1008 BIN)) + +(define (generate-signature header-sha256 + header+compressed-payload-size + ;; uncompressed-payload-size + ) + "Return the u8 list representing a signature header containing the +HEADER-SHA256 (a string) and the PAYLOAD-SIZE, which is the combined size of +the header and compressed payload." + (define size-tag (if (> header+compressed-payload-size INT32_MAX) + RPMSIGTAG_LONGSIZE + RPMSIGTAG_SIZE)) + (wrap-in-region-tags + (make-header (list (make-header-entry RPMSIGTAG_SHA256 1 header-sha256) + (make-header-entry size-tag 1 + header+compressed-payload-size) + ;; (make-header-entry RPMSIGTAG_PAYLOADSIZE 1 + ;; uncompressed-payload-size) + ;; Reserve 32 bytes of extra space in case users would + ;; like to add signatures, as done in rpmGenerateSignature. + (make-header-entry RPMSIGTAG_RESERVEDSPACE 32 + (make-list 32 0)))) + RPMTAG_HEADERSIGNATURES)) + +(define (assemble-rpm-metadata lead signature header) + "Align and append the various u8 list components together, and return the +result as a bytevector." + (let* ((offset (+ (length lead) (length signature))) + (header-offset (next-aligned-offset offset 8)) + (padding (make-list (- header-offset offset) 0))) + ;; The Header is 8-bytes aligned. + (u8-list->bytevector (append lead signature padding header)))) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 77425e5b0f..701e41ff1a 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -5,7 +5,7 @@ ;;; Copyright © 2018 Chris Marusich ;;; Copyright © 2018 Efraim Flashner ;;; Copyright © 2020 Tobias Geerinckx-Rice -;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer +;;; Copyright © 2020, 2021, 2022, 2023 Maxim Cournoyer ;;; Copyright © 2020 Eric Bavier ;;; Copyright © 2022 Alex Griffin ;;; @@ -67,6 +67,7 @@ (define-module (guix scripts pack) self-contained-tarball debian-archive + rpm-archive docker-image squashfs-image @@ -856,6 +857,166 @@ (define tar (string-append #+archiver "/bin/tar")) ;;; +;;; RPM archive format. +;;; +(define* (rpm-archive name profile + #:key target + (profile-name "guix-profile") + entry-point + (compressor (first %compressors)) + deduplicate? + localstatedir? + (symlinks '()) + archiver + (extra-options '())) + "Return a RPM archive (.rpm) containing a store initialized with the closure +of PROFILE, a derivation. The archive contains /gnu/store. SYMLINKS must be +a list of (SOURCE -> TARGET) tuples denoting symlinks to be added to the pack. +ARCHIVER and ENTRY-POINT are not used. RELOCATABLE?, PREIN-FILE, POSTIN-FILE, +PREUN-FILE and POSTUN-FILE can be provided via EXTRA-OPTIONS." + (when entry-point + (warning (G_ "entry point not supported in the '~a' format~%") 'rpm)) + + (define root (populate-profile-root profile + #:profile-name profile-name + #:target target + #:localstatedir? localstatedir? + #:deduplicate? deduplicate? + #:symlinks symlinks)) + + (define payload + (let* ((raw-cpio-file-name "payload.cpio") + (compressed-cpio-file-name (string-append raw-cpio-file-name + (compressor-extension + compressor)))) + (computed-file compressed-cpio-file-name + (with-imported-modules (source-module-closure + '((guix build utils) + (guix cpio) + (guix rpm))) + #~(begin + (use-modules (guix build utils) + (guix cpio) + (guix rpm) + (srfi srfi-1)) + + ;; Make sure non-ASCII file names are properly handled. + #+(set-utf8-locale profile) + + (define %root (if #$localstatedir? "." #$root)) + + (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)) + + (call-with-output-file #$raw-cpio-file-name + (lambda (port) + (with-directory-excursion %root + ;; The first "." entry is discarded. + (write-cpio-archive + (remove fhs-directory? + (cdr (find-files "." #:directories? #t))) + port)))) + (when #+(compressor-command compressor) + (apply invoke (append #+(compressor-command compressor) + (list #$raw-cpio-file-name)))) + (copy-file #$compressed-cpio-file-name #$output))) + #:local-build? #f))) ;allow offloading + + (define build + (with-extensions (list guile-gcrypt) + (with-imported-modules `(((guix config) => ,(make-config.scm)) + ,@(source-module-closure + `((gcrypt hash) + (guix build utils) + (guix profiles) + (guix rpm)) + #:select? not-config?)) + #~(begin + (use-modules (gcrypt hash) + (guix build utils) + (guix profiles) + (guix rpm) + (ice-9 binary-ports) + (ice-9 match) ;for manifest->friendly-name + (ice-9 optargs) + (rnrs bytevectors) + (srfi srfi-1)) + + (define machine-type + (and=> (or #$target %host-type) + (lambda (triplet) + (first (string-split triplet #\-))))) + + #$(procedure-source manifest->friendly-name) + + (define manifest (profile-manifest #$profile)) + + (define single-entry ;manifest entry + (match (manifest-entries manifest) + ((entry) + entry) + (_ #f))) + + (define name + (or (and=> single-entry manifest-entry-name) + (manifest->friendly-name manifest))) + + (define version + (or (and=> single-entry manifest-entry-version) "0.0.0")) + + (define lead + (generate-lead (string-append name "-" version) + #:target (or #$target %host-type))) + + (define payload-digest + (bytevector->hex-string (file-sha256 #$payload))) + + (let-keywords '#$extra-options #f ((relocatable? #f) + (prein-file #f) + (postin-file #f) + (preun-file #f) + (postun-file #f)) + + (let ((header (generate-header name version + payload-digest + #$root + #$(compressor-name compressor) + #:target (or #$target %host-type) + #:relocatable? relocatable? + #:prein-file prein-file + #:postin-file postin-file + #:preun-file preun-file + #:postun-file postun-file))) + + (define header-sha256 + (bytevector->hex-string (sha256 (u8-list->bytevector header)))) + + (define payload-size (stat:size (stat #$payload))) + + (define header+compressed-payload-size + (+ (length header) payload-size)) + + (define signature + (generate-signature header-sha256 + header+compressed-payload-size)) + + ;; Serialize the archive components to a file. + (call-with-input-file #$payload + (lambda (in) + (call-with-output-file #$output + (lambda (out) + (put-bytevector out (assemble-rpm-metadata lead + signature + header)) + (sendfile out in payload-size))))))))))) + + (gexp->derivation (string-append name ".rpm") build)) + + +;;; ;;; Compiling C programs. ;;; @@ -1187,7 +1348,8 @@ (define %formats `((tarball . ,self-contained-tarball) (squashfs . ,squashfs-image) (docker . ,docker-image) - (deb . ,debian-archive))) + (deb . ,debian-archive) + (rpm . ,rpm-archive))) (define (show-formats) ;; Print the supported pack formats. @@ -1201,18 +1363,22 @@ (define (show-formats) docker Tarball ready for 'docker load'")) (display (G_ " deb Debian archive installable via dpkg/apt")) + (display (G_ " + rpm RPM archive installable via rpm/yum")) (newline)) +(define (required-option symbol) + "Return an SYMBOL option that requires a value." + (option (list (symbol->string symbol)) #t #f + (lambda (opt name arg result . rest) + (apply values + (alist-cons symbol arg result) + rest)))) + (define %deb-format-options - (let ((required-option (lambda (symbol) - (option (list (symbol->string symbol)) #t #f - (lambda (opt name arg result . rest) - (apply values - (alist-cons symbol arg result) - rest)))))) - (list (required-option 'control-file) - (required-option 'postinst-file) - (required-option 'triggers-file)))) + (list (required-option 'control-file) + (required-option 'postinst-file) + (required-option 'triggers-file))) (define (show-deb-format-options) (display (G_ " @@ -1231,6 +1397,32 @@ (define (show-deb-format-options/detailed) (newline) (exit 0)) +(define %rpm-format-options + (list (required-option 'prein-file) + (required-option 'postin-file) + (required-option 'preun-file) + (required-option 'postun-file))) + +(define (show-rpm-format-options) + (display (G_ " + --help-rpm-format list options specific to the RPM format"))) + +(define (show-rpm-format-options/detailed) + (display (G_ " + --prein-file=FILE + Embed the provided prein script")) + (display (G_ " + --postin-file=FILE + Embed the provided postin script")) + (display (G_ " + --preun-file=FILE + Embed the provided preun script")) + (display (G_ " + --postun-file=FILE + Embed the provided postun script")) + (newline) + (exit 0)) + (define %options ;; Specifications of the command-line options. (cons* (option '(#\h "help") #f #f @@ -1307,7 +1499,12 @@ (define %options (lambda args (show-deb-format-options/detailed))) + (option '("help-rpm-format") #f #f + (lambda args + (show-rpm-format-options/detailed))) + (append %deb-format-options + %rpm-format-options %transformation-options %standard-build-options %standard-cross-build-options @@ -1325,6 +1522,7 @@ (define (show-help) (show-transformation-options-help) (newline) (show-deb-format-options) + (show-rpm-format-options) (newline) (display (G_ " -f, --format=FORMAT build a pack in the given FORMAT")) @@ -1483,6 +1681,16 @@ (define (process-file-arg opts name) (process-file-arg opts 'postinst-file) #:triggers-file (process-file-arg opts 'triggers-file))) + ('rpm + (list #:relocatable? relocatable? + #:prein-file + (process-file-arg opts 'prein-file) + #:postin-file + (process-file-arg opts 'postin-file) + #:preun-file + (process-file-arg opts 'preun-file) + #:postun-file + (process-file-arg opts 'postun-file))) (_ '()))) (target (assoc-ref opts 'target)) (bootstrap? (assoc-ref opts 'bootstrap?)) diff --git a/tests/pack.scm b/tests/pack.scm index a02924b7d2..734ae1c69b 100644 --- a/tests/pack.scm +++ b/tests/pack.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2018 Ricardo Wurmus -;;; Copyright © 2021 Maxim Cournoyer +;;; Copyright © 2021, 2023 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -28,13 +28,16 @@ (define-module (test-pack) #:use-module (guix tests) #:use-module (guix gexp) #:use-module (guix modules) + #:use-module (guix utils) #:use-module (gnu packages) #:use-module ((gnu packages base) #:select (glibc-utf8-locales)) #:use-module (gnu packages bootstrap) + #:use-module ((gnu packages package-management) #:select (rpm)) #:use-module ((gnu packages compression) #:select (squashfs-tools)) #:use-module ((gnu packages debian) #:select (dpkg)) #:use-module ((gnu packages guile) #:select (guile-sqlite3)) #:use-module ((gnu packages gnupg) #:select (guile-gcrypt)) + #:use-module ((gnu packages linux) #:select (fakeroot)) #:use-module (srfi srfi-64)) (define %store @@ -59,6 +62,17 @@ (define %tar-bootstrap %bootstrap-coreutils&co) (define %ar-bootstrap %bootstrap-binutils) +;;; This is a variant of the RPM package configured so that its database can +;;; be created on a writable location readily available inside the build +;;; container ("/tmp"). +(define rpm-for-tests + (package + (inherit rpm) + (arguments (substitute-keyword-arguments (package-arguments rpm) + ((#:configure-flags flags '()) + #~(cons "--localstatedir=/tmp" + (delete "--localstatedir=/var" #$flags))))))) + (test-begin "pack") @@ -355,6 +369,47 @@ (define hard-links (stat "postinst")))))) (assert (file-exists? "triggers")) + (mkdir #$output)))))) + (built-derivations (list check)))) + + (unless store (test-skip 1)) + (test-assertm "rpm archive can be installed/uninstalled" store + (mlet* %store-monad + ((guile (set-guile-for-build (default-guile))) + (profile (profile-derivation (packages->manifest + (list %bootstrap-guile)) + #:hooks '() + #:locales? #f)) + (rpm-pack (rpm-archive "rpm-pack" profile + #:compressor %gzip-compressor + #:symlinks '(("/bin/guile" -> "bin/guile")) + #:extra-options '(#:relocatable? #t))) + (check + (gexp->derivation "check-rpm-pack" + (with-imported-modules (source-module-closure + '((guix build utils))) + #~(begin + (use-modules (guix build utils)) + + (define fakeroot #+(file-append fakeroot "/bin/fakeroot")) + (define rpm #+(file-append rpm-for-tests "/bin/rpm")) + (mkdir-p "/tmp/lib/rpm") + + ;; Install the RPM package. This causes RPM to validate the + ;; signatures, header as well as the file digests, which + ;; makes it a rather thorough test. + (mkdir "test-prefix") + (invoke fakeroot rpm "--install" + (string-append "--prefix=" (getcwd) "/test-prefix") + #$rpm-pack) + + ;; Invoke the installed Guile command. + (invoke "./test-prefix/bin/guile" "--version") + + ;; Uninstall the RPM package. + (invoke fakeroot rpm "--erase" "guile-bootstrap") + + ;; Required so the above is run. (mkdir #$output)))))) (built-derivations (list check))))) diff --git a/tests/rpm.scm b/tests/rpm.scm new file mode 100644 index 0000000000..f40b36fe60 --- /dev/null +++ b/tests/rpm.scm @@ -0,0 +1,86 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2023 Maxim Cournoyer +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (test-rpm) + #:use-module (guix rpm) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-64) + #:use-module (srfi srfi-71)) + +;; For white-box testing. +(define-syntax-rule (expose-internal name) + (define name (@@ (guix rpm) name))) + +(expose-internal RPMTAG_ARCH) +(expose-internal RPMTAG_LICENSE) +(expose-internal RPMTAG_NAME) +(expose-internal RPMTAG_OS) +(expose-internal RPMTAG_RELEASE) +(expose-internal RPMTAG_SUMMARY) +(expose-internal RPMTAG_VERSION) +(expose-internal header-entry-count) +(expose-internal header-entry-tag) +(expose-internal header-entry-value) +(expose-internal header-entry?) +(expose-internal make-header) +(expose-internal make-header-entry) +(expose-internal make-header-index+data) + +(test-begin "rpm") + +(test-equal "lead must be 96 bytes long" + 96 + (length (generate-lead "hello-2.12.1"))) + +(define header-entries + (list (make-header-entry RPMTAG_NAME 1 "hello") + (make-header-entry RPMTAG_VERSION 1 "2.12.1") + (make-header-entry RPMTAG_RELEASE 1 "0") + (make-header-entry RPMTAG_SUMMARY 1 + "Hello, GNU world: An example GNU package") + (make-header-entry RPMTAG_LICENSE 1 "GPL 3 or later") + (make-header-entry RPMTAG_OS 1 "Linux") + (make-header-entry RPMTAG_ARCH 1 "x86_64"))) + +(define expected-header-index-length + (* 16 (length header-entries))) ;16 bytes per index entry + +(define expected-header-data-length + (+ (length header-entries) ;to account for null bytes + (fold + 0 (map (compose string-length (cut header-entry-value <>)) + header-entries)))) + +(let ((index data (make-header-index+data header-entries))) + (test-equal "header index" + expected-header-index-length + (length index)) + + ;; This test depends on the fact that only STRING entries are used, and that + ;; they are composed of single byte characters and the delimiting null byte. + (test-equal "header data" + expected-header-data-length + (length data))) + +(test-equal "complete header section" + (+ 16 ;leading magic + count bytes + expected-header-index-length expected-header-data-length) + (length (make-header header-entries))) + +(test-end) From patchwork Fri Feb 17 01:49:36 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 47030 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 1693416958; Fri, 17 Feb 2023 01:52:17 +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 autolearn=ham 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 A5DF41693E for ; Fri, 17 Feb 2023 01:52:16 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pSpu5-0007iN-12; 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 1pSptx-0007eS-1l for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:07 -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 1pSptw-0004Nt-Lf for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:04 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pSptw-0007Vs-Ik for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#61255] [PATCH v2 7/8] etc: Add a news entry snippet. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 17 Feb 2023 01:51:04 +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: ludo@gnu.org, Maxim Cournoyer Received: via spool by 61255-submit@debbugs.gnu.org id=B61255.167659863228783 (code B ref 61255); Fri, 17 Feb 2023 01:51:04 +0000 Received: (at 61255) by debbugs.gnu.org; 17 Feb 2023 01:50:32 +0000 Received: from localhost ([127.0.0.1]:38087 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pSptQ-0007UA-AD for submit@debbugs.gnu.org; Thu, 16 Feb 2023 20:50:32 -0500 Received: from mail-qv1-f42.google.com ([209.85.219.42]:44821) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pSptG-0007Sx-HY for 61255@debbugs.gnu.org; Thu, 16 Feb 2023 20:50:22 -0500 Received: by mail-qv1-f42.google.com with SMTP id ks14so355292qvb.11 for <61255@debbugs.gnu.org>; Thu, 16 Feb 2023 17:50:22 -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=FINmKnixy4cvcTNdQpEc/ZQRC4RvZ6cTnUdv0W5G1hw=; b=qE7EgwFv3P/rtaFDLdfRvppPqan7RIPmeuJFKji4g99yV0tFRDf4l49Yhwzn+JxGIq y5ILsetCPb8wW23YgZcRZnujNFzwjzznqNbGdkvO2cPxwTkgWPKu1kp6WjMjxSOftxUG W4A1SlGiYe8Co+uMkT0fEOiZvJQTB2j0wF0HZLwpdcrVbljYYseoAeoglFuzCLG2wMw2 8FwmDi1VBLam80KBYtJVr2nXCQMcY4R/71i2FAf3bOSAfx//UF+APg795+Fve0nYlQ/+ sEX0XnpP9/G5dXvXzEn0hXvG0xTuwVIKWGT1369KIUVeSYL31P31N6aCs9vJ0XWTL8LO 0XFw== 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=FINmKnixy4cvcTNdQpEc/ZQRC4RvZ6cTnUdv0W5G1hw=; b=rGnY8Vti0Tm84XpPIKYfUCBrdq8Bp4WpgsrhITaMJb902CUxx8ImJHBJK8nzaV7gQx 4/QMidAPj3W2DsA1DUY6UjRTtSnhWWMFN3Wl+MTNRF24Fa1T9c80UQtdX1bF2PUj9Ls1 R93cbWKNn9/aP1VhOyZs4Xg4lxv+c3qh0mnVDbM60HbRRSdRA/t6KldfbDNf4voLBndn fGJtAxZQgcjmQ8jBHtgi3uuyW7p7HTVd45r5Kip7UcnUx8EhNX75vWG3tpiyPR8b6N8C hJLN+TQ1v8Q02ZPjUoXeyn8WbArWHjSp0Jbvp7YAW7KvEi9k1Si8VKHB+sbMVF62X7jl BYCg== X-Gm-Message-State: AO0yUKWcvpVaRuTL8c6s1oN17DDAyfQN7N8pBHveRh7Awb3x8RcxGszg +WKvLKz8dCdfgkVHEFBxRDf/q8AVYwMbKjXi X-Google-Smtp-Source: AK7set9Dg2fuVwF9YROLtyvOLDccIRXK0qQMzWugT/1j6YFKXcY46yaS2qGJgRJzTdC8J1JlUf1/Og== X-Received: by 2002:a05:6214:5299:b0:56e:a6f1:8db with SMTP id kj25-20020a056214529900b0056ea6f108dbmr15979899qvb.20.1676598616931; Thu, 16 Feb 2023 17:50:16 -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.16 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 16 Feb 2023 17:50:16 -0800 (PST) From: Maxim Cournoyer Date: Fri, 17 Feb 2023 02:49:36 +0100 Message-Id: <20230217014938.20919-8-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 * etc/snippets/yas/scheme-mode/guix-news-entry: New file. --- Changes in v2: - New commit etc/snippets/yas/scheme-mode/guix-news-entry | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 etc/snippets/yas/scheme-mode/guix-news-entry diff --git a/etc/snippets/yas/scheme-mode/guix-news-entry b/etc/snippets/yas/scheme-mode/guix-news-entry new file mode 100644 index 0000000000..7f5bb21c50 --- /dev/null +++ b/etc/snippets/yas/scheme-mode/guix-news-entry @@ -0,0 +1,9 @@ +# -*- mode: snippet -*- +# name: guix-news-entry +# key: entry... +# -- +(entry (commit "$1") + (title + (en "$2")) + (body + (en "$3"))) From patchwork Fri Feb 17 01:49:37 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 47027 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 B30F016952; Fri, 17 Feb 2023 01:51:57 +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 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 EFD721693E for ; Fri, 17 Feb 2023 01:51:55 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pSpu6-0007ju-GV; Thu, 16 Feb 2023 20:51:14 -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 1pSptx-0007eU-9t for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:07 -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 1pSptx-0004O6-1e for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:05 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pSptw-0007Vz-Ue for guix-patches@gnu.org; Thu, 16 Feb 2023 20:51:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#61255] [PATCH v2 8/8] news: Add entry for the new 'rpm' guix pack format. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 17 Feb 2023 01:51:04 +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: Julien Lepiller , ludo@gnu.org, Florian Pelz , Maxim Cournoyer , Thiago Jung Bauermann Received: via spool by 61255-submit@debbugs.gnu.org id=B61255.167659863328790 (code B ref 61255); Fri, 17 Feb 2023 01:51:04 +0000 Received: (at 61255) by debbugs.gnu.org; 17 Feb 2023 01:50:33 +0000 Received: from localhost ([127.0.0.1]:38089 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pSptQ-0007UC-KG for submit@debbugs.gnu.org; Thu, 16 Feb 2023 20:50:33 -0500 Received: from mail-qt1-f173.google.com ([209.85.160.173]:41962) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pSptH-0007T4-V6 for 61255@debbugs.gnu.org; Thu, 16 Feb 2023 20:50:24 -0500 Received: by mail-qt1-f173.google.com with SMTP id z5so4150519qtn.8 for <61255@debbugs.gnu.org>; Thu, 16 Feb 2023 17:50:23 -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=h6eeWVhFS4/P4mj5jVKi+2tCRKAgXHX5V9OpJjZRF4k=; b=QRPZ/tOKLdw5Em6ZMrdX31SORvJxT1sylPmMNEBpd3bGdAKw9/wCuvzTPNjp/wloXe IRhmHv2BKyxpNazDq5Ja67F/ZaszPntWPXL6F1DF30Z2QpBovHyt+F0ZLNi+dagQ+NBc BEtKFZV9MR3P+BrMHyTnlDqjYEHbD5OBYNF/BacWHHRFM1aWLlzGhBUhnPJf1nmjgYdh V0G0NkEiM/ccgpXXrHk/7T8z6WkymVrbzBJKu/n5P7M0TPtNGw9HTmwffFP6KJhZfidM Y8DVT9m31gmy6CWN6Qc32l9dBIDgFAHhj57FqaCTluFPOzZaQ98FYi+W+38aTjmqZSQF CYDg== 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=h6eeWVhFS4/P4mj5jVKi+2tCRKAgXHX5V9OpJjZRF4k=; b=R+61tv09FBF0lPrwY8gP/bxobTrW9FNKC6W0Zi30QxlhTHuMeR8VC4Bc/8VBcR0kPb 85HmulFD26cCwEaFkv+Ktrv9YOl0PWRGqv3EDvidXItqTnRqH/xD/6O2ue7iBYEfywoi fHPpcYNHFdCpuHNaQ14ddvItnCQEqdssKjBTmMb4RJHskLpZeDBmB/DtCa480fQMzO+6 kFQmQeXzupGvqOgLGqVPs4+f7ofgBtjtIALLV5PzNkJ7Abaiw4rFFIXiszX/pSeeqooX JXKQmcfAu6rmZmecRB6yCecTUcirt/zt0MPyo0RN5C0doQKgvely+FzGWDrAj5RVXD5a fHMQ== X-Gm-Message-State: AO0yUKXOgIXE9x5CejlfYSaX6ju9EyApe7PGk5SvqAI8c6IW6E63oj3v xaO5V0ZlZCFdGgILiC4cfdJltpTSkfp8oLo0 X-Google-Smtp-Source: AK7set83HT0KMkUV0e/ZfuFnlTXtbwqWxEqi9HaW+mW5o3hcGfjkK8GTEXdC1hWvEZyvy61NO2IE8Q== X-Received: by 2002:ac8:5b4e:0:b0:3b9:b7c9:f0ce with SMTP id n14-20020ac85b4e000000b003b9b7c9f0cemr31636qtw.38.1676598618247; Thu, 16 Feb 2023 17:50:18 -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.17 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 16 Feb 2023 17:50:17 -0800 (PST) From: Maxim Cournoyer Date: Fri, 17 Feb 2023 02:49:37 +0100 Message-Id: <20230217014938.20919-9-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 * etc/news.scm: Add entry. --- Changes in v2: - New commit etc/news.scm | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/etc/news.scm b/etc/news.scm index 211a176170..1eefdd1636 100644 --- a/etc/news.scm +++ b/etc/news.scm @@ -9,7 +9,7 @@ ;; Copyright © 2020, 2022 Marius Bakke ;; Copyright © 2020, 2021 Mathieu Othacehe ;; Copyright © 2020 Jan (janneke) Nieuwenhuizen -;; Copyright © 2020, 2021, 2022 Maxim Cournoyer +;; Copyright © 2020, 2021, 2022, 2023 Maxim Cournoyer ;; Copyright © 2021 Leo Famulari ;; Copyright © 2021 Zhu Zihao ;; Copyright © 2021 Chris Marusich @@ -26,6 +26,21 @@ (channel-news (version 0) + (entry (commit "63622d2a234b707be5df07d8290a81b3247947e7") + (title + (en "New @samp{rpm} format for the @command{guix pack} command")) + (body + (en "RPM archives (with the .rpm file extension) can now be produced +via the @command{guix pack --format=rpm} command, providing an alternative +distribution path for software built with Guix. Here is a simple example that +generates an RPM archive for the @code{hello} package: + +@example +guix pack --format=rpm --symlink=/usr/bin/hello=bin/hello hello +@end example + +See @command{info \"(guix) Invoking guix pack\"} for more information."))) + (entry (commit "137b91f03bbb7f1df71cf10c4f79ae57fbcea400") (title (en "New @option{--with-version} package transformation option")