From patchwork Sun Aug 15 23:25:24 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Sarah Morgensen X-Patchwork-Id: 32120 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 4EB4827BC6B; Mon, 16 Aug 2021 00:26:15 +0100 (BST) 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_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,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 969E227BC82 for ; Mon, 16 Aug 2021 00:26:14 +0100 (BST) Received: from localhost ([::1]:57420 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mFPW9-0008K3-Kf for patchwork@mira.cbaines.net; Sun, 15 Aug 2021 19:26:13 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:37842) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mFPVy-0008I6-Ad for guix-patches@gnu.org; Sun, 15 Aug 2021 19:26:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:36402) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mFPVy-0004xR-4c for guix-patches@gnu.org; Sun, 15 Aug 2021 19:26:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mFPVy-0001qY-0Y for guix-patches@gnu.org; Sun, 15 Aug 2021 19:26:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50072] [PATCH WIP 1/4] guix hash: Extract file hashing procedures. Resent-From: Sarah Morgensen Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 15 Aug 2021 23:26:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50072 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 50072@debbugs.gnu.org Received: via spool by 50072-submit@debbugs.gnu.org id=B50072.16290699327023 (code B ref 50072); Sun, 15 Aug 2021 23:26:01 +0000 Received: (at 50072) by debbugs.gnu.org; 15 Aug 2021 23:25:32 +0000 Received: from localhost ([127.0.0.1]:47939 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mFPVU-0001pD-5j for submit@debbugs.gnu.org; Sun, 15 Aug 2021 19:25:32 -0400 Received: from out1.migadu.com ([91.121.223.63]:59878) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mFPVS-0001p4-6V for 50072@debbugs.gnu.org; Sun, 15 Aug 2021 19:25:31 -0400 X-Report-Abuse: Please report any abuse attempt to abuse@migadu.com and include these headers. DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=mgsn.dev; s=key1; t=1629069929; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:mime-version:mime-version:content-type:content-type: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=0WFMFSUuUYWVX08e2b+zqvIdj2OOvXmGMXdblJEeCyg=; b=Hj3SRdhXdJXsM1ywtCvt7jpZwMt76EonHF4eWORW+FRYmOWeiEWZQBd6KAMk8QvbO624cr i0Q2C+xoemwEMvhf/ANeBbHTBD890vCE9JIIBK158jkpXAQVk2KRGxmPesvesvd8iNZtXZ f+RLBB2nyPNtvWOKNs8LxQjiZe0sII0= From: Sarah Morgensen Date: Sun, 15 Aug 2021 16:25:24 -0700 Message-Id: <9ba0b798de2fdf859f94ca7b2f1ee052bceac63a.1629068119.git.iskarian@mgsn.dev> In-Reply-To: References: MIME-Version: 1.0 X-Migadu-Flow: FLOW_OUT X-Migadu-Auth-User: iskarian@mgsn.dev 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 * guix/scripts/hash.scm (guix-hash)[vcs-file?, file-hash]: Extract logic to... * guix/hash.scm: ...here. New file. --- guix/hash.scm | 51 +++++++++++++++++++++++++++++++++++++++++++ guix/scripts/hash.scm | 29 ++++++------------------ 2 files changed, 58 insertions(+), 22 deletions(-) create mode 100644 guix/hash.scm diff --git a/guix/hash.scm b/guix/hash.scm new file mode 100644 index 0000000000..8c2ab8187f --- /dev/null +++ b/guix/hash.scm @@ -0,0 +1,51 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Sarah Morgensen +;;; +;;; 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 hash) + #:use-module (gcrypt hash) + #:use-module (guix serialization) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:export (vcs-file? + file-hash*)) + +(define (vcs-file? file stat) + "Returns true if FILE is a version control system file." + (case (stat:type stat) + ((directory) + (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS"))) + ((regular) + ;; Git sub-modules have a '.git' file that is a regular text file. + (string=? (basename file) ".git")) + (else + #f))) + +(define* (file-hash* file #:key + (algorithm (hash-algorithm sha256)) + (recursive? #t) + (select? (negate vcs-file?))) + "Compute the hash of FILE with ALGORITHM. If RECURSIVE? is true, recurse +into subdirectories of FILE, computing the combined hash of all files for +which (SELECT? FILE STAT) returns true." + (if recursive? + (let-values (((port get-hash) + (open-hash-port algorithm))) + (write-file file port #:select? select?) + (force-output port) + (get-hash)) + (file-hash algorithm file))) diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index b8622373cc..353ca30c2c 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2016 Jan Nieuwenhuizen ;;; Copyright © 2018 Tim Gesthuizen +;;; Copyright © 2021 Sarah Morgensen ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,6 +24,7 @@ #:use-module (gcrypt hash) #:use-module (guix serialization) #:use-module (guix ui) + #:use-module (guix hash) #:use-module (guix scripts) #:use-module (guix base16) #:use-module (guix base32) @@ -125,16 +127,6 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n")) (parse-command-line args %options (list %default-options) #:build-options? #f)) - (define (vcs-file? file stat) - (case (stat:type stat) - ((directory) - (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS"))) - ((regular) - ;; Git sub-modules have a '.git' file that is a regular text file. - (string=? (basename file) ".git")) - (else - #f))) - (let* ((opts (parse-options)) (args (filter-map (match-lambda (('argument . value) @@ -150,18 +142,11 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n")) ;; Compute the hash of FILE. ;; Catch and gracefully report possible '&nar-error' conditions. (with-error-handling - (if (assoc-ref opts 'recursive?) - (let-values (((port get-hash) - (open-hash-port (assoc-ref opts 'hash-algorithm)))) - (write-file file port #:select? select?) - (force-output port) - (get-hash)) - (match file - ("-" (port-hash (assoc-ref opts 'hash-algorithm) - (current-input-port))) - (_ (call-with-input-file file - (cute port-hash (assoc-ref opts 'hash-algorithm) - <>))))))) + (match file + ("-" (port-hash (assoc-ref opts 'hash-algorithm) + (current-input-port))) + (_ (file-hash* #:algorithm (assoc-ref opts 'hash-algorithm) + #:recursive? (assoc-ref opts 'recursive?)))))) (match args ((file) From patchwork Sun Aug 15 23:25:25 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Sarah Morgensen X-Patchwork-Id: 32121 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 35DE627BC78; Mon, 16 Aug 2021 00:26:17 +0100 (BST) 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_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,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 DCCC327BC6B for ; Mon, 16 Aug 2021 00:26:15 +0100 (BST) Received: from localhost ([::1]:57452 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mFPWA-0008ME-UF for patchwork@mira.cbaines.net; Sun, 15 Aug 2021 19:26:15 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:37844) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mFPVy-0008II-M3 for guix-patches@gnu.org; Sun, 15 Aug 2021 19:26:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:36403) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mFPVy-0004xy-G9 for guix-patches@gnu.org; Sun, 15 Aug 2021 19:26:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mFPVy-0001qf-D8 for guix-patches@gnu.org; Sun, 15 Aug 2021 19:26:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50072] [PATCH WIP 2/4] import: Factorize file hashing. Resent-From: Sarah Morgensen Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 15 Aug 2021 23:26:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50072 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 50072@debbugs.gnu.org Received: via spool by 50072-submit@debbugs.gnu.org id=B50072.16290699387048 (code B ref 50072); Sun, 15 Aug 2021 23:26:02 +0000 Received: (at 50072) by debbugs.gnu.org; 15 Aug 2021 23:25:38 +0000 Received: from localhost ([127.0.0.1]:47943 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mFPVZ-0001pW-Ic for submit@debbugs.gnu.org; Sun, 15 Aug 2021 19:25:38 -0400 Received: from out2.migadu.com ([188.165.223.204]:47102) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mFPVW-0001pL-Gp for 50072@debbugs.gnu.org; Sun, 15 Aug 2021 19:25:35 -0400 X-Report-Abuse: Please report any abuse attempt to abuse@migadu.com and include these headers. DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=mgsn.dev; s=key1; t=1629069932; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:mime-version:mime-version:content-type:content-type: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=7akfLvRyHvBOWqyJCG4HKD+1hne9n2Xo0apkJYmGmzY=; b=KPtZsDwr0kwJOix07b9YzqdBLYRFmDcul3feNT/EMuYAjOAxjTQrAntdUz55xoZ4BscaJD aibBAPHpGhqGo40MH7Ojqzs8n2kt7T+UYXY1/+ZLxWXHkTFmcIr0ZSykFIS22h1wsJBimY sw+7Nb/6p03I60V04zovmDv1OGPV0CM= From: Sarah Morgensen Date: Sun, 15 Aug 2021 16:25:25 -0700 Message-Id: <82bab33f2d4a03c8e83d1825648577fbae3aee7e.1629068119.git.iskarian@mgsn.dev> In-Reply-To: References: MIME-Version: 1.0 X-Migadu-Flow: FLOW_OUT X-Migadu-Auth-User: iskarian@mgsn.dev 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 * guix/import/cran.scm (vcs-file?, file-hash): Remove procedures. (description->package): Use 'file-hash*' instead. * guix/import/elpa.scm (vcs-file?, file-hash): Remove procedures. (git-repository->origin, elpa-package->sexp): Use 'file-hash* instead'. * guix/import/go.scm (vcs-file?, file-hash): Remove procedures. (git-checkout-hash): Use 'file-hash*' instead. --- guix/import/cran.scm | 32 +++----------------------------- guix/import/elpa.scm | 28 ++++------------------------ guix/import/go.scm | 26 +++----------------------- 3 files changed, 10 insertions(+), 76 deletions(-) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index f649928c5a..ac24bc117e 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2020 Martin Becze +;;; Copyright © 2021 Sarah Morgensen ;;; ;;; This file is part of GNU Guix. ;;; @@ -34,9 +35,8 @@ #:use-module (web uri) #:use-module (guix memoization) #:use-module (guix http-client) - #:use-module (gcrypt hash) + #:use-module (guix hash) #:use-module (guix store) - #:use-module ((guix serialization) #:select (write-file)) #:use-module (guix base32) #:use-module ((guix download) #:select (download-to-store)) #:use-module (guix import utils) @@ -194,17 +194,6 @@ bioconductor package NAME, or #F if the package is unknown." (bioconductor-packages-list type)) (cut assoc-ref <> "Version"))) -;; XXX taken from (guix scripts hash) -(define (vcs-file? file stat) - (case (stat:type stat) - ((directory) - (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS"))) - ((regular) - ;; Git sub-modules have a '.git' file that is a regular text file. - (string=? (basename file) ".git")) - (else - #f))) - ;; Little helper to download URLs only once. (define download (memoize @@ -437,16 +426,6 @@ reference the pkg-config tool." (define (needs-knitr? meta) (member "knitr" (listify meta "VignetteBuilder"))) -;; XXX adapted from (guix scripts hash) -(define (file-hash file select? recursive?) - ;; Compute the hash of FILE. - (if recursive? - (let-values (((port get-hash) (open-sha256-port))) - (write-file file port #:select? select?) - (force-output port) - (get-hash)) - (call-with-input-file file port-sha256))) - (define (description->package repository meta) "Return the `package' s-expression for an R package published on REPOSITORY from the alist META, which was derived from the R package's DESCRIPTION file." @@ -544,12 +523,7 @@ from the alist META, which was derived from the R package's DESCRIPTION file." (sha256 (base32 ,(bytevector->nix-base32-string - (case repository - ((git) - (file-hash source (negate vcs-file?) #t)) - ((hg) - (file-hash source (negate vcs-file?) #t)) - (else (file-sha256 source)))))))) + (file-hash* source)))))) ,@(if (not (and git? hg? (equal? (string-append "r-" name) (cran-guix-name name)))) diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index c0dc5acf51..22c937ca5f 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2018 Oleg Pykhalov ;;; Copyright © 2020 Martin Becze ;;; Copyright © 2020 Ricardo Wurmus +;;; Copyright © 2021 Sarah Morgensen ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,10 +37,10 @@ #:use-module (guix import utils) #:use-module (guix http-client) #:use-module (guix git) + #:use-module (guix hash) #:use-module ((guix serialization) #:select (write-file)) #:use-module (guix store) #:use-module (guix ui) - #:use-module (gcrypt hash) #:use-module (guix base32) #:use-module (guix upstream) #:use-module (guix packages) @@ -226,27 +227,6 @@ keywords to values." (close-port port) (data->recipe (cons ':name data)))) -;; XXX adapted from (guix scripts hash) -(define (file-hash file select? recursive?) - ;; Compute the hash of FILE. - (if recursive? - (let-values (((port get-hash) (open-sha256-port))) - (write-file file port #:select? select?) - (force-output port) - (get-hash)) - (call-with-input-file file port-sha256))) - -;; XXX taken from (guix scripts hash) -(define (vcs-file? file stat) - (case (stat:type stat) - ((directory) - (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS"))) - ((regular) - ;; Git sub-modules have a '.git' file that is a regular text file. - (string=? (basename file) ".git")) - (else - #f))) - (define (git-repository->origin recipe url) "Fetch origin details from the Git repository at URL for the provided MELPA RECIPE." @@ -268,7 +248,7 @@ RECIPE." (sha256 (base32 ,(bytevector->nix-base32-string - (file-hash directory (negate vcs-file?) #t))))))) + (file-hash* directory))))))) (define* (melpa-recipe->origin recipe) "Fetch origin details from the MELPA recipe and associated repository for @@ -379,7 +359,7 @@ type ''." (sha256 (base32 ,(if tarball - (bytevector->nix-base32-string (file-sha256 tarball)) + (bytevector->nix-base32-string (file-hash* tarball)) "failed to download package"))))))) (build-system emacs-build-system) ,@(maybe-inputs 'propagated-inputs dependencies) diff --git a/guix/import/go.scm b/guix/import/go.scm index 617a0d0e23..c6425667f8 100644 --- a/guix/import/go.scm +++ b/guix/import/go.scm @@ -25,6 +25,7 @@ (define-module (guix import go) #:use-module (guix build-system go) #:use-module (guix git) + #:use-module (guix hash) #:use-module (guix i18n) #:use-module (guix diagnostics) #:use-module (guix import utils) @@ -35,9 +36,7 @@ #:use-module ((guix licenses) #:prefix license:) #:use-module (guix memoization) #:autoload (htmlprag) (html->sxml) ;from Guile-Lib - #:autoload (guix git) (update-cached-checkout) - #:autoload (gcrypt hash) (open-hash-port hash-algorithm sha256) - #:autoload (guix serialization) (write-file) + #:autoload (gcrypt hash) (hash-algorithm sha256) #:autoload (guix base32) (bytevector->nix-base32-string) #:autoload (guix build utils) (mkdir-p) #:use-module (ice-9 match) @@ -494,25 +493,6 @@ source." goproxy (module-meta-repo-root meta-data))) -;; XXX: Copied from (guix scripts hash). -(define (vcs-file? file stat) - (case (stat:type stat) - ((directory) - (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS"))) - ((regular) - ;; Git sub-modules have a '.git' file that is a regular text file. - (string=? (basename file) ".git")) - (else - #f))) - -;; XXX: Adapted from 'file-hash' in (guix scripts hash). -(define* (file-hash file #:optional (algorithm (hash-algorithm sha256))) - ;; Compute the hash of FILE. - (let-values (((port get-hash) (open-hash-port algorithm))) - (write-file file port #:select? (negate vcs-file?)) - (force-output port) - (get-hash))) - (define* (git-checkout-hash url reference algorithm) "Return the ALGORITHM hash of the checkout of URL at REFERENCE, a commit or tag." @@ -531,7 +511,7 @@ tag." (update-cached-checkout url #:ref `(tag-or-commit . ,reference))))) - (file-hash checkout algorithm))) + (file-hash* checkout #:algorithm algorithm))) (define (vcs->origin vcs-type vcs-repo-url version) "Generate the `origin' block of a package depending on what type of source From patchwork Sun Aug 15 23:25:26 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Sarah Morgensen X-Patchwork-Id: 32122 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 7AA3E27BC78; Mon, 16 Aug 2021 00:26:23 +0100 (BST) 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_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,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 3FA3A27BC6B for ; Mon, 16 Aug 2021 00:26:23 +0100 (BST) Received: from localhost ([::1]:57836 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mFPWI-0000BX-BF for patchwork@mira.cbaines.net; Sun, 15 Aug 2021 19:26:22 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:37846) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mFPVz-0008Io-2O for guix-patches@gnu.org; Sun, 15 Aug 2021 19:26:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:36404) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mFPVy-0004ye-SO for guix-patches@gnu.org; Sun, 15 Aug 2021 19:26:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mFPVy-0001qm-PS for guix-patches@gnu.org; Sun, 15 Aug 2021 19:26:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50072] [PATCH WIP 3/4] refresh: Support non-tarball sources. Resent-From: Sarah Morgensen Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 15 Aug 2021 23:26:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50072 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 50072@debbugs.gnu.org Received: via spool by 50072-submit@debbugs.gnu.org id=B50072.16290699407064 (code B ref 50072); Sun, 15 Aug 2021 23:26:02 +0000 Received: (at 50072) by debbugs.gnu.org; 15 Aug 2021 23:25:40 +0000 Received: from localhost ([127.0.0.1]:47946 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mFPVc-0001pr-Cs for submit@debbugs.gnu.org; Sun, 15 Aug 2021 19:25:40 -0400 Received: from out0.migadu.com ([94.23.1.103]:31065) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mFPVZ-0001pT-8L for 50072@debbugs.gnu.org; Sun, 15 Aug 2021 19:25:38 -0400 X-Report-Abuse: Please report any abuse attempt to abuse@migadu.com and include these headers. DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=mgsn.dev; s=key1; t=1629069935; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:mime-version:mime-version:content-type:content-type: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=i3sWwu6rP2yY7l+g2SazGbRfisouEZXzlss71KFp3gU=; b=M3pDhzn0gAYR/P6gLql49wXSbrh7B4Fk918vASVXGKs2Qg993jglgq4fruM4TMYuxAtn+J C2HQEqjSE9LSzO7TG9b8QyReAAaMuRjDGuoi5MvEf8cLYZkaQl1WL9zRO6N5gH4L61urKE apvb4MriGBP1r/4KOvf5WedHDyylgJ8= From: Sarah Morgensen Date: Sun, 15 Aug 2021 16:25:26 -0700 Message-Id: <54668cb99babc81db0edfcdf2a8fa870bde96863.1629068119.git.iskarian@mgsn.dev> In-Reply-To: References: MIME-Version: 1.0 X-Migadu-Flow: FLOW_OUT X-Migadu-Auth-User: iskarian@mgsn.dev 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 * guix/scripts/refresh.scm (update-package): Use 'file-hash*' instead of 'port-sha256'. Rename TARBALL to OUTPUT. --- guix/scripts/refresh.scm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index fb6c52a567..abb0c24e96 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2018 Efraim Flashner ;;; Copyright © 2019 Ricardo Wurmus ;;; Copyright © 2020 Simon Tournier +;;; Copyright © 2021 Sarah Morgensen ;;; ;;; This file is part of GNU Guix. ;;; @@ -26,7 +27,6 @@ (define-module (guix scripts refresh) #:use-module (guix ui) - #:use-module (gcrypt hash) #:use-module (guix scripts) #:use-module ((guix scripts build) #:select (%standard-build-options)) #:use-module (guix store) @@ -38,6 +38,7 @@ #:use-module (guix scripts graph) #:use-module (guix monads) #:use-module (guix gnupg) + #:use-module (guix hash) #:use-module (gnu packages) #:use-module ((gnu packages commencement) #:select (%final-inputs)) #:use-module (ice-9 match) @@ -314,14 +315,14 @@ KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed values: 'interactive' (default), 'always', and 'never'. When WARN? is true, warn about packages that have no matching updater." (if (lookup-updater package updaters) - (let-values (((version tarball source) + (let-values (((version output source) (package-update store package updaters #:key-download key-download)) ((loc) (or (package-field-location package 'version) (package-location package)))) (when version - (if (and=> tarball file-exists?) + (if (and=> output file-exists?) (begin (info loc (G_ "~a: updating from version ~a to version ~a...~%") @@ -347,8 +348,7 @@ warn about packages that have no matching updater." (package-name package) (upstream-input-change-name change))) (upstream-source-input-changes source)) - (let ((hash (call-with-input-file tarball - port-sha256))) + (let ((hash (file-hash* output))) (update-package-source package source hash))) (warning (G_ "~a: version ~a could not be \ downloaded and authenticated; not updating~%") From patchwork Sun Aug 15 23:25:27 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Sarah Morgensen X-Patchwork-Id: 32123 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 8A9D927BC78; Mon, 16 Aug 2021 00:26:33 +0100 (BST) 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_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,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 01F3D27BC6B for ; Mon, 16 Aug 2021 00:26:33 +0100 (BST) Received: from localhost ([::1]:58088 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mFPWR-0000N9-SI for patchwork@mira.cbaines.net; Sun, 15 Aug 2021 19:26:32 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:37848) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mFPVz-0008Jn-Fg for guix-patches@gnu.org; Sun, 15 Aug 2021 19:26:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:36405) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mFPVz-0004yp-9A for guix-patches@gnu.org; Sun, 15 Aug 2021 19:26:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mFPVz-0001qu-5x for guix-patches@gnu.org; Sun, 15 Aug 2021 19:26:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins. Resent-From: Sarah Morgensen Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 15 Aug 2021 23:26:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50072 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 50072@debbugs.gnu.org Received: via spool by 50072-submit@debbugs.gnu.org id=B50072.16290699417072 (code B ref 50072); Sun, 15 Aug 2021 23:26:03 +0000 Received: (at 50072) by debbugs.gnu.org; 15 Aug 2021 23:25:41 +0000 Received: from localhost ([127.0.0.1]:47948 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mFPVc-0001pt-M6 for submit@debbugs.gnu.org; Sun, 15 Aug 2021 19:25:41 -0400 Received: from out0.migadu.com ([94.23.1.103]:31077) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mFPVa-0001pZ-D7 for 50072@debbugs.gnu.org; Sun, 15 Aug 2021 19:25:39 -0400 X-Report-Abuse: Please report any abuse attempt to abuse@migadu.com and include these headers. DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=mgsn.dev; s=key1; t=1629069937; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:mime-version:mime-version:content-type:content-type: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=SaBFF2tRm7PZlrCixzWhD5HmIJdo0elYCu26DpndMPE=; b=dYLKoTk49hRJ19rfQYYfqNKaWd9X0R6fYgzpstssHtb/XZIq3EMi172z11IVqhPsIXGsY8 xq3uPcxRKHwCpB5UknK7kd20P19lcX0xvlrbqhtgCp4g/+RPYmR287UpiPtpL58fwe0PDU xEOmetKcpXJK0zb/1cSDMete83ra7f8= From: Sarah Morgensen Date: Sun, 15 Aug 2021 16:25:27 -0700 Message-Id: <8d1ae518b23fac5b15812a30b11df1c360ab3fbf.1629068119.git.iskarian@mgsn.dev> In-Reply-To: References: MIME-Version: 1.0 X-Migadu-Flow: FLOW_OUT X-Migadu-Auth-User: iskarian@mgsn.dev 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 * guix/git-download.scm (checkout-to-store): New procedure. * guix/upstream.scm (guess-version-transform) (package-update/git-fetch): New procedures. (%method-updates): Add GIT-FETCH mapping. --- guix/git-download.scm | 18 +++++++++++++++++- guix/upstream.scm | 41 ++++++++++++++++++++++++++++++++++++++++- 2 files changed, 57 insertions(+), 2 deletions(-) diff --git a/guix/git-download.scm b/guix/git-download.scm index 5e624b9ae9..a7bdc16718 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2017 Mathieu Lirzin ;;; Copyright © 2017 Christopher Baines ;;; Copyright © 2020 Jakub Kądziołka +;;; Copyright © 2021 Sarah Morgensen ;;; ;;; This file is part of GNU Guix. ;;; @@ -26,6 +27,7 @@ #:use-module (guix records) #:use-module (guix packages) #:use-module (guix modules) + #:use-module (guix git) #:autoload (guix build-system gnu) (standard-packages) #:autoload (git bindings) (libgit2-init!) #:autoload (git repository) (repository-open @@ -53,7 +55,9 @@ git-fetch git-version git-file-name - git-predicate)) + git-predicate + + checkout-to-store)) ;;; Commentary: ;;; @@ -287,4 +291,16 @@ absolute file name and STAT is the result of 'lstat'." (#f #f))))) (const #f))) +(define* (checkout-to-store store ref #:key (log (current-error-port))) + "Checkout REF to STORE. Write progress reports to LOG. RECURSIVE? has the +same effect as the same-named parameter of 'latest-repository-commit'." + ;; XXX: (guix git) does not use shallow clones, so this will be slow + ;; for long-running repositories. + (match-record ref + (url commit recursive?) + (latest-repository-commit store url + #:ref `(tag-or-commit . ,commit) + #:recursive? recursive? + #:log-port log))) + ;;; git-download.scm ends here diff --git a/guix/upstream.scm b/guix/upstream.scm index 632e9ebc4f..927260cd89 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2015 Alex Kost ;;; Copyright © 2019 Ricardo Wurmus +;;; Copyright © 2021 Sarah Morgensen ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +25,7 @@ #:use-module (guix discovery) #:use-module ((guix download) #:select (download-to-store url-fetch)) + #:use-module (guix git-download) #:use-module (guix gnupg) #:use-module (guix packages) #:use-module (guix diagnostics) @@ -430,9 +432,46 @@ SOURCE, an ." #:key-download key-download))) (values version tarball source)))))) +(define (guess-version-transform commit from-version) + "Return a one-argument proc that transforms FROM-VERSION to COMMIT, or #f +if no such transformation could be determined." + ;; Just handle prefixes for now, since that's the most common. + (if (string-suffix? from-version commit) + (let* ((version-length (string-length from-version)) + (commit-prefix (string-drop-right commit version-length))) + (lambda (version) + (string-append commit-prefix version))) + #f)) + +(define* (package-update/git-fetch store package source + #:key key-download) + "Return the version, checkout, and SOURCE, to update PACKAGE to +SOURCE, an ." + + (define (uri-update/git old-uri old-version url version) + (let* ((old-commit (git-reference-commit old-uri)) + (transform (guess-version-transform old-commit old-version))) + (and transform + (git-reference + (inherit old-uri) + (url url) + (commit (transform version)))))) + + ;; Only use the first element of URLS. + (match-record source + (version urls) + (let* ((old-uri (origin-uri (package-source package))) + (old-version (package-version package)) + (new-uri (uri-update/git old-uri old-version + (first urls) version))) + (if new-uri + (values version (checkout-to-store store new-uri) source) + (values #f #f #f))))) + (define %method-updates ;; Mapping of origin methods to source update procedures. - `((,url-fetch . ,package-update/url-fetch))) + `((,url-fetch . ,package-update/url-fetch) + (,git-fetch . ,package-update/git-fetch))) (define* (package-update store package #:optional (updaters (force %updaters))