From patchwork Mon Jan 18 16:51:20 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 26467 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 D180727BC15; Mon, 18 Jan 2021 17:18:35 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H4, RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,T_DKIM_INVALID autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 84E3E27BC14 for ; Mon, 18 Jan 2021 17:18:35 +0000 (GMT) Received: from localhost ([::1]:44352 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1l1YAk-0003be-LM for patchwork@mira.cbaines.net; Mon, 18 Jan 2021 12:18:34 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:42032) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1l1Xl4-0002cr-00 for guix-patches@gnu.org; Mon, 18 Jan 2021 11:52:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:36597) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1l1Xl3-0005jy-Nc for guix-patches@gnu.org; Mon, 18 Jan 2021 11:52:01 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1l1Xl3-0000lB-Km for guix-patches@gnu.org; Mon, 18 Jan 2021 11:52:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#45774] [PATCH core-updates v3 1/2] utils: Retrieve the store prefix from NIX_STORE_DIR, not STORE_DIR. References: <20210110200535.24377-1-maxim.cournoyer@gmail.com> In-Reply-To: <20210110200535.24377-1-maxim.cournoyer@gmail.com> Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 18 Jan 2021 16:52:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 45774 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 45774@debbugs.gnu.org X-Debbugs-Original-To: guix-patches@gnu.org, 45774@debbugs.gnu.org Received: via spool by 45774-submit@debbugs.gnu.org id=B45774.16109887202913 (code B ref 45774); Mon, 18 Jan 2021 16:52:01 +0000 Received: (at 45774) by debbugs.gnu.org; 18 Jan 2021 16:52:00 +0000 Received: from localhost ([127.0.0.1]:48143 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1l1Xl1-0000kv-Oi for submit@debbugs.gnu.org; Mon, 18 Jan 2021 11:51:59 -0500 Received: from mail-qt1-f175.google.com ([209.85.160.175]:34054) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1l1Xl0-0000kJ-5n for 45774@debbugs.gnu.org; Mon, 18 Jan 2021 11:51:58 -0500 Received: by mail-qt1-f175.google.com with SMTP id c1so11702062qtc.1 for <45774@debbugs.gnu.org>; Mon, 18 Jan 2021 08:51:58 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:mime-version :content-transfer-encoding; bh=OT+qmkYntdzslMt0aEa0WPokhkPkZCvzMN7Y3wqDnes=; b=MGIIzkkXNRDniu9tx6tBn4mtgzV58V/BdDbuln+Auo/2t3wpbwSWkqyu0y9RR2GjYJ CNnp0qZn6zHTaO389bUYy1c5ulSBKKwrXm/vkcn3hOId+GM89NIKCEE2y9UFl6liTQ05 cW6hKgmGJdyViAw0zoi17bOc2f3a8mktZMM1C/bn8x9TMeJVfHb4rlsVGbF8p2MsqZHq DZB8gEG8RLfbL5WWNxsNl3zSy+k50HdokJ0B4KC3leuv4L5mm8oQTSYAo215mwDR867/ DkHRO6OeSlHLVYxJqV2bNdJWozcKxlGKo5DBRY45DNimf8h6hq9Kf3gW9IAwA0yqsTn6 cqhQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:mime-version :content-transfer-encoding; bh=OT+qmkYntdzslMt0aEa0WPokhkPkZCvzMN7Y3wqDnes=; b=keuPsI5opZj9y/evXy4A8lxFSy70QqdaGXeG1t1nnHHsEU+qYVEILCRpno3b03ffvj GY/Qcg+P+jC2afzI7CFC8uQVbli/g5y9BqcSc4bIRA2uuwIGG85sNS1x+K7bxRYlaS68 TLvpRG5PLkERjY5E0/keUg/7OSpfONrgwCLXVQ69vULmoSH6otJTQE8DFq/aFi6ZJNmz 3l5IFhDQJP/gK2tzayO+0M2mMQEI8bxb2hR9h32hVDTjeD8TXugy5ujJIotpSOFhb5Ey TjvV7ifzJvUR4uCaG/qLq1WHGIC46tzx2ALyHsj0n5ReksMB7+o9/nztlNksPS5801Bu O7nA== X-Gm-Message-State: AOAM531PjuciNxD7bXD/Nzu72YFSQHDkuPx+yLNBB1ESHbr0WzF7sd0x L1VmuLfCIPIQTGZf18zDwvs= X-Google-Smtp-Source: ABdhPJyfKMzqWFsk/bgqojpzFO8Y4j46+Op/f5deK+0ZPoI3p49cLfQ1DPxnDQAIXRpUlNxBr/2k8Q== X-Received: by 2002:ac8:6edd:: with SMTP id f29mr454223qtv.213.1610988712453; Mon, 18 Jan 2021 08:51:52 -0800 (PST) Received: from localhost.localdomain (dsl-149-228.b2b2c.ca. [66.158.149.228]) by smtp.gmail.com with ESMTPSA id m64sm10992602qkb.90.2021.01.18.08.51.51 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 18 Jan 2021 08:51:51 -0800 (PST) From: Maxim Cournoyer Date: Mon, 18 Jan 2021 11:51:20 -0500 Message-Id: <20210118165122.25813-1-maxim.cournoyer@gmail.com> X-Mailer: git-send-email 2.29.2 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" X-getmail-retrieved-from-mailbox: Patches On the daemon side, nixStore gets set to the environment variable NIX_STORE_DIR, else the environment variable NIX_STORE else the compile time macro NIX_STORE_DIR (see the Settings::processEnvironment method in nix/libstore/globals.cc). Hence, it is more appropriate to lookup the environment variable NIX_STORE_DIR than NIX_STORE in (guix build utils). * guix/build/utils.scm (%store-directory): Call getenv with NIX_STORE_DIR instead of NIX_STORE. --- guix/build/utils.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 76180e67e0..2cbdb31505 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -144,7 +144,7 @@ (define (%store-directory) "Return the directory name of the store." - (or (getenv "NIX_STORE") + (or (getenv "NIX_STORE_DIR") "/gnu/store")) (define (store-file-name? file) From patchwork Mon Jan 18 16:51:21 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 26468 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 EE32F27BC15; Mon, 18 Jan 2021 17:19:47 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H4, RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,T_DKIM_INVALID,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 9C18627BC14 for ; Mon, 18 Jan 2021 17:19:45 +0000 (GMT) Received: from localhost ([::1]:45300 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1l1YBs-00044H-Ri for patchwork@mira.cbaines.net; Mon, 18 Jan 2021 12:19:44 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:42430) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1l1Xm4-0003Hc-JA for guix-patches@gnu.org; Mon, 18 Jan 2021 11:53:06 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:36621) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1l1Xm3-00060D-CL for guix-patches@gnu.org; Mon, 18 Jan 2021 11:53:04 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1l1Xm3-0000oI-B3 for guix-patches@gnu.org; Mon, 18 Jan 2021 11:53:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#45774] [PATCH core-updates v3 2/2] build-systems/gnu: Allow unpacking/repacking more kind of files. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 18 Jan 2021 16:53:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 45774 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 45774@debbugs.gnu.org X-Debbugs-Original-To: guix-patches@gnu.org, 45774@debbugs.gnu.org Received: via spool by 45774-submit@debbugs.gnu.org id=B45774.16109887332983 (code B ref 45774); Mon, 18 Jan 2021 16:53:03 +0000 Received: (at 45774) by debbugs.gnu.org; 18 Jan 2021 16:52:13 +0000 Received: from localhost ([127.0.0.1]:48152 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1l1Xl7-0000lp-Im for submit@debbugs.gnu.org; Mon, 18 Jan 2021 11:52:12 -0500 Received: from mail-qk1-f181.google.com ([209.85.222.181]:37288) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1l1Xl4-0000kV-62 for 45774@debbugs.gnu.org; Mon, 18 Jan 2021 11:52:04 -0500 Received: by mail-qk1-f181.google.com with SMTP id h4so19237327qkk.4 for <45774@debbugs.gnu.org>; Mon, 18 Jan 2021 08:52:02 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=93I9hcIBZAt02KLcqyLBdmz5tQhsR8FszOh0O4hOiyQ=; b=WDdX8RRtz/eK/xRIAyPzvjJzT30QHm98zTuYjUX6HgIQSUfY2a8QOR+uePMBg6QuC2 cpFz22CLVMYsTgII4uaGsyEySv43R7iXH/mejRU+XADCRVea3V3sBUxoMUi+SDVva7Wo hGaz292cbM1en7QkpPGz/Y1WgH5uh3mt38+R1K8DYCyuFncUpFxk4lDutck8dWp1bZ+9 OywB/BUxu0mvmxNH7LCvyesIK30LKIvx0kQQHeLM9uH2T9FdYTO3H5/PYNvPWpt201Q4 ng3iycIj7eVDzZQs80NAt0m1Hg/GF9wt11P5Lcqv2usw0fnRMr40W26N0aqikr3lBjLr yQyQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=93I9hcIBZAt02KLcqyLBdmz5tQhsR8FszOh0O4hOiyQ=; b=NFQIOr+GeMoJEhXxm1TYaWjupmrRc35vGpQqeyXJEQ+HbEwyPTjaDuyKAubi7tTZNV iubo67rD4RiFvXZVQZPOqR5larShID+3wVCWi4VGJtlqhmoPyg6GBrwiAq2MPS2JLZKR 7JYoK3cnlHE6fiCAjjG3YZx/j+PEAg58OSMSx7UvdyAMSuvj9y0kCaByTtWT1DMyVdaK p6vMpz1f+JKk0YRvtB2JsN2d60h24USBRsj+d0mhgZjn+TAz9ZUPDKAoDa+wCm3VmFb8 DBBzWTHUCMTOx2IaCfTUz4KRPHlawMGfgMEIVCaiceqbXxZrRupVJYkWA3L287VcMRD0 0cEw== X-Gm-Message-State: AOAM533wZKo2rCsnyIZGROr2ECS3kS8Q/Cknx6djQqNnUAFjas0Z3H/G ttwERFOjOTDXwNU6sYmJH/Y= X-Google-Smtp-Source: ABdhPJw/ydeNhDSWz1dGaEA/U62gQoq7BcIzXeX3EwA2AJhvXQU8QfMe5FGZmBGtgsjAuw/vMxulLQ== X-Received: by 2002:a05:620a:947:: with SMTP id w7mr432151qkw.389.1610988716327; Mon, 18 Jan 2021 08:51:56 -0800 (PST) Received: from localhost.localdomain (dsl-149-228.b2b2c.ca. [66.158.149.228]) by smtp.gmail.com with ESMTPSA id m64sm10992602qkb.90.2021.01.18.08.51.55 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 18 Jan 2021 08:51:55 -0800 (PST) From: Maxim Cournoyer Date: Mon, 18 Jan 2021 11:51:21 -0500 Message-Id: <20210118165122.25813-2-maxim.cournoyer@gmail.com> X-Mailer: git-send-email 2.29.2 In-Reply-To: <20210118165122.25813-1-maxim.cournoyer@gmail.com> References: <20210118165122.25813-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" X-getmail-retrieved-from-mailbox: Patches Before this change, only plain directories, tar or zip archives were supported as the source of a package for the GNU build system; anything else would cause the unpack phase to fail. Origins relying on snippets would suffer from the same problem. This change adds the support to use files of the following extensions: .gz, .Z, .bz2, .lz, and .xz, even when they are not tarballs. Files of unknown extensions are treated as uncompressed files and supported as well. * guix/packages.scm (patch-and-repack): Only add the compressor utility to the PATH when the file is compressed. Bind more inputs in the mlet, and use them for decompressing single files. Adjust the decompression and compression routines. [decompression-type]: Remove nested variable. * guix/build/utils.scm (compressor, tarball?): New procedures. Move %xz-parallel-args to the new 'compression helpers' section. * tests/packages.scm: Add tests. Add missing copyright year for Jan. * guix/build/gnu-build-system.scm (first-subdirectory): Return #f when no sub-directory was found. (unpack): Support more file types, including uncompressed plain files. --- guix/build/gnu-build-system.scm | 24 +++++-- guix/build/utils.scm | 47 +++++++++---- guix/packages.scm | 117 ++++++++++++++++++-------------- guix/tests.scm | 43 +++++++++++- tests/builders.scm | 35 +++++++++- tests/packages.scm | 72 +++++++++++++++++++- 6 files changed, 259 insertions(+), 79 deletions(-) diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index f8e8a46854..66edd2de2d 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2018 Mark H Weaver ;;; Copyright © 2020 Brendan Tildesley +;;; Copyright © 2021 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -60,13 +61,15 @@ See https://reproducible-builds.org/specs/source-date-epoch/." (setenv "SOURCE_DATE_EPOCH" "1")) (define (first-subdirectory directory) - "Return the file name of the first sub-directory of DIRECTORY." + "Return the file name of the first sub-directory of DIRECTORY or false, when +there are none." (match (scandir directory (lambda (file) (and (not (member file '("." ".."))) (file-is-directory? (string-append directory "/" file))))) - ((first . _) first))) + ((first . _) first) + (_ #f))) (define* (set-paths #:key target inputs native-inputs (search-paths '()) (native-search-paths '()) @@ -155,10 +158,19 @@ working directory." (copy-recursively source "." #:keep-mtime? #t)) (begin - (if (string-suffix? ".zip" source) - (invoke "unzip" source) - (invoke "tar" "xvf" source)) - (chdir (first-subdirectory "."))))) + (cond + ((string-suffix? ".zip" source) + (invoke "unzip" source)) + ((tarball? source) + (invoke "tar" "xvf" source)) + (else + (let ((name (strip-store-file-name source)) + (command (compressor source))) + (copy-file source name) + (when command + (invoke command "--decompress" name))))) + ;; Attempt to change into child directory. + (and=> (first-subdirectory ".") chdir)))) (define* (bootstrap #:key bootstrap-scripts #:allow-other-keys) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 2cbdb31505..01904785bd 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -6,7 +6,7 @@ ;;; Copyright © 2018 Arun Isaac ;;; Copyright © 2018, 2019 Ricardo Wurmus ;;; Copyright © 2020 Efraim Flashner -;;; Copyright © 2020 Maxim Cournoyer +;;; Copyright © 2020, 2021 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -51,6 +51,10 @@ package-name->name+version parallel-job-count + compressor + tarball? + %xz-parallel-args + directory-exists? executable-file? symbolic-link? @@ -113,9 +117,7 @@ make-desktop-entry-file - locale-category->string - - %xz-parallel-args)) + locale-category->string)) ;;; @@ -137,6 +139,32 @@ (module-replace! (current-module) '(setvbuf))) (else #f)) + +;;; +;;; Compression helpers. +;;; + +(define (compressor file-name) + "Return the name of the compressor package/binary used to compress or +decompress FILE-NAME, based on its file extension, else false." + (cond ((string-suffix? "gz" file-name) "gzip") + ((string-suffix? "Z" file-name) "gzip") + ((string-suffix? "bz2" file-name) "bzip2") + ((string-suffix? "lz" file-name) "lzip") + ((string-suffix? "zip" file-name) "unzip") + ((string-suffix? "xz" file-name) "xz") + (else #f))) ;no compression used/unknown file extension + +(define (tarball? file-name) + "True when FILE-NAME has a tar file extension." + (string-match "\\.(tar(\\..*)?|tgz|tbz)$" file-name)) + +(define (%xz-parallel-args) + "The xz arguments required to enable bit-reproducible, multi-threaded +compression." + (list "--memlimit=50%" + (format #f "--threads=~a" (max 2 (parallel-job-count))))) + ;;; ;;; Directories. @@ -1536,17 +1564,6 @@ returned." LC_NAME LC_NUMERIC LC_PAPER LC_TELEPHONE LC_TIME))) - -;;; -;;; Others. -;;; - -(define (%xz-parallel-args) - "The xz arguments required to enable bit-reproducible, multi-threaded -compression." - (list "--memlimit=50%" - (format #f "--threads=~a" (max 2 (parallel-job-count))))) - ;;; Local Variables: ;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1) ;;; eval: (put 'call-with-ascii-input-file 'scheme-indent-function 1) diff --git a/guix/packages.scm b/guix/packages.scm index cd2cded9ee..73f605f3a9 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -5,7 +5,7 @@ ;;; Copyright © 2016 Alex Kost ;;; Copyright © 2017, 2019, 2020 Efraim Flashner ;;; Copyright © 2019 Marius Bakke -;;; Copyright © 2020 Maxim Cournoyer +;;; Copyright © 2020, 2021 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,6 +23,7 @@ ;;; along with GNU Guix. If not, see . (define-module (guix packages) + #:use-module ((guix build utils) #:select (compressor tarball?)) #:use-module (guix utils) #:use-module (guix records) #:use-module (guix store) @@ -609,14 +610,6 @@ specifies modules in scope when evaluating SNIPPET." ((package) package) (#f #f))))) - (define decompression-type - (cond ((string-suffix? "gz" source-file-name) "gzip") - ((string-suffix? "Z" source-file-name) "gzip") - ((string-suffix? "bz2" source-file-name) "bzip2") - ((string-suffix? "lz" source-file-name) "lzip") - ((string-suffix? "zip" source-file-name) "unzip") - (else "xz"))) - (define original-file-name ;; Remove the store prefix plus the slash, hash, and hyphen. (let* ((sans (string-drop source-file-name @@ -651,17 +644,24 @@ specifies modules in scope when evaluating SNIPPET." (lower-object patch system)))) (mlet %store-monad ((tar -> (lookup-input "tar")) + (gzip -> (lookup-input "gzip")) + (bzip2 -> (lookup-input "bzip2")) + (lzip -> (lookup-input "lzip")) (xz -> (lookup-input "xz")) (patch -> (lookup-input "patch")) (locales -> (lookup-input "locales")) - (decomp -> (lookup-input decompression-type)) + (comp -> (and=> (compressor source-file-name) + lookup-input)) (patches (sequence %store-monad (map instantiate-patch patches)))) (define build (with-imported-modules '((guix build utils)) #~(begin (use-modules (ice-9 ftw) + (ice-9 match) + (ice-9 regex) (srfi srfi-1) + (srfi srfi-26) (guix build utils)) ;; The --sort option was added to GNU tar in version 1.28, released @@ -723,54 +723,67 @@ specifies modules in scope when evaluating SNIPPET." (package-version locales))))) (setlocale LC_ALL "en_US.utf8")) - (setenv "PATH" (string-append #+xz "/bin" ":" - #+decomp "/bin")) + (setenv "PATH" + (string-append #+xz "/bin" + (if #+comp + (string-append ":" #+comp "/bin") + ""))) (setenv "XZ_DEFAULTS" (string-join (%xz-parallel-args))) - ;; SOURCE may be either a directory or a tarball. - (if (file-is-directory? #+source) - (let* ((store (%store-directory)) - (len (+ 1 (string-length store))) - (base (string-drop #+source len)) - (dash (string-index base #\-)) - (directory (string-drop base (+ 1 dash)))) - (mkdir directory) - (copy-recursively #+source directory)) - #+(if (string=? decompression-type "unzip") - #~(invoke "unzip" #+source) - #~(invoke (string-append #+tar "/bin/tar") - "xvf" #+source))) - - (let ((directory (first-file "."))) - (format (current-error-port) - "source is under '~a'~%" directory) - (chdir directory) - - (for-each apply-patch '#+patches) - - #+(if snippet - #~(let ((module (make-fresh-user-module))) - (module-use-interfaces! - module - (map resolve-interface '#+modules)) - ((@ (system base compile) compile) - '#+snippet - #:to 'value - #:opts %auto-compilation-options - #:env module)) - #~#t) - - (chdir "..") + ;; SOURCE may be either a directory, a tarball or a simple file. + (let ((name (strip-store-file-name #+source)) + (command (and=> #+comp (cut string-append <> "/bin/" + (compressor #+source))))) + (if (file-is-directory? #+source) + (copy-recursively #+source name) + (cond + ((tarball? #+source) + (invoke (string-append #+tar "/bin/tar") "xvf" #+source)) + ((and=> (compressor #+source) (cut string= "unzip" <>)) + ;; Note: Referring to the store unzip here (#+unzip) + ;; would introduce a cycle. + ("unzip" (invoke "unzip" #+source))) + (else + (copy-file #+source name) + (when command + (invoke command "--decompress" name)))))) + + (let* ((file (first-file ".")) + (directory (if (file-is-directory? file) + file + "."))) + (format (current-error-port) "source is at '~a'~%" file) + + (with-directory-excursion directory + + (for-each apply-patch '#+patches) + + #+(if snippet + #~(let ((module (make-fresh-user-module))) + (module-use-interfaces! + module + (map resolve-interface '#+modules)) + ((@ (system base compile) compile) + '#+snippet + #:to 'value + #:opts %auto-compilation-options + #:env module)) + #~#t)) ;; If SOURCE is a directory (such as a checkout), return a ;; directory. Otherwise create a tarball. - (if (file-is-directory? #+source) - (copy-recursively directory #$output - #:log (%make-void-port "w")) - (repack directory #$output)))))) - - (let ((name (if (checkout? original-file-name) + (cond + ((file-is-directory? #+source) + (copy-recursively directory #$output + #:log (%make-void-port "w"))) + ((not #+comp) + (copy-file file #$output)) + (else + (repack directory #$output))))))) + + (let ((name (if (or (checkout? original-file-name) + (not (compressor original-file-name))) original-file-name (tarxz-name original-file-name)))) (gexp->derivation name build diff --git a/guix/tests.scm b/guix/tests.scm index fc3d521163..da75835099 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -20,12 +20,13 @@ #:use-module ((guix config) #:select (%storedir %localstatedir)) #:use-module (guix store) #:use-module (guix derivations) + #:use-module (guix gexp) #:use-module (guix packages) #:use-module (guix base32) #:use-module (guix serialization) #:use-module (guix monads) #:use-module ((guix utils) #:select (substitute-keyword-arguments)) - #:use-module ((guix build utils) #:select (mkdir-p)) + #:use-module ((guix build utils) #:select (mkdir-p compressor)) #:use-module ((gcrypt hash) #:hide (sha256)) #:use-module (guix build-system gnu) #:use-module (gnu packages base) @@ -60,7 +61,9 @@ dummy-package dummy-origin - gnu-make-for-tests)) + gnu-make-for-tests + + test-file)) ;;; Commentary: ;;; @@ -435,6 +438,42 @@ default values, and with EXTRA-FIELDS set as specified." (native-inputs '()) ;no need for 'pkg-config' (inputs %bootstrap-inputs-for-tests)))) + +;;; +;;; Test utility procedures. + +(define (test-file store name content) + "Create a simple file in STORE with CONTENT (a string), compressed according +to its file name extension. Return both its file name and its hash." + (let* ((ext (string-index-right name #\.)) + (name-sans-ext (if ext + (string-take name (string-index-right name #\.)) + name)) + (comp (compressor name)) + (command #~(if #+comp + (string-append #+%bootstrap-coreutils&co + "/bin/" #+comp) + #f)) + (f (with-imported-modules '((guix build utils)) + (computed-file name + #~(begin + (use-modules (guix build utils) + (rnrs io simple)) + (with-output-to-file #+name-sans-ext + (lambda _ + (format #t #+content))) + (when #+command + (invoke #+command #+name-sans-ext)) + (copy-file #+name #$output))))) + (file-drv (run-with-store store (lower-object f))) + (file (derivation->output-path file-drv)) + (file-drv-outputs (derivation-outputs file-drv)) + (_ (build-derivations store (list file-drv))) + (file-hash (derivation-output-hash + (assoc-ref file-drv-outputs "out")))) + (values file file-hash))) + +;;; ;; Local Variables: ;; eval: (put 'call-with-derivation-narinfo 'scheme-indent-function 1) ;; eval: (put 'call-with-derivation-substitute 'scheme-indent-function 2) diff --git a/tests/builders.scm b/tests/builders.scm index fdcf38ded3..624547500a 100644 --- a/tests/builders.scm +++ b/tests/builders.scm @@ -17,10 +17,12 @@ ;;; along with GNU Guix. If not, see . -(define-module (test-builders) +(define-module (tests builders) #:use-module (guix download) #:use-module (guix build-system) #:use-module (guix build-system gnu) + #:use-module (guix build gnu-build-system) + #:use-module (guix build utils) #:use-module (guix store) #:use-module (guix utils) #:use-module (guix base32) @@ -32,7 +34,9 @@ package-derivation package-native-search-paths)) #:use-module (gnu packages bootstrap) #:use-module (ice-9 match) + #:use-module (ice-9 textual-ports) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-64)) ;; Test the higher-level builders. @@ -78,4 +82,33 @@ (test-assert "gnu-build-system" (build-system? gnu-build-system)) +(define unpack (assoc-ref %standard-phases 'unpack)) + +(define compressors '(("gzip" . "gz") + ("xz" . "xz") + ("bzip2" . "bz2") + (#f . #f))) + +(for-each + (match-lambda + ((comp . ext) + + (unless (network-reachable?) (test-skip 1)) ;for bootstrap binaries + (test-equal (string-append "gnu-build-system unpack phase, " + "single file (compression: " + (if comp comp "None") ")") + "expected text" + (let*-values + (((name) "test") + ((compressed-name) (if ext + (string-append name "." ext) + name)) + ((file hash) (test-file %store compressed-name "expected text"))) + (call-with-temporary-directory + (lambda (dir) + (with-directory-excursion dir + (unpack #:source file) + (call-with-input-file name get-string-all)))))))) + compressors) + (test-end "builders") diff --git a/tests/packages.scm b/tests/packages.scm index a867f2fd6d..b3ccd98e48 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès -;;; Copyright © Jan (janneke) Nieuwenhuizen +;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2021 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,13 +18,14 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . -(define-module (test-packages) +(define-module (tests packages) #:use-module (guix tests) #:use-module (guix store) #:use-module (guix monads) #:use-module (guix grafts) - #:use-module ((guix gexp) #:select (local-file local-file-file)) + #:use-module (guix gexp) #:use-module (guix utils) + #:use-module ((guix build utils) #:select (tarball?)) #:use-module ((guix diagnostics) ;; Rename the 'location' binding to allow proper syntax ;; matching when setting the 'location' field of a package. @@ -32,6 +34,7 @@ (else name)))) #:use-module ((gcrypt hash) #:prefix gcrypt:) #:use-module (guix derivations) + #:use-module (guix download) #:use-module (guix packages) #:use-module (guix grafts) #:use-module (guix search-paths) @@ -50,6 +53,7 @@ #:use-module (gnu packages version-control) #:use-module (gnu packages xml) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) @@ -576,6 +580,11 @@ (build-derivations %store (list drv)) (call-with-input-file output get-string-all))) + +;;; +;;; Source derivation with snippets. +;;; + (unless (network-reachable?) (test-skip 1)) (test-equal "package-source-derivation, snippet" "OK" @@ -631,6 +640,63 @@ (and (build-derivations %store (list (pk 'snippet-drv drv))) (call-with-input-file out get-string-all)))) +;; Note: lzip is not part of bootstrap-coreutils&co, so is not included to +;; avoid having to rebuild the world. +(define compressors '(("gzip" . "gz") + ("xz" . "xz") + ("bzip2" . "bz2") + (#f . #f))) + +(for-each + (match-lambda + ((comp . ext) + (unless (network-reachable?) (test-skip 1)) + (test-equal (string-append "origin->derivation, single file with snippet " + "(compression: " (if comp comp "None") ")") + "2 + 2 = 4" + (let*-values + (((name) "maths") + ((compressed-name) (if comp + (string-append name "." ext) + name)) + ((file hash) (test-file %store compressed-name "2 + 2 = 5")) + ;; Create an origin using the above computed file and its hash. + ((source) (origin + (method url-fetch) + (uri (string-append "file://" file)) + (file-name compressed-name) + (patch-inputs `(("tar" ,%bootstrap-coreutils&co) + ("xz" ,%bootstrap-coreutils&co) + ("bzip2" ,%bootstrap-coreutils&co) + ("gzip" ,%bootstrap-coreutils&co))) + (patch-guile %bootstrap-guile) + (modules '((guix build utils))) + (snippet `(substitute* ,name + (("5") "4"))) + (hash (content-hash hash)))) + ;; Build origin. + ((drv) (run-with-store %store (origin->derivation source))) + ((out) (derivation->output-path drv))) + ;; Decompress the resulting tar.xz and return its content. + (and (build-derivations %store (list drv)) + (if (tarball? out) + (let* ((bin #~(string-append #+%bootstrap-coreutils&co + "/bin")) + (f (computed-file + name + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (setenv "PATH" #+bin) + (invoke "tar" "xvf" #+out) + (copy-file #+name #$output))))) + (drv (run-with-store %store (lower-object f))) + (_ (build-derivations %store (list drv)))) + (call-with-input-file (derivation->output-path drv) + get-string-all)) + (call-with-input-file out get-string-all))))))) + compressors) + (test-assert "return value" (let ((drv (package-derivation %store (dummy-package "p")))) (and (derivation? drv)