From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id yJSQCDNe+19MfgAA0tVLHw (envelope-from ) for ; Sun, 10 Jan 2021 20:06:11 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id 8KRDBDNe+18uRQAAbx9fmQ (envelope-from ) for ; Sun, 10 Jan 2021 20:06:11 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 3F3B59402AF for ; Sun, 10 Jan 2021 20:06:10 +0000 (UTC) Received: from localhost ([::1]:45002 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kygyW-0007eC-WC for larch@yhetil.org; Sun, 10 Jan 2021 15:06:09 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:39304) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kygyQ-0007e4-8T for guix-patches@gnu.org; Sun, 10 Jan 2021 15:06:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:43462) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kygyQ-0004PN-1N for guix-patches@gnu.org; Sun, 10 Jan 2021 15:06:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kygyP-0005KZ-T4 for guix-patches@gnu.org; Sun, 10 Jan 2021 15:06:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#45774] [PATCH core-updates 1/1] guix: packages: Allow patch-and-repack to work with plain files. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 10 Jan 2021 20:06:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 45774 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 45773@gnu.org, 45774@debbugs.gnu.org X-Debbugs-Original-To: 45773@gnu.org, guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.161030915620469 (code B ref -1); Sun, 10 Jan 2021 20:06:01 +0000 Received: (at submit) by debbugs.gnu.org; 10 Jan 2021 20:05:56 +0000 Received: from localhost ([127.0.0.1]:55008 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kygyJ-0005K5-9L for submit@debbugs.gnu.org; Sun, 10 Jan 2021 15:05:55 -0500 Received: from lists.gnu.org ([209.51.188.17]:39152) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kygyH-0005Jx-Iw for submit@debbugs.gnu.org; Sun, 10 Jan 2021 15:05:54 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:39302) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kygyH-0007dn-ET for guix-patches@gnu.org; Sun, 10 Jan 2021 15:05:53 -0500 Received: from mail-io1-xd30.google.com ([2607:f8b0:4864:20::d30]:43262) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kygyF-0004HY-6H for guix-patches@gnu.org; Sun, 10 Jan 2021 15:05:53 -0500 Received: by mail-io1-xd30.google.com with SMTP id o6so15590782iob.10; Sun, 10 Jan 2021 12:05:50 -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=R6+qyBU2MlyCz6OQiOW6ONTwLEzahy4VP0r/oAUu5nQ=; b=YpMkyZUaSoWPz3xPvVVWe2vcdOM6uml0Co6l7dju+0O67SI9nXFjdUweoScGQa6obv pqYcak9DCrQcw2RkhyZzr7wK+LncgIB0Ve+xT65lX9F50WQgsn7eanpw1HUuxo1spzyB CNM7qu3CCzSOUzkfcczGuEz4p6knh4kPzWgRtyle+V/smLu/8UV1+CZsvGcJnD8a2CPZ Vvtcx2lKtfocypmE0Q1HoRuUXNuteaLmEcEIKjQLgk9BtBHOWmPUwByu/9+jipRbgbuP OPg7pRldRa9xaiY/IAVFNS9i1IQYKfAjXtjQTwMyAnRD5sWyGzDBw3Tvwx7JxSjih+tE wEAQ== 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=R6+qyBU2MlyCz6OQiOW6ONTwLEzahy4VP0r/oAUu5nQ=; b=iTsfnx3fD8tqtTpncgwUQ0NXzg/Nj2vzlvjfQT5NFNKmO71OetvEWiycRbRvT8QWi4 PpuPT29+23WO2WJxcPpAvCBiTcUF4PQ5/HFDydxyCwXAZgkvF71NtrXlWAgKm2AXj0m0 tnvTkchGPmraPQH/w64ivbt7r+tmmySd/jYrMiC4i9nEWRTdu0DUfqJQT1hAYupuHbIN Jiv4Nv717eaAVWVZHuM9AXXV+5EcSDryD/CeF8fBDU1W5hpsBZ57246m1hzyr31ZrvZZ 4WAHmPfDW5F+mRPeAcpyMdHdXwRVd6KznBSINqS38jTrc0I/BdKv4VWCXZFRGSIcncsi XAsg== X-Gm-Message-State: AOAM533/gDlnPlhF3MSzTEGLxZno1eNq5EkwHPyQ7yK1P2+94yUwBH+W vbfmq3O+PWkxG//huWGq2qjT2WA8rNOUQQ== X-Google-Smtp-Source: ABdhPJwoqIVHqO0KVyCKjzEk5ftMq6HkycPdjFpFyXl+WzfepacmRWDHWzt+yBDEpcTSZAw+GcGL/g== X-Received: by 2002:a05:6638:19c:: with SMTP id a28mr11629868jaq.76.1610309149372; Sun, 10 Jan 2021 12:05:49 -0800 (PST) Received: from localhost.localdomain (dsl-205-233-124-188.b2b2c.ca. [205.233.124.188]) by smtp.gmail.com with ESMTPSA id n77sm9516249iod.48.2021.01.10.12.05.48 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sun, 10 Jan 2021 12:05:48 -0800 (PST) From: Maxim Cournoyer Date: Sun, 10 Jan 2021 15:05:35 -0500 Message-Id: <20210110200535.24377-1-maxim.cournoyer@gmail.com> X-Mailer: git-send-email 2.29.2 MIME-Version: 1.0 Content-Type: text/plain; charset=yes Content-Transfer-Encoding: 8bit Received-SPF: pass client-ip=2607:f8b0:4864:20::d30; envelope-from=maxim.cournoyer@gmail.com; helo=mail-io1-xd30.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action 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+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN X-Migadu-Spam-Score: -1.25 Authentication-Results: aspmx1.migadu.com; dkim=fail (body hash did not verify) header.d=gmail.com header.s=20161025 header.b=YpMkyZUa; dmarc=fail reason="SPF not aligned (relaxed)" header.from=gmail.com (policy=none); spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Queue-Id: 3F3B59402AF X-Spam-Score: -1.25 X-Migadu-Scanner: scn0.migadu.com X-TUID: BLGPs6U30x6c This change allows the use of the snippet field on a single file origin. Previously, the patch-and-repack procedure would fail on plain files, as it would end up invoking tar when attempting to extract non-tarballs. * 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 decompression and compression routines. [decompression-type]: Return #f when no known compression extension is used. [tarball?]: New nested procedure. * tests/packages.scm: Add tests. Add missing copyright year for Jan. --- guix/packages.scm | 96 +++++++++++++++++++++++++++++++--------------- tests/packages.scm | 87 +++++++++++++++++++++++++++++++++++++++-- 2 files changed, 149 insertions(+), 34 deletions(-) diff --git a/guix/packages.scm b/guix/packages.scm index 93407c143c..f6336e7345 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. ;;; @@ -615,7 +615,8 @@ specifies modules in scope when evaluating SNIPPET." ((string-suffix? "bz2" source-file-name) "bzip2") ((string-suffix? "lz" source-file-name) "lzip") ((string-suffix? "zip" source-file-name) "unzip") - (else "xz"))) + ((string-suffix? "xz" source-file-name) "xz") + (else #f))) ;no compression used (define original-file-name ;; Remove the store prefix plus the slash, hash, and hyphen. @@ -653,19 +654,29 @@ 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)) + (decomp -> (and=> decompression-type 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)) + (define (tarball? file-name) + ;; Return true if FILE-NAME has a tar extension. + (string-match "\\.tar(\\..*)?$" file-name)) + ;; The --sort option was added to GNU tar in version 1.28, released ;; 2014-07-28. During bootstrap we must cope with older versions. (define tar-supports-sort? @@ -702,12 +713,15 @@ 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 #+decomp + (string-append ":" #+decomp "/bin") + ""))) (setenv "XZ_DEFAULTS" (string-join (%xz-parallel-args))) - ;; SOURCE may be either a directory or a tarball. + ;; SOURCE may be either a directory, a tarball or a simple file. (if (file-is-directory? #+source) (let* ((store (%store-directory)) (len (+ 1 (string-length store))) @@ -716,31 +730,51 @@ specifies modules in scope when evaluating SNIPPET." (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 "..") + ;; File is *not* a directory. + (cond + ((tarball? #+source) + (invoke (string-append #+tar "/bin/tar") + "xvf" #+source)) + ((and=> #+decompression-type (cut string= "unzip" <>)) + ("unzip" (invoke "unzip" #+source))) + (else + ;; A simple file, either compressed or not. + (match #+decompression-type + ;; Note: Referring to the store unzip here (#+unzip) + ;; introduces a cycle. + ("unzip" (invoke "unzip" #+source)) + (else + ;; bzip2, gzip, lzip and xz share a common CLI. + (let ((name (strip-store-file-name #+source)) + (command (and=> #+decomp + (cut string-append <> "/bin/" + #+decompression-type)))) + (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)) (unless tar-supports-sort? (call-with-output-file ".file_list" diff --git a/tests/packages.scm b/tests/packages.scm index a867f2fd6d..5c84dbf4b8 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,12 +18,12 @@ ;;; 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 diagnostics) ;; Rename the 'location' binding to allow proper syntax @@ -32,6 +33,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) @@ -576,6 +578,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 +638,80 @@ (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* ((name "maths") + (compressed-name (if comp + (string-append name "." ext) + name)) + (command #~(if #+comp + (string-append #+%bootstrap-coreutils&co + "/bin/" #+comp) + #f)) + (f (with-imported-modules '((guix build utils)) + (computed-file compressed-name + #~(begin + (use-modules (guix build utils) + (rnrs io simple)) + (with-output-to-file #+name + (lambda _ + (format #t "2 + 2 = 5"))) + (when #+command + (invoke #+command #+name)) + (copy-file #+compressed-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"))) + ;; 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 file-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)) + (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))))))) + compressors) + (test-assert "return value" (let ((drv (package-derivation %store (dummy-package "p")))) (and (derivation? drv) -- 2.29.2