[PATCH WIP 0/4] Add upstream updater for git-fetch origins.

Done

Details

5 participants

Sarah Morgensen
Ludovic Courtès
Maxime Devos
Xinglu Chen
zimoun

Owner: unassigned

Submitted by: Sarah Morgensen

Severity: normal

Sarah Morgensen wrote on 16 Aug 2021 01:16

Recipients:(address . guix-patches@gnu.org)

Message-ID:cover.1629068119.git.iskarian@mgsn.dev

Hello Guix,

This is a proof-of-concept for extending `guix refresh -u` to support packages

with git-fetch origins. The potential impact is large: approximately 4.5k

packages use git-fetch, although only some fraction would be supported.

Currently, this enables update support for (at least) any package where

* github-updater finds an update,

* origin-method is 'git-fetch', and

* the package version is a suffix of the 'commit' field.

Drawbacks currently include the fact that libgit2 doesn't (yet) support

shallow checkouts [0], so the entire repository must be cloned. There is also

no support for verifying commits.

There should probably also be a few tests added.

WDYT?

[0] https://github.com/libgit2/libgit2/issues/3058

Sarah Morgensen (4):

guix hash: Extract file hashing procedures.

import: Factorize file hashing.

refresh: Support non-tarball sources.

upstream: Support updating git-fetch origins.

guix/git-download.scm | 18 +++++++++++++-

guix/hash.scm | 51 ++++++++++++++++++++++++++++++++++++++++

guix/import/cran.scm | 32 +++----------------------

guix/import/elpa.scm | 28 ++++------------------

guix/import/go.scm | 26 +++-----------------

guix/scripts/hash.scm | 29 ++++++-----------------

guix/scripts/refresh.scm | 10 ++++----

guix/upstream.scm | 41 +++++++++++++++++++++++++++++++-

8 files changed, 130 insertions(+), 105 deletions(-)

create mode 100644 guix/hash.scm

base-commit: 12099eac1b161d364be923451d27d7d739d0f14d

2.31.1

Sarah Morgensen wrote on 16 Aug 2021 01:25

[PATCH WIP 1/4] guix hash: Extract file hashing procedures.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:9ba0b798de2fdf859f94ca7b2f1ee052bceac63a.1629068119.git.iskarian@mgsn.dev

* 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

Toggle diff (120 lines)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 <iskarian@mgsn.dev>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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 <nikita@karetnikov.org>
 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; 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)
-- 
2.31.1

Sarah Morgensen wrote on 16 Aug 2021 01:25

[PATCH WIP 2/4] import: Factorize file hashing.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:82bab33f2d4a03c8e83d1825648577fbae3aee7e.1629068119.git.iskarian@mgsn.dev

* 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(-)

Toggle diff (202 lines)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 <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; 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 <go.wigust@gmail.com>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; 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 '<elpa-package>'."
                         (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
-- 
2.31.1

Sarah Morgensen wrote on 16 Aug 2021 01:25

[PATCH WIP 3/4] refresh: Support non-tarball sources.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:54668cb99babc81db0edfcdf2a8fa870bde96863.1629068119.git.iskarian@mgsn.dev

* 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(-)

Toggle diff (57 lines)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 <efraim@flashner.co.il>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; 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~%")
-- 
2.31.1

Sarah Morgensen wrote on 16 Aug 2021 01:25

[PATCH WIP 4/4] upstream: Support updating git-fetch origins.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:8d1ae518b23fac5b15812a30b11df1c360ab3fbf.1629068119.git.iskarian@mgsn.dev

* 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(-)

Toggle diff (118 lines)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 <mthl@gnu.org>
 ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
 ;;; Copyright © 2020 Jakub K?dzio?ka <kuba@kadziolka.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; 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 <git-reference>
+    (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 <ludo@gnu.org>
 ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; 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 <upstream-source>."
                                         #: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 <upstream-source>."
+
+  (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 <upstream-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))
-- 
2.31.1

Maxime Devos wrote on 16 Aug 2021 12:46

Recipients:

Message-ID:cbcef388b1df20c24b6615a006c0daaf50f74b1f.camel@telenet.be

Sarah Morgensen schreef op zo 15-08-2021 om 16:25 [-0700]:

Toggle quote (5 lines)

> * 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.

Does it support packages defined like (a)

(define-public gnash
  (let ((commit "583ccbc1275c7701dc4843ec12142ff86bb305b4")
        (revision "0"))
    (package
      (name "gnash")
      (version (git-version "0.8.11" revision commit))
      (source (git-reference
                (url "https://example.org")
                (commit commit)))
      [...])))

and (b)

(define-public gnash
  (package
    (name "gnash")
    (version "0.8.11")
    (source (git-reference
              (url "https://example.org")
              (commit commit))
    [...]))
?

(Maybe (a) and (b) can be used as test cases.)

FWIW, I had a try at supporting git-fetch origins in "--with-latest" and
"guix refresh -e" myself, and had to modify 'package-update' to replace
commit strings.  IIRC, it supports (b), but not (a).  The patch is
attached, hopefully it will be useful.

Greetings,
Maxime.

Attachment: git-fetch.patch

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYRpCAhccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7mtFAQC2K6AYws89maCmlssXfSbym3b2

9CG2Ima2OaxW4a7k3wD/Z1vXqq7oTCNKbFPVwtQSEH++PEd83p7UKB2LMsw+cgg=

=ilA3

-----END PGP SIGNATURE-----

Xinglu Chen wrote on 16 Aug 2021 15:02

Recipients:

Message-ID:87wnol8rw3.fsf@yoctocell.xyz

On Mon, Aug 16 2021, Maxime Devos wrote:

Toggle quote (17 lines)> Sarah Morgensen schreef op zo 15-08-2021 om 16:25 [-0700]:
>> * 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.
>
> Does it support packages defined like (a)
>
> (define-public gnash
>   (let ((commit "583ccbc1275c7701dc4843ec12142ff86bb305b4")
>         (revision "0"))
>     (package
>       (name "gnash")
>       (version (git-version "0.8.11" revision commit))
>       (source (git-reference
>                 (url "https://example.org")

IIUC, it only supports GitHub URLs at the moment. I have a WIP patch

for adding support for any arbitrary Git repository[1].

[1]:

https://git.yoctocell.xyz/guix/commit/?h=guix-upstream-git-fetch&id=0356c7603a4611d40875b4eb352e3378295f34bc

Maxime Devos wrote on 16 Aug 2021 20:15

Recipients:

Message-ID:12f985cd431b8b8099f680a3b25ed2eb90e6b26d.camel@telenet.be

Xinglu Chen schreef op ma 16-08-2021 om 15:02 [+0200]:

Toggle quote (22 lines)> On Mon, Aug 16 2021, Maxime Devos wrote:
> 
> > Sarah Morgensen schreef op zo 15-08-2021 om 16:25 [-0700]:
> > > * 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.
> > 
> > Does it support packages defined like (a)
> > 
> > (define-public gnash
> >   (let ((commit "583ccbc1275c7701dc4843ec12142ff86bb305b4")
> >         (revision "0"))
> >     (package
> >       (name "gnash")
> >       (version (git-version "0.8.11" revision commit))
> >       (source (git-reference
> >                 (url "https://example.org")
> 
> IIUC, it only supports GitHub URLs at the moment.  I have a WIP patch
> for adding support for any arbitrary Git repository[1].

This patch series doesn't mention GitHub anywhere (except in the patch
series description) so I don't think it only supports GitHub URLs.
Admittedly, only one updater, "github", currently produces git-reference
URLs, but I sent a patch series [2] that adds an importer which produces
git-reference URLs and the corresponding updater (see ‘git-fetch.patch’)
produces appropriate git-reference objects.

[2]: https://issues.guix.gnu.org/49828#51.

Greetings,
Maxime.

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYRqrKxccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7hj2AQDWxLAJXlGpJDkETEBgpnyP1iqC

LTkAy45kWUZkOdqY1AD6A2CMB630ENX8F2HOy6f9iMU1h6G/+xqqCy7ltH39AwI=

=487y

-----END PGP SIGNATURE-----

Sarah Morgensen wrote on 16 Aug 2021 21:56

Re: bug#50072: [PATCH WIP 0/4] Add upstream updater for git-fetch origins.

Recipients:(name . Maxime Devos)(address . maximedevos@telenet.be)

Message-ID:86fsv9jh8h.fsf_-_@mgsn.dev

Hi Maxime,

Thanks for taking a look at this. :)

Maxime Devos <maximedevos@telenet.be> writes:

Toggle quote (19 lines)> Sarah Morgensen schreef op zo 15-08-2021 om 16:25 [-0700]:
>> * 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.
>
> Does it support packages defined like (a)
>
> (define-public gnash
>   (let ((commit "583ccbc1275c7701dc4843ec12142ff86bb305b4")
>         (revision "0"))
>     (package
>       (name "gnash")
>       (version (git-version "0.8.11" revision commit))
>       (source (git-reference
>                 (url "https://example.org")
>                 (commit commit)))
>       [...])))

No, it doesn't. Since the commit definition isn't part of the actual

package definition, the current code has no way of updating it. It

would require a rewrite of the edit-in-place logic with probably a lot

of special-casing.

There are currently ~1250 package which use this format, though, so it

could be worth it... Perhaps what we actually need is a better idiom to

express this situation. Package properties ('git-commit)? A 'git-version*'?

Toggle snippet (6 lines)

(define (git-version* version revision)

(let* ((source (package-source this-package))

(commit (git-reference-commit (origin-uri source))))

(git-version version revision commit)))

I'm not sure if binding order would be an issue with that.

Toggle quote (12 lines)> and (b)
>
> (define-public gnash
>   (package
>     (name "gnash")
>     (version "0.8.11")
>     (source (git-reference
>               (url "https://example.org")
>               (commit commit))
>     [...]))
> ?

Is this missing a definition for commit? If it's like above, the same

applies. Or if you mean

Toggle snippet (5 lines)

(source (git-reference

(url "https://example.org")

(commit "583ccbc1275c7701dc4843ec12142ff86bb305b"))

Then that wouldn't be too hard to support. There seem to be ~136

packages with this idiom.

Toggle quote (51 lines)> (Maybe (a) and (b) can be used as test cases.)
>
> FWIW, I had a try at supporting git-fetch origins in "--with-latest" and
> "guix refresh -e" myself, and had to modify 'package-update' to replace
> commit strings.  IIRC, it supports (b), but not (a).  The patch is
> attached, hopefully it will be useful.
>
> Greetings,
> Maxime.
>
> diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
> index 4264341d6a..2904c3f94a 100644
> --- a/guix/import/minetest.scm
> +++ b/guix/import/minetest.scm
> @@ -297,7 +297,7 @@ results.  The return value is a list of <package/keys> records."
>  (define (make-minetest-sexp author/name version repository commit
>                              inputs home-page synopsis
>                              description media-license license)
> -  "Return a S-expression for the minetest package with the given author/NAME,
> +  "Return a S-expression for the minetest package with the given AUTHOR/NAME,
>  VERSION, REPOSITORY, COMMIT, INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION,
>  MEDIA-LICENSE and LICENSE."
>    `(package
> @@ -452,3 +452,37 @@ list of AUTHOR/NAME strings."
>                      #:repo->guix-package minetest->guix-package*
>                      #:guix-name
>                      (compose contentdb->package-name author/name->name)))
> +
> +#|
> +(define (minetest-package? pkg)
> +  (and (string-prefix? "minetest-" (package:package-name pkg))
> +       (assq-ref (package:package-properties pkg) 'upstream-name)))
> +
> +(define (latest-minetest-release pkg)
> +  "Return an <upstream-source> for the latest release of the package PKG."
> +  (define upstream-name
> +    (assoc-ref (package:package-properties pkg) 'upstream-name))
> +  (define contentdb-package (contentdb-fetch upstream-name))
> +  (define release (latest-release upstream-name))
> +  (and contentdb-package release
> +       (and-let* ((old-origin (package:package-source pkg))
> +                  (old-reference (package:origin-uri old-origin))
> +                  (is-git? (download:git-reference? old-reference))
> +                  (commit (release-commit release)))
> +         (upstream-source
> +          (package (package:package-name pkg))
> +          (version (release-title release))
> +          (urls (download:git-reference
> +                 (url (package-repository contentdb-package))
> +                 (commit commit)))))))

Aha! This is actually what should be done, having the updater put the

git-reference into upstream-source, since the updater is going to know

better how to manipulate the uri.

Toggle quote (87 lines)> +
> +(define %minetest-updater
> +  (upstream-updater
> +   (name 'minetest)
> +   (description "Updater for Minetest packages on ContentDB")
> +   (pred minetest-package?)
> +   (latest latest-minetest-release)))
> +|#
> +;;  #:use-module (guix upstream)
> +;;  #:use-module ((guix git-download) #:prefix download:)
> +;;  #:use-module ((guix packages) #:prefix package:)
> diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
> index fb6c52a567..4f3bbbcb94 100644
> --- a/guix/scripts/refresh.scm
> +++ b/guix/scripts/refresh.scm
> @@ -28,8 +28,10 @@
>    #:use-module (guix ui)
>    #:use-module (gcrypt hash)
>    #:use-module (guix scripts)
> +  #:use-module (guix serialization)
>    #:use-module ((guix scripts build) #:select (%standard-build-options))
>    #:use-module (guix store)
> +  #:use-module (guix build utils)
>    #:use-module (guix utils)
>    #:use-module (guix packages)
>    #:use-module (guix profiles)
> @@ -307,6 +309,17 @@ update would trigger a complete rebuild."
>             (G_ "no updater for ~a~%")
>             (package-name package)))
>  
> +
> +;; 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* (update-package store package updaters
>                           #:key (key-download 'interactive) warn?)
>    "Update the source file that defines PACKAGE with the new version.
> @@ -347,8 +360,8 @@ 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 tarball (const #t)
> +                                       (directory-exists? tarball))))
>                    (update-package-source package source hash)))
>                (warning (G_ "~a: version ~a could not be \
>  downloaded and authenticated; not updating~%")
> diff --git a/guix/upstream.scm b/guix/upstream.scm
> index 632e9ebc4f..61f67b57c1 100644
> --- a/guix/upstream.scm
> +++ b/guix/upstream.scm
> @@ -24,6 +24,11 @@
>    #:use-module (guix discovery)
>    #:use-module ((guix download)
>                  #:select (download-to-store url-fetch))
> +  #:use-module ((guix git-download)
> +                #:select (git-fetch git-reference?
> +                                    git-reference-url
> +                                    git-reference-commit
> +                                    git-reference-recursive?))
>    #:use-module (guix gnupg)
>    #:use-module (guix packages)
>    #:use-module (guix diagnostics)
> @@ -33,6 +38,7 @@
>    #:use-module (guix store)
>    #:use-module ((guix derivations) #:select (built-derivations derivation->output-path))
>    #:autoload   (gcrypt hash) (port-sha256)
> +  #:autoload   (guix git) (latest-repository-commit)
>    #:use-module (guix monads)
>    #:use-module (srfi srfi-1)
>    #:use-module (srfi srfi-9)
> @@ -93,7 +99,8 @@
>    upstream-source?
>    (package        upstream-source-package)        ;string
>    (version        upstream-source-version)        ;string
> -  (urls           upstream-source-urls)           ;list of strings
> +  ; list of strings or a <git-reference>
> +  (urls           upstream-source-urls)

Is it possible for an updater to want to return a list of

<git-reference>? I'm still not sure what the purpose of multiple urls

is, since nearly everthing seems to just take (first urls)...

Toggle quote (19 lines)>    (signature-urls upstream-source-signature-urls  ;#f | list of strings
>                    (default #f))
>    (input-changes  upstream-source-input-changes
> @@ -361,6 +368,11 @@ values: 'interactive' (default), 'always', and 'never'."
>                                                  system target)
>    "Download SOURCE from its first URL and lower it as a fixed-output
>  derivation that would fetch it."
> +  (define url
> +    (match (upstream-source-urls source)
> +      ((first . _) first)
> +      (_ (raise (formatted-message
> +                 (G_ "git origins are unsupported by --with-latest"))))))
>    (mlet* %store-monad ((url -> (first (upstream-source-urls source)))
>                         (signature
>                          -> (and=> (upstream-source-signature-urls source)
> @@ -430,9 +442,23 @@ SOURCE, an <upstream-source>."
>                                          #:key-download key-download)))
>           (values version tarball source))))))

What is this 'upstream-source-compiler' actually used for? I couldn't

figure that out, so I just left it untouched.

Toggle quote (57 lines)>  
> +(define* (package-update/git-fetch store package source #:key key-download)
> +  "Return the version, source code directory, and SOURCE, to update PACKAGE to
> +SOURCE, an <upstream-source>."
> +  (match source
> +    (($ <upstream-source> _ version ref _)
> +     (values version
> +             (latest-repository-commit
> +              store
> +              (git-reference-url ref)
> +              #:ref `(commit . ,(git-reference-commit ref))
> +              #:recursive? (git-reference-recursive? ref))
> +             source))))
> +
>  (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))
> @@ -492,9 +518,22 @@ new version string if an update was made, and #f otherwise."
>                               (origin-hash (package-source package))))
>                 (old-url     (match (origin-uri (package-source package))
>                                ((? string? url) url)
> +                              ((? git-reference? ref)
> +                               (git-reference-url ref))
>                                (_ #f)))
>                 (new-url     (match (upstream-source-urls source)
> -                              ((first _ ...) first)))
> +                              ((first _ ...) first)
> +                              ((? git-reference? ref)
> +                               (git-reference-url ref))
> +                              (_ #f)))
> +               (old-commit  (match (origin-uri (package-source package))
> +                              ((? git-reference? ref)
> +                               (git-reference-commit ref))
> +                              (_ #f)))
> +               (new-commit  (match (upstream-source-urls source)
> +                              ((? git-reference? ref)
> +                               (git-reference-commit ref))
> +                              (_ #f)))
>                 (file        (and=> (location-file loc)
>                                     (cut search-path %load-path <>))))
>            (if file
> @@ -508,6 +547,9 @@ new version string if an update was made, and #f otherwise."
>                                             'filename file))
>                      (replacements `((,old-version . ,version)
>                                      (,old-hash . ,hash)
> +                                    ,@(if (and old-commit new-commit)
> +                                          `((,old-commit . ,new-commit))
> +                                          '())
>                                      ,@(if (and old-url new-url)
>                                            `((,(dirname old-url) .
>                                               ,(dirname new-url)))

Thanks for sharing your work; it was very helpful!

Sarah

Maxime Devos wrote on 17 Aug 2021 12:18

Recipients:(name . Sarah Morgensen)(address . iskarian@mgsn.dev)

Message-ID:7986923ce7712dc341e859e62675abee12072922.camel@telenet.be

Sarah Morgensen schreef op ma 16-08-2021 om 12:56 [-0700]:

Toggle quote (30 lines)> Hi Maxime,
> 
> Thanks for taking a look at this. :)
> 
> Maxime Devos <maximedevos@telenet.be> writes:
> 
> > Sarah Morgensen schreef op zo 15-08-2021 om 16:25 [-0700]:
> > > * 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.
> > 
> > Does it support packages defined like (a)
> > 
> > (define-public gnash
> >   (let ((commit "583ccbc1275c7701dc4843ec12142ff86bb305b4")
> >         (revision "0"))
> >     (package
> >       (name "gnash")
> >       (version (git-version "0.8.11" revision commit))
> >       (source (git-reference
> >                 (url "https://example.org")
> >                 (commit commit)))
> >       [...])))
> 
> No, it doesn't.  Since the commit definition isn't part of the actual
> package definition, the current code has no way of updating it.  It
> would require a rewrite of the edit-in-place logic with probably a lot
> of special-casing.

Perhaps a 'surrounding-expression-location' procedure can be defined?

(define (surrounding-expression-location inner-location)

"Determine the location of the S-expression that surrounds the S-expression

at INNER-LOCATION, or #false if the inner S-expression is at the top-level."

??? Something like 'read', but in reverse, maybe?

Doesn't need to support every construct, just "string without escapes" and

(parentheses other-things) might be good enough in practice for now)

Seems tricky to implement, but it would be more robust than relying

on conventions like ‘the surrounding 'let' can be found by moving two columns

and two lines backwards’. Or see another method (let&) below that is actually

implemented ...

Toggle quote (13 lines)> There are currently ~1250 package which use this format, though, so it
> could be worth it...  Perhaps what we actually need is a better idiom to
> express this situation.  Package properties ('git-commit)?  A 'git-version*'?
> 
> --8<---------------cut here---------------start------------->8---
> (define (git-version* version revision)
>   (let* ((source (package-source this-package))
>          (commit (git-reference-commit (origin-uri source))))
>     (git-version version revision commit)))
> --8<---------------cut here---------------end--------------->8---
> 
> I'm not sure if binding order would be an issue with that.

The 'file-name' field of 'origin' is not thunked, and refers to the 'version'

field of the 'package' (also not thunked). If 'version' would use the 'git-version*'

from above, then there would be a loop (I'm having the 'gnash' package in mind,

see "guix edit gnash"). And git-version* cannot be a procedure, it must be a macro,

as it used 'this-package', which can only be expanded inside a package definition.

Alternatively, what do you think of a let& macro, that adjusts the inner expression

to have the source location of the 'let&' form:

(define-syntax with-source-location

(lambda (s)

(syntax-case s ()

((_ (exp . exp*) source)

"Expand to (EXP . EXP*), but with the source location replaced

by the source location of SOURCE."

(datum->syntax s (cons #'exp #'exp*) #:source (syntax-source #'source))))))

(define-syntax let&

(lambda (s)

"Like 'let', but let the inner expression have the location

of the 'let&' form when it is expanded. Only a single inner

expression is allowed."

(syntax-case s ()

((_ bindings exp)

#'(let bindings

(with-source-location exp s))))))

That way, 'update-package-source' doesn't need to know about the surrounding

'let' form; it would simply use 'edit-expression' as usual (though something

,@(if (and old-commit new-commit)

`((,old-commit . ,new-commit))

'())

would need to be added, and something to replace ‘(revision "N")’ with

‘(revision "N+1")’.)

A complete example is attached (a.scm). The previous usages of

(let ((commit ...) (revision ...)) ...) would need to be adjusted

to use let& instead (build-aux/update-guix-package.scm needs to

be adjusted as well).

Personally, I'd go with the 'let&' form

Toggle quote (21 lines)> > and (b)
> > 
> > (define-public gnash
> >   (package
> >     (name "gnash")
> >     (version "0.8.11")
> >     (source (git-reference
> >               (url "https://example.org")
> >               (commit commit))
> >     [...]))
> > ?
> 
> Is this missing a definition for commit? If it's like above, the same
> applies.  Or if you mean
> 
> --8<---------------cut here---------------start------------->8---
>      (source (git-reference
>                (url "https://example.org")
>                (commit "583ccbc1275c7701dc4843ec12142ff86bb305b"))
> --8<---------------cut here---------------end--------------->8---

The latter.

Toggle quote (3 lines)

> Then that wouldn't be too hard to support. There seem to be ~136

> packages with this idiom.

FWIW, the patch I sent modified 'update-package-source' to replace

the commit in this case (b) (but not case (a)).

Toggle quote (12 lines)> > [the patch Maxime sent]
> > 
> >    upstream-source?
> >    (package        upstream-source-package)        ;string
> >    (version        upstream-source-version)        ;string
> > -  (urls           upstream-source-urls)           ;list of strings
> > +  ; list of strings or a <git-reference>
> > +  (urls           upstream-source-urls)
> 
> Is it possible for an updater to want to return a list of
> <git-reference>?

No, 'git-fetch' from (guix git-download) only accepts a single <git-reference>
object, it doesn't support lists of <git-reference>.  It will throw a type
error if a list is passed.  Compare with 'url-fetch*', which does accept a list
of URLs (in which case it will fall-back to the second, the third, the fourth ...
entry when the first entry gives a 404 or something).

Toggle quote (3 lines)

> I'm still not sure what the purpose of multiple urls

> is, since nearly everthing seems to just take (first urls)...

As I understand it, the second, third, fourth ... URL (when using url-fetch)
are fall-backs.  Also, (guix upstream) sometimes distinguishes between the
different URLs, see e.g. package-update/url-fetch, which will try to choose a
tarball with the same kind of extension (.zip, .tar.gz, .tar.xz, ...) as the original
URI.

Toggle quote (22 lines)> >    (signature-urls upstream-source-signature-urls  ;#f | list of strings
> >                    (default #f))
> >    (input-changes  upstream-source-input-changes
> > @@ -361,6 +368,11 @@ values: 'interactive' (default), 'always', and 'never'."
> >                                                  system target)
> >    "Download SOURCE from its first URL and lower it as a fixed-output
> >  derivation that would fetch it."
> > +  (define url
> > +    (match (upstream-source-urls source)
> > +      ((first . _) first)
> > +      (_ (raise (formatted-message
> > +                 (G_ "git origins are unsupported by --with-latest"))))))
> >    (mlet* %store-monad ((url -> (first (upstream-source-urls source)))
> >                         (signature
> >                          -> (and=> (upstream-source-signature-urls source)
> > @@ -430,9 +442,23 @@ SOURCE, an <upstream-source>."
> >                                          #:key-download key-download)))
> >           (values version tarball source))))))
> 
> What is this 'upstream-source-compiler' actually used for?  I couldn't
> figure that out, so I just left it untouched.

It is used to ‘lower’ <upstream-source> objects.  More specifically,
transform-package-latest from (guix transformations) will sometimes
replace the 'source' of a package with a <upstream-source> object,
and 'upstream-source-compiler' is used to turn the <upstream-source>
into a (fixed-output) derivation that can be built into a
/gnu/store/...-checkout or /gnu/store/...-version.tar.gz file in the store.

Greetings,
Maxime

;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; 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 <http://www.gnu.org/licenses/>. (use-modules (guix packages) (gnu packages animation) (guix git-download)) (define-syntax with-source-location (lambda (s) (syntax-case s () ((_ (exp . exp*) source) "Expand to (EXP . EXP*), but with the source location replaced by the source location of SOURCE." (datum->syntax s (cons #'exp #'exp*) #:source (syntax-source #'source)))))) (define-syntax let& (lambda (s) "Like 'let', but let the inner expression have the location of the 'let&' form when it is expanded. Only a single inner expression is allowed." (syntax-case s () ((_ bindings exp) #'(let bindings (with-source-location exp s)))))) (define-public gnash2 ;; The last tagged release of Gnash was in 2013. (let& ((commit "583ccbc1275c7701dc4843ec12142ff86bb305b4") (revision "0")) (package (inherit gnash) (name "gnash2") (version (git-version "0.8.11" revision commit)) (source (origin (method git-fetch) (uri (git-reference (url "https://git.savannah.gnu.org/git/gnash.git/") (commit commit))) (file-name (git-file-name name version)) (patches (search-patches "gnash-fix-giflib-version.patch")) (sha256 (base32 "0fh0bljn0i6ypyh6l99afi855p7ki7lm869nq1qj6k8hrrwhmfry"))))))) (format #t "old: ~a~%" (package-location gnash)) (format #t "new: ~a~%" (package-location gnash2)) ;; ^ it says column 2, which is the column of the let& form.

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYRuM9BccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7sCHAP9xBj75KhXqSDRyCSSQFyATroZ3

K22ko8hK0JHF1DtoFAD/U7vAsQq8rQXjBlwMe2f+W0O55HD6OTDRwZ99pKRdwwo=

=BfS0

-----END PGP SIGNATURE-----

Xinglu Chen wrote on 18 Aug 2021 16:45

Re: [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins.

Recipients:

Message-ID:878s0yke14.fsf@yoctocell.xyz

On Mon, Aug 16 2021, Maxime Devos wrote:

Toggle quote (28 lines)> Xinglu Chen schreef op ma 16-08-2021 om 15:02 [+0200]:
>> On Mon, Aug 16 2021, Maxime Devos wrote:
>> 
>> > Sarah Morgensen schreef op zo 15-08-2021 om 16:25 [-0700]:
>> > > * 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.
>> > 
>> > Does it support packages defined like (a)
>> > 
>> > (define-public gnash
>> >   (let ((commit "583ccbc1275c7701dc4843ec12142ff86bb305b4")
>> >         (revision "0"))
>> >     (package
>> >       (name "gnash")
>> >       (version (git-version "0.8.11" revision commit))
>> >       (source (git-reference
>> >                 (url "https://example.org")
>> 
>> IIUC, it only supports GitHub URLs at the moment.  I have a WIP patch
>> for adding support for any arbitrary Git repository[1].
>
> This patch series doesn't mention GitHub anywhere (except in the patch
> series description) so I don't think it only supports GitHub URLs.
> Admittedly, only one updater, "github", currently produces git-reference
> URLs,

That was what I was referring to, sorry for not making it clearer.

Only the ‘github’ updater can update ‘git-fetch’ origins;

=> only GitHub URLs can are recognized by the ‘github’ updater;

=> thus, only packages hosted on GitHub can be updated.

Toggle quote (6 lines)

> but I sent a patch series [2] that adds an importer which produces

> git-reference URLs and the corresponding updater (see ‘git-fetch.patch’)

> produces appropriate git-reference objects.

> [2]: <https://issues.guix.gnu.org/49828#51>.

I haven’t looked at the patches yet, but that looks very cool! :-)

Maxime Devos wrote on 30 Aug 2021 23:36

Re: [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.

Recipients:(name . Sarah Morgensen)(address . iskarian@mgsn.dev)

Message-ID:2c76cd38605f4358df29ed0d464a8f5512b1b662.camel@telenet.be

Maxime Devos schreef op di 17-08-2021 om 12:18 [+0200]:

Toggle quote (14 lines)> [... stuff about let&, let*&, supporting packages like:
> > > (define-public gnash
> > >   (let ((commit "583ccbc1275c7701dc4843ec12142ff86bb305b4")
> > >         (revision "0"))
> > >     (package
> > >       (name "gnash")
> > >       (version (git-version "0.8.11" revision commit))
> > >       (source (git-reference
> > >                 (url "https://example.org")
> > >                 (commit commit)))
> > >       [...])))
> > ...
> ... by fudging the source locations ...]

I went ahead and send a patch replacing 'let' with 'let&':

https://issues.guix.gnu.org/50286.

Greetings,

Maxime.

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYS1PXBccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7h2rAP0VJi/wmuk0zSVG122dfNY7jHOM

b27we11DqPJz77yfpgEA8Io5XvYfNa2WMyAt84BkSWyM/IlMlsrnLUtm9ImBcQM=

=P2nY

-----END PGP SIGNATURE-----

Ludovic Courtès wrote on 6 Sep 2021 12:23

Re: bug#50072: [PATCH WIP 0/4] Add upstream updater for git-fetch origins.

Recipients:(name . Maxime Devos)(address . maximedevos@telenet.be)

Message-ID:87k0ju80kk.fsf_-_@gnu.org

Hi,

Maxime Devos <maximedevos@telenet.be> skribis:

Toggle quote (45 lines)> Sarah Morgensen schreef op ma 16-08-2021 om 12:56 [-0700]:
>> Hi Maxime,
>> 
>> Thanks for taking a look at this. :)
>> 
>> Maxime Devos <maximedevos@telenet.be> writes:
>> 
>> > Sarah Morgensen schreef op zo 15-08-2021 om 16:25 [-0700]:
>> > > * 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.
>> > 
>> > Does it support packages defined like (a)
>> > 
>> > (define-public gnash
>> >   (let ((commit "583ccbc1275c7701dc4843ec12142ff86bb305b4")
>> >         (revision "0"))
>> >     (package
>> >       (name "gnash")
>> >       (version (git-version "0.8.11" revision commit))
>> >       (source (git-reference
>> >                 (url "https://example.org")
>> >                 (commit commit)))
>> >       [...])))
>> 
>> No, it doesn't.  Since the commit definition isn't part of the actual
>> package definition, the current code has no way of updating it.  It
>> would require a rewrite of the edit-in-place logic with probably a lot
>> of special-casing.
>
> Perhaps a 'surrounding-expression-location' procedure can be defined?
>
> (define (surrounding-expression-location inner-location)
>   "Determine the location of the S-expression that surrounds the S-expression
> at INNER-LOCATION, or #false if the inner S-expression is at the top-level."
>   ??? Something like 'read', but in reverse, maybe?
>   Doesn't need to support every construct, just "string without escapes" and
>   (parentheses other-things) might be good enough in practice for now)
>
> Seems tricky to implement, but it would be more robust than relying
> on conventions like ‘the surrounding 'let' can be found by moving two columns
> and two lines backwards’.  Or see another method (let&) below that is actually
> implemented ...

I think we can work incrementally.  It wouldn’t be unreasonable to start
with a ‘definition-location’ procedure that would work in a way similar
to ‘package-field-location’ (essentially ‘read’ each top-level sexp of
the file and record the location of the one that immediately precedes
the package location.)

But maybe the discussion in https://issues.guix.gnu.org/50286 will
give us something nice.

Thanks,
Ludo’.

Ludovic Courtès wrote on 6 Sep 2021 12:27

Recipients:(name . Sarah Morgensen)(address . iskarian@mgsn.dev)(address . 50072@debbugs.gnu.org)

Message-ID:87fsui80dd.fsf_-_@gnu.org

Hi Sarah,

I like this patch series. :-)

Sarah Morgensen <iskarian@mgsn.dev> skribis:

Toggle quote (5 lines)

> * 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.

This LGTM.

Nitpick:

Toggle quote (7 lines)

> +(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 <git-reference>

[...]

Toggle quote (4 lines)

> + ;; Only use the first element of URLS.

> + (match-record source <upstream-source>

> + (version urls)

I’d use the record acceesors in this cases rather than ‘match-record’;
currently ‘match-record’ is not super efficient and I find it slightly
less readable when you’re just accessing a couple of fields.

Thanks,
Ludo’.

Maxime Devos wrote on 6 Sep 2021 13:47

Recipients:(name . Ludovic Courtès)(address . ludo@gnu.org)

Message-ID:10996c63a8690ceea6c88a5fc88ddabad7b000dd.camel@telenet.be

Hi,

Ludovic Courtès schreef op ma 06-09-2021 om 12:23 [+0200]:

Toggle quote (40 lines)> > > > 
> > > > [...]
> > > > Does it support packages defined like (a)
> > > > 
> > > > (define-public gnash
> > > >   (let ((commit "583ccbc1275c7701dc4843ec12142ff86bb305b4")
> > > >         (revision "0"))
> > > >     (package
> > > >       (name "gnash")
> > > >       (version (git-version "0.8.11" revision commit))
> > > >       (source (git-reference
> > > >                 (url "https://example.org")
> > > >                 (commit commit)))
> > > >       [...])))
> > > 
> > > No, it doesn't.  Since the commit definition isn't part of the actual
> > > package definition, the current code has no way of updating it.  It
> > > would require a rewrite of the edit-in-place logic with probably a lot
> > > of special-casing.
> > 
> > Perhaps a 'surrounding-expression-location' procedure can be defined?
> > 
> > (define (surrounding-expression-location inner-location)
> >   "Determine the location of the S-expression that surrounds the S-expression
> > at INNER-LOCATION, or #false if the inner S-expression is at the top-level."
> >   ??? Something like 'read', but in reverse, maybe?
> >   Doesn't need to support every construct, just "string without escapes" and
> >   (parentheses other-things) might be good enough in practice for now)
> > 
> > Seems tricky to implement, but it would be more robust than relying
> > on conventions like ‘the surrounding 'let' can be found by moving two columns
> > and two lines backwards’.  Or see another method (let&) below that is actually
> > implemented ...
> 
> I think we can work incrementally.  It wouldn’t be unreasonable to start
> with a ‘definition-location’ procedure that would work in a way similar
> to ‘package-field-location’ (essentially ‘read’ each top-level sexp of
> the file and record the location of the one that immediately precedes
> the package location.)

‘package-field-location’ (currently) doesn't work like that. Currently,

it extracts the location from the package, opens the file, uses a procedure

'goto' that works like 'seek' except that it accepts line and column numbers

instead of byte offsets.

What you proposed could work, though it seems a bit inefficient to me.

Asking upstream for an update probably takes a lot more time though.

Toggle quote (3 lines)

> But maybe the discussion in https://issues.guix.gnu.org/50286 will

> give us something nice.

Greetings,

Maxime

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYTX/1xccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7ophAQC7GSfWH0C/M+dLr8Jkdg0mny/r

yoG85v0kcMpD6jIk/AD+MgzJwEj1oLYkRndZc9Ql4ILaODgpj0tHD0orEEKA/gk=

=koNy

-----END PGP SIGNATURE-----

Sarah Morgensen wrote on 7 Sep 2021 03:16

Re: [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins.

Recipients:(name . Maxime Devos)(address . maximedevos@telenet.be)(address . 50072@debbugs.gnu.org)

Message-ID:86mtopi3s7.fsf@mgsn.dev

Hi Maxime,

Maxime Devos <maximedevos@telenet.be> writes:

Toggle quote (19 lines)> Sarah Morgensen schreef op zo 15-08-2021 om 16:25 [-0700]:
>> * 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.
>
> Does it support packages defined like (a)
>
> (define-public gnash
>   (let ((commit "583ccbc1275c7701dc4843ec12142ff86bb305b4")
>         (revision "0"))
>     (package
>       (name "gnash")
>       (version (git-version "0.8.11" revision commit))
>       (source (git-reference
>                 (url "https://example.org")
>                 (commit commit)))
>       [...])))

Thinking about this again, since updaters typically returns actual

versions (tags) instead of commits, how much would such a

feature be used?

OTOH, I could definitely see use for an ability to update packages like

these to proper versions (removing the surrounding 'let') but that's

probably more rare and may not be worth the implementation effort.

SEarah

Sarah Morgensen wrote on 7 Sep 2021 03:59

Re: [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.

Recipients:(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 50072@debbugs.gnu.org)

Message-ID:86k0jti1r4.fsf@mgsn.dev

Hi Ludo,

Ludovic Courtès <ludo@gnu.org> writes:

Toggle quote (4 lines)

> Hi Sarah,

> I like this patch series. :-)

Thanks for taking a look!

Toggle quote (10 lines)>
> Sarah Morgensen <iskarian@mgsn.dev> skribis:
>
>> * 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.
>
> This LGTM.

Thanks. WDYT about pre-emptively adding support for non-url URIs as

well? That is,

1. change "urls" in <upstream-source> to "uri"

2. in 'git-fetch'

a) if the upstream-source-uri is a git-reference, just use it as-is

rather than guessing the tag

b) if it's not, return an 'upstream-source' with a git-reference URI

3. update 'upstream-source-compiler' to work for git-reference URIs.

If there are no objections, I think I'll make those changes and send

that as a proper patch.

Toggle quote (20 lines)>
> Nitpick:
>
>> +(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 <git-reference>
>
> [...]
>
>> +  ;; Only use the first element of URLS.
>> +  (match-record source <upstream-source>
>> +    (version urls)
>
> I’d use the record acceesors in this cases rather than ‘match-record’;
> currently ‘match-record’ is not super efficient and I find it slightly
> less readable when you’re just accessing a couple of fields.

Fair. I got a little excited to discover new syntax :)

Sarah

Maxime Devos wrote on 7 Sep 2021 12:00

Re: [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins.

Recipients:(name . Sarah Morgensen)(address . iskarian@mgsn.dev)(address . 50072@debbugs.gnu.org)

Message-ID:470a95f159120d14384c3096cff91e3ce8d3c6c8.camel@telenet.be

Sarah Morgensen schreef op ma 06-09-2021 om 18:16 [-0700]:

Toggle quote (27 lines)> Hi Maxime,
> 
> Maxime Devos <maximedevos@telenet.be> writes:
> 
> > Sarah Morgensen schreef op zo 15-08-2021 om 16:25 [-0700]:
> > > * 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.
> > 
> > Does it support packages defined like (a)
> > 
> > (define-public gnash
> >   (let ((commit "583ccbc1275c7701dc4843ec12142ff86bb305b4")
> >         (revision "0"))
> >     (package
> >       (name "gnash")
> >       (version (git-version "0.8.11" revision commit))
> >       (source (git-reference
> >                 (url "https://example.org")
> >                 (commit commit)))
> >       [...])))
> 
> Thinking about this again, since updaters typically returns actual
> versions (tags) instead of commits, how much would such a
> feature be used?

The minetest updater returns version numbers.

It also returns a git-reference object, which includes the commit.

Just returning a version number often isn't sufficient,

because many repositories of minetest mods do not keep version tags.

See https://issues.guix.gnu.org/50072#5.

Greetings,

Maxime.

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYTc4ShccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7oCxAP9Ij02MwmdqzRHO0untiA8XMwvQ

5mIZFI/F4rGBs+bFVAEA/HGbTDWV65zhq7GRhx3iSkL8dQ7TNZLaOhn1KKNnpAc=

=OfIQ

-----END PGP SIGNATURE-----

Sarah Morgensen wrote on 7 Sep 2021 19:51

Recipients:(name . Maxime Devos)(address . maximedevos@telenet.be)(address . 50072@debbugs.gnu.org)

Message-ID:86a6koi8ac.fsf@mgsn.dev

Hi,

Maxime Devos <maximedevos@telenet.be> writes:

Toggle quote (33 lines)> Sarah Morgensen schreef op ma 06-09-2021 om 18:16 [-0700]:
>> Hi Maxime,
>> 
>> Maxime Devos <maximedevos@telenet.be> writes:
>> 
>> > Sarah Morgensen schreef op zo 15-08-2021 om 16:25 [-0700]:
>> > > * 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.
>> > 
>> > Does it support packages defined like (a)
>> > 
>> > (define-public gnash
>> >   (let ((commit "583ccbc1275c7701dc4843ec12142ff86bb305b4")
>> >         (revision "0"))
>> >     (package
>> >       (name "gnash")
>> >       (version (git-version "0.8.11" revision commit))
>> >       (source (git-reference
>> >                 (url "https://example.org")
>> >                 (commit commit)))
>> >       [...])))
>> 
>> Thinking about this again, since updaters typically returns actual
>> versions (tags) instead of commits, how much would such a
>> feature be used?
>
> The minetest updater returns version numbers.
> It also returns a git-reference object, which includes the commit.
> Just returning a version number often isn't sufficient,
> because many repositories of minetest mods do not keep version tags.

Thanks for the explanation.

So there is a version number indicated elsewhere than in the tags for

some minetest packages? (Is this data in the package's git repo or in

e.g. minetest repo metadata?) That is, the minetest updater always uses

"blessed versions" (not just random commits), such that "revision" will

always be "0"?

Are current minetest packages like this formatted like 'gnash' above?

Toggle quote (2 lines)

> See https://issues.guix.gnu.org/50072#5.

That's the message I quoted ;)

Sarah

Maxime Devos wrote on 7 Sep 2021 22:58

Recipients:(name . Sarah Morgensen)(address . iskarian@mgsn.dev)(address . 50072@debbugs.gnu.org)

Message-ID:7905b183a5865bb597b10f8440074efa463ab544.camel@telenet.be

Sarah Morgensen schreef op di 07-09-2021 om 10:51 [-0700]:

Toggle quote (6 lines)

> So there is a version number indicated elsewhere than in the tags for

> some minetest packages? (Is this data in the package's git repo or in

> e.g. minetest repo metadata?) That is, the minetest updater always uses

> "blessed versions" (not just random commits), such that "revision" will

> always be "0"?

The minetest importer looks at ContentDB. E.g., for Jeija/mesecons:

https://content.minetest.net/packages/Jeija/mesecons/. It doesn't look

at git tags at all. It only clones the git repository to compute the hash.

Strictly speaking, ContentDB only has ‘release titles’, and not ‘version numbers’.

Release titles are usually version numbers or dates. In the former case, all is

well. In the latter case, there isn't much the importer/updater can do about that,

so it will use the date even though it isn't a ‘proper version number’.

Releases on ContentDB are ordered. The importer and refresher always use the

latest release, not some random commit. ContentDB has a mapping from releases

to their commits, which the importer and refresher uses.

So, yes, there are ‘blessed versions’. However, due to particularities of how

minetest mods are released, revision won't always be 0, because there are

minetest mods that make a new release on ContentDB without a corresponding

version bump (e.g. minetest-ethereal, minetest-mesecons, minetest-throwing,

minetest-throwing-arrows).

Toggle quote (2 lines)

> Are current minetest packages like this formatted like 'gnash' above?

About a third are formatted like 'gnash' (let ((commit ...) (revision ...)) ...)).

Greetings,

Maxime

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYTfSYBccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7lPAAQCDu0xEAeybas2f1Y3lnGkGYxJK

9NbcMQWMRRWX6bmLvgD/Wkkcowr0BIACPDCucoDP4n2KqS/W+PHletLtFJ+xNQ8=

=mgxY

-----END PGP SIGNATURE-----

Ludovic Courtès wrote on 29 Sep 2021 23:28

Re: bug#50072: [PATCH WIP 0/4] Add upstream updater for git-fetch origins.

Recipients:(name . Sarah Morgensen)(address . iskarian@mgsn.dev)(address . 50072@debbugs.gnu.org)

Message-ID:87a6jv6pgm.fsf_-_@gnu.org

Hi Sarah,

I just noticed I hadn’t answered this message…

Sarah Morgensen <iskarian@mgsn.dev> skribis:

Toggle quote (2 lines)

> Ludovic Courtès <ludo@gnu.org> writes:

[...]

Toggle quote (26 lines)>> Sarah Morgensen <iskarian@mgsn.dev> skribis:
>>
>>> * 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.
>>
>> This LGTM.
>
> Thanks.  WDYT about pre-emptively adding support for non-url URIs as
> well?  That is,
>
> 1. change "urls" in <upstream-source> to "uri"
>
> 2. in 'git-fetch'
>
>   a) if the upstream-source-uri is a git-reference, just use it as-is
>      rather than guessing the tag
>
>   b) if it's not, return an 'upstream-source' with a git-reference URI 
>
> 3. update 'upstream-source-compiler' to work for git-reference URIs.
>
> If there are no objections, I think I'll make those changes and send
> that as a proper patch.

That sounds like a good idea. We’ll need to check users of

‘upstream-source-urls’ & co. and see whether/how they can deal with

generalized “URIs”.

That said, perhaps it can come after this patch series, which I think

was mostly waiting on ‘package-definition-location’ initially?

Thanks,

Ludo’.

Ludovic Courtès wrote on 17 Nov 2021 16:03

Recipients:(name . Sarah Morgensen)(address . iskarian@mgsn.dev)(address . 50072@debbugs.gnu.org)

Message-ID:878rxmx1sp.fsf_-_@gnu.org

Hi Sarah,

Friendly reminder about this patch set:

https://issues.guix.gnu.org/50072

To me, it’s pretty much ready now that we can use

‘package-definition-location’ so that ‘guix refresh -u’ edits the right

bits.

If you’re not able to work on it these days, I can tweak it for

‘package-definition-location’ use and push it on your behalf.

Let me know!

Thanks,

Ludo’.

Ludovic Courtès <ludo@gnu.org> skribis:

Toggle quote (45 lines)> Hi Sarah,
>
> I just noticed I hadn’t answered this message…
>
> Sarah Morgensen <iskarian@mgsn.dev> skribis:
>
>> Ludovic Courtès <ludo@gnu.org> writes:
>
> [...]
>
>>> Sarah Morgensen <iskarian@mgsn.dev> skribis:
>>>
>>>> * 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.
>>>
>>> This LGTM.
>>
>> Thanks.  WDYT about pre-emptively adding support for non-url URIs as
>> well?  That is,
>>
>> 1. change "urls" in <upstream-source> to "uri"
>>
>> 2. in 'git-fetch'
>>
>>   a) if the upstream-source-uri is a git-reference, just use it as-is
>>      rather than guessing the tag
>>
>>   b) if it's not, return an 'upstream-source' with a git-reference URI 
>>
>> 3. update 'upstream-source-compiler' to work for git-reference URIs.
>>
>> If there are no objections, I think I'll make those changes and send
>> that as a proper patch.
>
> That sounds like a good idea.  We’ll need to check users of
> ‘upstream-source-urls’ & co. and see whether/how they can deal with
> generalized “URIs”.
>
> That said, perhaps it can come after this patch series, which I think
> was mostly waiting on ‘package-definition-location’ initially?
>
> Thanks,
> Ludo’.

Maxime Devos wrote on 1 Jan 2022 18:35

Re: [PATCH WIP 0/4] Add upstream updater for git-fetch origins.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:33e7ca24fb1704d03007c4e6eff76a25d6b5e5fe.camel@telenet.be

Hi,

I'm currently unifying the patches of Sarah and me, changing the

minetest and generic-git updater so "guix refresh -u" works. I'll

send them when they are tested.

Greetings,

Maxime.

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYdCQ1RccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7hhbAP9YZwOFBJ88oa0H/DhtpdPtkzRg

0gjGttlvuG99RMRBAgEAmDWJjphAU9/qLP9WKgkh3bKqbesZDQPJHT7x6jOSFgM=

=CG4Z

-----END PGP SIGNATURE-----

Maxime Devos wrote on 1 Jan 2022 21:39

[PATCH v2 3/4] refresh: Support non-tarball sources.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:20220101203940.149517-4-maximedevos@telenet.be

* 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(-)

Toggle diff (57 lines)diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 8806f0f740..68bb9040d8 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; 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...~%")
@@ -363,8 +364,7 @@ warn about packages that have no matching updater."
                       (info loc (G_ "~a: consider removing this propagated input: ~a~%")
                             name change-name))))
                  (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~%")
-- 
2.30.2

Maxime Devos wrote on 1 Jan 2022 21:39

[PATCH v2 0/4] Add upstream updater for git-fetch origins

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:20220101203940.149517-1-maximedevos@telenet.be

Hi,

This is a combination of Sarah's patches and the patch I wrote.

Some differences:

'guix/hash.scm' is added to Makefile.am.

I modified the 'generic-git' and 'minetest' updater to return

'git-reference' objects.

There's no guess-version-transform procedure. Due to letting updaters

return git-reference objects, guessing isn't necessary.

This also allows using commits.

In contrast to my original version, it not only supports commits,

but also tags (using 'tag-or-commit'), like in Sarah's version.

I didn't use checkout-to-store, because it is used in only a single

location and is only a basic wrapper around latest-repository-commit.

I didn't look at testing if (let ((commit ...) (revision ...)) (package ...))

works. If it doesn't, that could be implemented in a separate patch.

'--with-latest' with a git source fails with a nice error message.

Some tests:

$ make check # no failures

$ ./pre-inst-env guix refresh minetest-mobs-animal -u --type=generic-git

The result seems largely reasonable: the version changed, and the commit

changed to a new tag.

However, the URL changed from mixed case to lowercase. Maybe a todo for later:

use the original URL if it only changed in case.

Also, the version switched from YYYY-MM-DD to YYYY.MM.DD. Maybe change the

minetest importer to use the latter, to keep minetest and generic-git

consistent? TODO for later!

A bug: the sha256 hash isn't updated. I don't know why.

I investigated a little, and it turns out that 'latest-repository-commit' is called

with the new tag, but the store item corresponds the old commit. Weird!

$ # undo the update

$ ./pre-inst-env guix refresh minetest-mobs-animal -u --type=minetest

No problems at all (except the mixed case -> lowercase). The commit and sha256/base32

are updated!

$ ./pre-inst-env guix build minetest-mobs-animal

This builds successfully.

$ # undo changes

$ ./pre-inst-env guix build minetest-mobs-animal --with-latest=minetest-mobs-animal

It fails gracefully with:

guix build: error: git origins are unsupported by --with-latest

Also, do tarball origins still function? They do:

$ # move GNU "hello" to an earlier version, then do

$ ./pre-inst-env guix build hello --with-latest=hello

This build hello@2.10 -- the output path is the same as before moving 'hello'

to an earlier version.

$ ./pre-inst-env guix refresh -u hello

The version is updated to @2.10, but sha256 isn't changed?

Seems like a bug, but it doesn't appear to be a regression.

Sarah Morgensen (4):

guix hash: Extract file hashing procedures.

import: Factorize file hashing.

refresh: Support non-tarball sources.

upstream: Support updating 'git-fetch' origins.

Makefile.am | 1 +

guix/hash.scm | 51 ++++++++++++++++++++++++++++++++++

guix/import/cran.scm | 32 ++-------------------

guix/import/elpa.scm | 29 +++----------------

guix/import/git.scm | 22 +++++++++------

guix/import/go.scm | 25 ++---------------

guix/import/minetest.scm | 24 +++++++---------

guix/scripts/hash.scm | 18 ++----------

guix/scripts/refresh.scm | 10 +++----

guix/upstream.scm | 60 ++++++++++++++++++++++++++++++++++++----

tests/minetest.scm | 7 ++---

11 files changed, 151 insertions(+), 128 deletions(-)

create mode 100644 guix/hash.scm

base-commit: 9708681f1a9f221ae6cad64625ba8309b6742653

2.30.2

Maxime Devos wrote on 1 Jan 2022 21:39

[PATCH v2 2/4] import: Factorize file hashing.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:20220101203940.149517-3-maximedevos@telenet.be

From: Sarah Morgensen <iskarian@mgsn.dev>

* 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/minetest.scm (file-hash): Remove procedure.
(make-minetest-sexp): Use 'file-hash*' instead.
---
 guix/import/cran.scm     | 32 +++-----------------------------
 guix/import/elpa.scm     | 29 ++++-------------------------
 guix/import/go.scm       | 25 +++----------------------
 guix/import/minetest.scm | 18 +++++++-----------
 4 files changed, 17 insertions(+), 87 deletions(-)

Toggle diff (255 lines)diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 1389576cad..69f4533da7 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -35,10 +36,9 @@
   #:use-module (guix memoization)
   #:use-module (guix http-client)
   #:use-module (guix diagnostics)
+  #:use-module (guix hash)
   #:use-module (guix i18n)
-  #:use-module (gcrypt 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)
@@ -196,17 +196,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
@@ -464,16 +453,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."
@@ -571,12 +550,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 edabb88b7a..c1f40ed915 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,10 +38,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)
@@ -229,27 +230,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."
@@ -270,8 +250,7 @@ RECIPE."
              (commit ,commit)))
        (sha256
         (base32
-         ,(bytevector->nix-base32-string
-           (file-hash directory (negate vcs-file?) #t)))))))
+         ,(bytevector->nix-base32-string (file-hash* directory)))))))
 
 (define* (melpa-recipe->origin recipe)
   "Fetch origin details from the MELPA recipe and associated repository for
@@ -380,7 +359,7 @@ type '<elpa-package>'."
                         (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 26dbc34b63..ea999d290c 100644
--- a/guix/import/go.scm
+++ b/guix/import/go.scm
@@ -26,6 +26,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)
@@ -36,11 +37,10 @@
   #: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   (guix base32) (bytevector->nix-base32-string)
   #:autoload   (guix build utils) (mkdir-p)
+  #:autoload   (gcrypt hash) (hash-algorithm sha256)
   #:use-module (ice-9 match)
   #:use-module (ice-9 peg)
   #:use-module (ice-9 rdelim)
@@ -499,25 +499,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."
@@ -536,7 +517,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
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index abddd885ee..44671d8480 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,6 +39,7 @@
   #:use-module (guix base32)
   #:use-module (guix git)
   #:use-module ((guix git-download) #:prefix download:)
+  #:use-module (guix hash)
   #:use-module (guix store)
   #:export (%default-sort-key
             %contentdb-api
@@ -286,14 +287,6 @@ results.  The return value is a list of <package-keys> records."
   (with-store store
     (latest-repository-commit store url #:ref ref)))
 
-;; XXX adapted from (guix scripts hash)
-(define (file-hash file)
-  "Compute the hash of FILE."
-  (let-values (((port get-hash) (open-sha256-port)))
-    (write-file file port)
-    (force-output port)
-    (get-hash)))
-
 (define (make-minetest-sexp author/name version repository commit
                             inputs home-page synopsis
                             description media-license license)
@@ -314,9 +307,12 @@ MEDIA-LICENSE and LICENSE."
            ;; The git commit is not always available.
            ,(and commit
                  (bytevector->nix-base32-string
-                  (file-hash
+                  (file-hash*
                    (download-git-repository repository
-                                            `(commit . ,commit)))))))
+                                            `(commit . ,commit))
+                   ;; 'download-git-repository' already filtered out the '.git'
+                   ;; directory.
+                   #:select? (const #true))))))
          (file-name (git-file-name name version))))
      (build-system minetest-mod-build-system)
      ,@(maybe-propagated-inputs (map contentdb->package-name inputs))
-- 
2.30.2

Maxime Devos wrote on 1 Jan 2022 21:39

[PATCH v2 1/4] guix hash: Extract file hashing procedures.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:20220101203940.149517-2-maximedevos@telenet.be

From: Sarah Morgensen <iskarian@mgsn.dev>

* guix/scripts/hash.scm (guix-hash)[vcs-file?, file-hash]: Extract logic
to...
* guix/hash.scm: ...here. New file.
---
 Makefile.am           |  1 +
 guix/hash.scm         | 51 +++++++++++++++++++++++++++++++++++++++++++
 guix/scripts/hash.scm | 18 +++------------
 3 files changed, 55 insertions(+), 15 deletions(-)
 create mode 100644 guix/hash.scm

Toggle diff (121 lines)diff --git a/Makefile.am b/Makefile.am
index 8c5682a1c6..bc3d0087d0 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -99,6 +99,7 @@ MODULES =					\
   guix/extracting-download.scm			\
   guix/git-download.scm				\
   guix/hg-download.scm				\
+  guix/hash.scm					\
   guix/swh.scm					\
   guix/monads.scm				\
   guix/monad-repl.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 <iskarian@mgsn.dev>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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 d73e3d13dd..168450d668 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +25,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)
@@ -46,11 +48,7 @@
 (define* (nar-hash file #:optional
                    (algorithm (assoc-ref %default-options 'hash-algorithm))
                    select?)
-  (let-values (((port get-hash)
-                (open-hash-port algorithm)))
-    (write-file file port #:select? select?)
-    (force-output port)
-    (get-hash)))
+  (file-hash* file #:algorithm algorithm #:select? select?))
 
 (define* (default-hash file #:optional
                        (algorithm (assoc-ref %default-options 'hash-algorithm))
@@ -181,16 +179,6 @@ use '--serializer' instead~%"))
     (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)
-- 
2.30.2

Maxime Devos wrote on 1 Jan 2022 21:39

[PATCH v2 4/4] upstream: Support updating 'git-fetch' origins.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:20220101203940.149517-5-maximedevos@telenet.be

From: Sarah Morgensen <iskarian@mgsn.dev>

Updaters need to be modified to return 'git-reference' objects.
This patch modifies the 'generic-git' and 'minetest' updater,
but others might need to be modified as well.

* guix/upstream.scm (package-update/git-fetch): New procedure.
  (<upstream-source>)[urls]: Document it can be a 'git-reference'.
  (%method-updates): Add 'git-fetch' mapping.
  (update-package-source): Support 'git-reference' sources.
  (upstream-source-compiler): Bail out gracefully if the source is a git
  origin.
* guix/import/git.scm
  (latest-git-tag-version): Always return two values and document that the tag
  is returned as well.
  (latest-git-release)[urls]: Use the 'git-reference' instead of the
  repository URL.
* guix/import/minetest.scm (latest-minetest-release)[urls]: Don't wrap the
  'git-reference' in a list.
* tests/minetest.scm (upstream-source->sexp): Adjust to new convention.

Co-authored-by: Maxime Devos <maximedevos@telenet.be>
---
 guix/import/git.scm      | 22 +++++++++------
 guix/import/minetest.scm |  6 ++--
 guix/upstream.scm        | 60 ++++++++++++++++++++++++++++++++++++----
 tests/minetest.scm       |  7 ++---
 4 files changed, 74 insertions(+), 21 deletions(-)

Toggle diff (228 lines)diff --git a/guix/import/git.scm b/guix/import/git.scm
index 1eb219f3fe..4cf404677c 100644
--- a/guix/import/git.scm
+++ b/guix/import/git.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -34,6 +35,7 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
   #:export (%generic-git-updater
 
             ;; For tests.
@@ -172,21 +174,21 @@ repository at URL."
          (values version tag)))))))
 
 (define (latest-git-tag-version package)
-  "Given a PACKAGE, return the latest version of it, or #f if the latest version
-could not be determined."
+  "Given a PACKAGE, return the latest version of it and the corresponding git
+tag, or #false and #false if the latest version could not be determined."
   (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
              (warning (or (package-field-location package 'source)
                           (package-location package))
                       (G_ "~a for ~a~%")
                       (condition-message c)
                       (package-name package))
-             #f)
+             (values #f #f))
             ((eq? (exception-kind c) 'git-error)
              (warning (or (package-field-location package 'source)
                           (package-location package))
                       (G_ "failed to fetch Git repository for ~a~%")
                       (package-name package))
-             #f))
+             (values #f #f)))
     (let* ((source (package-source package))
            (url (git-reference-url (origin-uri source)))
            (property (cute assq-ref (package-properties package) <>)))
@@ -208,14 +210,16 @@ could not be determined."
   "Return an <upstream-source> for the latest release of PACKAGE."
   (let* ((name (package-name package))
          (old-version (package-version package))
-         (url (git-reference-url (origin-uri (package-source package))))
-         (new-version (latest-git-tag-version package)))
-
-    (and new-version
+         (old-reference (origin-uri (package-source package)))
+         (new-version new-version-tag (latest-git-tag-version package)))
+    (and new-version new-version-tag
          (upstream-source
           (package name)
           (version new-version)
-          (urls (list url))))))
+          (urls (git-reference
+                 (url (git-reference-url old-reference))
+                 (commit new-version-tag)
+                 (recursive? (git-reference-recursive? old-reference))))))))
 
 (define %generic-git-updater
   (upstream-updater
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index 44671d8480..9df13e45ae 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -503,9 +503,9 @@ or #false if the latest release couldn't be determined."
        (upstream-source
         (package (package:package-name pkg))
         (version (release-version release))
-        (urls (list (download:git-reference
-                     (url (package-repository contentdb-package))
-                     (commit (release-commit release))))))))
+        (urls (download:git-reference
+               (url (package-repository contentdb-package))
+               (commit (release-commit release)))))))
 
 (define %minetest-updater
   (upstream-updater
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 632e9ebc4f..0df2e78d30 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -2,6 +2,8 @@
 ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,12 +26,14 @@
   #: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)
   #:use-module (guix ui)
   #:use-module (guix base32)
   #:use-module (guix gexp)
+  #:use-module (guix git)
   #:use-module (guix store)
   #:use-module ((guix derivations) #:select (built-derivations derivation->output-path))
   #:autoload   (gcrypt hash) (port-sha256)
@@ -93,7 +97,7 @@
   upstream-source?
   (package        upstream-source-package)        ;string
   (version        upstream-source-version)        ;string
-  (urls           upstream-source-urls)           ;list of strings
+  (urls           upstream-source-urls)           ;list of strings|git-reference
   (signature-urls upstream-source-signature-urls  ;#f | list of strings
                   (default #f))
   (input-changes  upstream-source-input-changes
@@ -361,8 +365,12 @@ values: 'interactive' (default), 'always', and 'never'."
                                                 system target)
   "Download SOURCE from its first URL and lower it as a fixed-output
 derivation that would fetch it."
-  (mlet* %store-monad ((url -> (first (upstream-source-urls source)))
-                       (signature
+  (define url
+    (match (upstream-source-urls source)
+      ((first . _) first)
+      (_ (raise (formatted-message
+                 (G_ "git origins are unsupported by --with-latest"))))))
+  (mlet* %store-monad ((signature
                         -> (and=> (upstream-source-signature-urls source)
                                   first))
                        (tarball ((store-lift download-tarball) url signature)))
@@ -430,9 +438,35 @@ SOURCE, an <upstream-source>."
                                         #: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 <upstream-source>."
+  ;; TODO: it would be nice to authenticate commits, e.g. with
+  ;; "guix git authenticate" or a list of permitted signing keys.
+  (define ref (upstream-source-urls source)) ; a <git-reference>
+  (values (upstream-source-version source)
+          (latest-repository-commit
+           store
+           (git-reference-url ref)
+           #:ref `(tag-or-commit . ,(git-reference-commit ref))
+           #:recursive? (git-reference-recursive? ref))
+          source))
+
 (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))
@@ -492,9 +526,22 @@ new version string if an update was made, and #f otherwise."
                              (origin-hash (package-source package))))
                (old-url     (match (origin-uri (package-source package))
                               ((? string? url) url)
+                              ((? git-reference? ref)
+                               (git-reference-url ref))
                               (_ #f)))
                (new-url     (match (upstream-source-urls source)
-                              ((first _ ...) first)))
+                              ((first _ ...) first)
+                              ((? git-reference? ref)
+                               (git-reference-url ref))
+                              (_ #f)))
+               (old-commit  (match (origin-uri (package-source package))
+                              ((? git-reference? ref)
+                               (git-reference-commit ref))
+                              (_ #f)))
+               (new-commit  (match (upstream-source-urls source)
+                              ((? git-reference? ref)
+                               (git-reference-commit ref))
+                              (_ #f)))
                (file        (and=> (location-file loc)
                                    (cut search-path %load-path <>))))
           (if file
@@ -508,6 +555,9 @@ new version string if an update was made, and #f otherwise."
                                            'filename file))
                     (replacements `((,old-version . ,version)
                                     (,old-hash . ,hash)
+                                    ,@(if (and old-commit new-commit)
+                                          `((,old-commit . ,new-commit))
+                                          '())
                                     ,@(if (and old-url new-url)
                                           `((,(dirname old-url) .
                                              ,(dirname new-url)))
diff --git a/tests/minetest.scm b/tests/minetest.scm
index 77b9aa928f..cbb9e83889 100644
--- a/tests/minetest.scm
+++ b/tests/minetest.scm
@@ -387,10 +387,9 @@ during a dynamic extent where that package is available on ContentDB."
 
 ;; Update detection
 (define (upstream-source->sexp upstream-source)
-  (define urls (upstream-source-urls upstream-source))
-  (unless (= 1 (length urls))
-    (error "only a single URL is expected"))
-  (define url (first urls))
+  (define url (upstream-source-urls upstream-source))
+  (unless (git-reference? url)
+    (error "a <git-reference> is expected"))
   `(,(upstream-source-package upstream-source)
     ,(upstream-source-version upstream-source)
     ,(git-reference-url url)
-- 
2.30.2

Ludovic Courtès wrote on 3 Jan 2022 14:55

Re: [PATCH v2 3/4] refresh: Support non-tarball sources.

Recipients:(name . Maxime Devos)(address . maximedevos@telenet.be)

Message-ID:87o84sly9k.fsf@gnu.org

Hi Maxime,

Thanks for the updated patch set! Overall it LGTM. I found this one

bug:

Maxime Devos <maximedevos@telenet.be> skribis:

Toggle quote (5 lines)

> From: Sarah Morgensen <iskarian@mgsn.dev>

> * guix/scripts/refresh.scm (update-package): Use 'file-hash*' instead of

> 'port-sha256'. Rename TARBALL to OUTPUT.

[...]

Toggle quote (4 lines)

> - (let ((hash (call-with-input-file tarball

> - port-sha256)))

> + (let ((hash (file-hash* output)))

This is incorrect because ‘file-hash*’ defaults to #:recursive? #t (IOW

it computes the hash of a nar containing OUTPUT instead of the hash of

OUTPUT). You can see the problem for instance by running:

./pre-inst-env guix refresh -u mailutils && \

./pre-inst-env guix build -S mailutils

# hash mismatch error

I think we need to check whether OUTPUT is a file or a directory and

pass #:recursive? accordingly.

WDYT?

Thanks,

Ludo’.

Ludovic Courtès wrote on 3 Jan 2022 15:02

Re: [PATCH v2 4/4] upstream: Support updating 'git-fetch' origins.

Recipients:(name . Maxime Devos)(address . maximedevos@telenet.be)

Message-ID:87h7aklxxj.fsf@gnu.org

Maxime Devos <maximedevos@telenet.be> skribis:

Toggle quote (23 lines)> From: Sarah Morgensen <iskarian@mgsn.dev>
>
> Updaters need to be modified to return 'git-reference' objects.
> This patch modifies the 'generic-git' and 'minetest' updater,
> but others might need to be modified as well.
>
> * guix/upstream.scm (package-update/git-fetch): New procedure.
>   (<upstream-source>)[urls]: Document it can be a 'git-reference'.
>   (%method-updates): Add 'git-fetch' mapping.
>   (update-package-source): Support 'git-reference' sources.
>   (upstream-source-compiler): Bail out gracefully if the source is a git
>   origin.
> * guix/import/git.scm
>   (latest-git-tag-version): Always return two values and document that the tag
>   is returned as well.
>   (latest-git-release)[urls]: Use the 'git-reference' instead of the
>   repository URL.
> * guix/import/minetest.scm (latest-minetest-release)[urls]: Don't wrap the
>   'git-reference' in a list.
> * tests/minetest.scm (upstream-source->sexp): Adjust to new convention.
>
> Co-authored-by: Maxime Devos <maximedevos@telenet.be>

[...]

Toggle quote (11 lines)>                                                  system target)
>    "Download SOURCE from its first URL and lower it as a fixed-output
>  derivation that would fetch it."
> -  (mlet* %store-monad ((url -> (first (upstream-source-urls source)))
> -                       (signature
> +  (define url
> +    (match (upstream-source-urls source)
> +      ((first . _) first)
> +      (_ (raise (formatted-message
> +                 (G_ "git origins are unsupported by --with-latest"))))))

We should probably not refer to ‘--with-latest’ in

‘upstream-source-compiler’ to keep things separate.

Toggle quote (9 lines)

> +(define* (package-update/git-fetch store package source #:key key-download)

> + "Return the version, checkout, and SOURCE, to update PACKAGE to

> +SOURCE, an <upstream-source>."

> + ;; TODO: it would be nice to authenticate commits, e.g. with

> + ;; "guix git authenticate" or a list of permitted signing keys.

> + (define ref (upstream-source-urls source)) ; a <git-reference>

> + (values (upstream-source-version source)

> + (latest-repository-commit

It’s a bummer that <upstream-source> no longer models things correctly:

‘urls’ can be either a list of URLs or a <git-reference>, as can be seen

in the two examples above, and ‘signature-urls’ is meaningless for Git

origins.

We can probably leave it for a future patch series, but I think we

should do something about it.

In particular, as the comment notes, IWBN to make provisions to allow

for tag signature verification, which is probably the most widespread

practice.

Thanks,

Ludo’.

Maxime Devos wrote on 4 Jan 2022 16:09

[PATCH v3 1/4] guix hash: Extract file hashing procedures.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:20220104150937.35872-2-maximedevos@telenet.be

* guix/scripts/hash.scm (guix-hash)[vcs-file?] (nar-hash, default-hash):

Extract hashing logic to...

* guix/hash.scm (vcs-file?, file-hash*): ... these new procedures in this

new file.

Modified-by: Maxime Devos <maximedevos@telenet.be>

---

Makefile.am | 1 +

guix/hash.scm | 68 +++++++++++++++++++++++++++++++++++++++++++

guix/scripts/hash.scm | 22 +++-----------

3 files changed, 73 insertions(+), 18 deletions(-)

create mode 100644 guix/hash.scm

Toggle diff (148 lines)diff --git a/Makefile.am b/Makefile.am
index 8c5682a1c6..bc3d0087d0 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -99,6 +99,7 @@ MODULES =					\
   guix/extracting-download.scm			\
   guix/git-download.scm				\
   guix/hg-download.scm				\
+  guix/hash.scm					\
   guix/swh.scm					\
   guix/monads.scm				\
   guix/monad-repl.scm				\
diff --git a/guix/hash.scm b/guix/hash.scm
new file mode 100644
index 0000000000..19cbc41ad1
--- /dev/null
+++ b/guix/hash.scm
@@ -0,0 +1,68 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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? 'auto)
+                     (select? (negate vcs-file?)))
+  "Compute the hash of FILE with ALGORITHM.  If RECURSIVE? is #true or 'auto',
+recurse into subdirectories of FILE, computing the combined hash (nar hash) of
+all files for which (SELECT?  FILE STAT) returns true.
+
+Symbolic links are not dereferenced unless RECURSIVE? is false.
+
+This procedure must only be used under controlled circumstances;
+the detection of symbolic links in FILE is racy.
+
+Keep in mind that the hash of a regular file depends on RECURSIVE?:
+if the recursive hash is desired, it must be set to #true.  Otherwise, it must
+be set to #false or 'auto'. In most situations, the non-recursive hash is desired
+for regular files."
+  (if (or (eq? recursive? #true)
+          (and (eq? recursive? 'auto)
+               ;; Don't change this to (eq? 'directory ...), because otherwise
+               ;; if 'file' denotes a symbolic link, the 'file-hash' below
+               ;; would dereference it -- dereferencing symbolic links would
+               ;; open an avoidable can of potential worms.
+               (not (eq? 'regular (stat:type (lstat file))))))
+      (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 d73e3d13dd..28d587b944 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +25,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)
@@ -46,20 +48,14 @@
 (define* (nar-hash file #:optional
                    (algorithm (assoc-ref %default-options 'hash-algorithm))
                    select?)
-  (let-values (((port get-hash)
-                (open-hash-port algorithm)))
-    (write-file file port #:select? select?)
-    (force-output port)
-    (get-hash)))
+  (file-hash* file #:algorithm algorithm #:select? select? #:recursive? #true))
 
 (define* (default-hash file #:optional
                        (algorithm (assoc-ref %default-options 'hash-algorithm))
                        select?)
   (match file
     ("-" (port-hash algorithm (current-input-port)))
-    (_
-     (call-with-input-file file
-       (cute port-hash algorithm <>)))))
+    (_ (file-hash* file #:algorithm algorithm #:recursive? #false))))
 
 (define* (git-hash file #:optional
                        (algorithm (assoc-ref %default-options 'hash-algorithm))
@@ -181,16 +177,6 @@ use '--serializer' instead~%"))
     (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)
-- 
2.30.2

Maxime Devos wrote on 4 Jan 2022 16:09

[PATCH v3 2/4] import: Factorize file hashing.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:20220104150937.35872-3-maximedevos@telenet.be

From: Sarah Morgensen <iskarian@mgsn.dev>

* 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/minetest.scm (file-hash): Remove procedure.
  (make-minetest-sexp): Use 'file-hash*' instead.
---
 guix/import/cran.scm     | 32 +++-----------------------------
 guix/import/elpa.scm     | 29 +++++------------------------
 guix/import/go.scm       | 25 +++----------------------
 guix/import/minetest.scm | 19 ++++++++-----------
 4 files changed, 19 insertions(+), 86 deletions(-)

Toggle diff (256 lines)diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 1389576cad..b61402078d 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -35,10 +36,9 @@
   #:use-module (guix memoization)
   #:use-module (guix http-client)
   #:use-module (guix diagnostics)
+  #:use-module (guix hash)
   #:use-module (guix i18n)
-  #:use-module (gcrypt 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)
@@ -196,17 +196,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
@@ -464,16 +453,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."
@@ -571,12 +550,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 #:recursive? (or git? hg?)))))))
               ,@(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 edabb88b7a..c5167eacb5 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,10 +38,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)
@@ -229,27 +230,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."
@@ -271,7 +251,7 @@ RECIPE."
        (sha256
         (base32
          ,(bytevector->nix-base32-string
-           (file-hash directory (negate vcs-file?) #t)))))))
+           (file-hash* directory #:recursive? #true)))))))
 
 (define* (melpa-recipe->origin recipe)
   "Fetch origin details from the MELPA recipe and associated repository for
@@ -380,7 +360,8 @@ type '<elpa-package>'."
                         (sha256
                          (base32
                           ,(if tarball
-                               (bytevector->nix-base32-string (file-sha256 tarball))
+                               (bytevector->nix-base32-string
+                                (file-hash* tarball #:recursive? #false))
                                "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 26dbc34b63..c7673e6a1a 100644
--- a/guix/import/go.scm
+++ b/guix/import/go.scm
@@ -26,6 +26,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)
@@ -36,11 +37,10 @@
   #: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   (guix base32) (bytevector->nix-base32-string)
   #:autoload   (guix build utils) (mkdir-p)
+  #:autoload   (gcrypt hash) (hash-algorithm sha256)
   #:use-module (ice-9 match)
   #:use-module (ice-9 peg)
   #:use-module (ice-9 rdelim)
@@ -499,25 +499,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."
@@ -536,7 +517,7 @@ tag."
                   (update-cached-checkout url
                                           #:ref
                                           `(tag-or-commit . ,reference)))))
-    (file-hash checkout algorithm)))
+    (file-hash* checkout #:algorithm algorithm #:recursive? #true)))
 
 (define (vcs->origin vcs-type vcs-repo-url version)
   "Generate the `origin' block of a package depending on what type of source
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index abddd885ee..a7bdbfebca 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,6 +39,7 @@
   #:use-module (guix base32)
   #:use-module (guix git)
   #:use-module ((guix git-download) #:prefix download:)
+  #:use-module (guix hash)
   #:use-module (guix store)
   #:export (%default-sort-key
             %contentdb-api
@@ -286,14 +287,6 @@ results.  The return value is a list of <package-keys> records."
   (with-store store
     (latest-repository-commit store url #:ref ref)))
 
-;; XXX adapted from (guix scripts hash)
-(define (file-hash file)
-  "Compute the hash of FILE."
-  (let-values (((port get-hash) (open-sha256-port)))
-    (write-file file port)
-    (force-output port)
-    (get-hash)))
-
 (define (make-minetest-sexp author/name version repository commit
                             inputs home-page synopsis
                             description media-license license)
@@ -314,9 +307,13 @@ MEDIA-LICENSE and LICENSE."
            ;; The git commit is not always available.
            ,(and commit
                  (bytevector->nix-base32-string
-                  (file-hash
+                  (file-hash*
                    (download-git-repository repository
-                                            `(commit . ,commit)))))))
+                                            `(commit . ,commit))
+                   ;; 'download-git-repository' already filtered out the '.git'
+                   ;; directory.
+                   #:select? (const #true)
+                   #:recursive? #true)))))
          (file-name (git-file-name name version))))
      (build-system minetest-mod-build-system)
      ,@(maybe-propagated-inputs (map contentdb->package-name inputs))
-- 
2.30.2

Maxime Devos wrote on 4 Jan 2022 16:09

[PATCH v3 0/4] Add upstream updater for git-fetch origins

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:20220104150937.35872-1-maximedevos@telenet.be

The following changes were made since v2:

* file-hash* has been modified to, by default, only compute nar hash if the

file is a directory.

* Most uses of file-hash* have been modified to explicitely set #:recursive?

#false or #:recursive? #true

* the compiler <upstream-source> has been modified to support git-fetch

origins.

However, it is broken, and I don't know how to resolve the issue.

(Except perhaps by using latest-repository-commit directly but that

shouldn't be necessary, since <git-checkout> objects are lowerable?)

* 'guess-version-transform' has been removed, since it is unused.

Checklist:

- [x] make check

There's one test failure: FAIL: tests/guix-pack-relocatable.sh

guix pack: error: profile contains conflicting entries for python-numpy

guix pack: error: first entry: python-numpy@1.21.3 /gnu/store/9dd0zkkwl45rmsa7b6vjb1747l57aw4y-python-numpy-1.21.3R

guix pack: error: second entry: python-numpy@1.20.3 /gnu/store/mlccgh05bf8cdinq0ilpvpdmsspq36pv-python-numpy-1.20.3R

guix pack: error: ... propagated from python-matplotlib@3.4.3

guix pack: error: ... propagated from python-scipy@1.7.3

guix/build/syscalls.scm:2271:8: In procedure terminal-window-size:

In procedure terminal-window-size: Inappropriate ioctl for device

(This is from within Emacs.) It seems unrelated to this patch series;

- [ ] guix build --source minetest-unified-inventory --with-latest=minetest-unified-inventory

This causes

Wrong type to apply: #<<git-checkout> url: "https://github.com/minetest-mods/unified_inventory"branch: #f commit: "d6688872c84417d2f61d6f5e607aea39d78920aa" recursive?: #f

but I don't know how to resolve this.

- [x] guix refresh minetest-unified-inventory -t minetest

- [x] guix refresh -t minetest -u minetest-unified-inventory

Version, hash and commit seem ok.

- [x] move "hello" to earlier version, do "guix refresh hello"

An update '2.9' -> '2.10' is available.

- [ ] guix refresh -u hello

gpgv: Signature made Sun Nov 16 12:08:37 2014 UTC

gpgv: using RSA key A9553245FDE9B739

gpgv: Can't check signature: No public key

Would you like to add this key to keyring '$HOME/.config/guix/upstream/trustedkeys.kbx'?

yes

gpg: key A9553245FDE9B739: new key but contains no user ID - skipped

gpg: Total number processed: 1

gpg: w/o user IDs: 1

gpgv: Signature made Sun Nov 16 12:08:37 2014 UTC

gpgv: using RSA key A9553245FDE9B739

gpgv: Can't check signature: No public key

guix refresh: warning: signature verification failed for 'mirror://gnu/hello/hello-2.10.tar.gz' (key: A9553245FDE9B739)

guix refresh: warning: hello: version 2.10 could not be downloaded and authenticated; not updating

Failure seems unrelated to patch series.

- [x] "./pre-inst-env guix download mirror://gnu/hello/hello-2.10.tar.gz" and "./pre-inst-env guix hash /gnu/store/STUFF" return the same hash

- [x] ./pre-inst-env guix hash -r $(./pre-inst-env guix build --source minetest-mesecons)

returns the hash in the minetest-mesecons package

Also a warning: ‘--recursive is deprecated, use --serializer' instead,

but 'guix hash --help' doesn't tell what the argument of '--serializer'

can be so I think I'll stick with '-r' for now.

Sarah Morgensen (4):

guix hash: Extract file hashing procedures.

import: Factorize file hashing.

refresh: Support non-tarball sources.

upstream: Support updating and fetching 'git-fetch' origins.

Makefile.am | 1 +

guix/git.scm | 14 ++++++++-

guix/hash.scm | 68 ++++++++++++++++++++++++++++++++++++++++

guix/import/cran.scm | 32 ++-----------------

guix/import/elpa.scm | 29 +++--------------

guix/import/git.scm | 22 +++++++------

guix/import/go.scm | 25 ++-------------

guix/import/minetest.scm | 25 +++++++--------

guix/scripts/hash.scm | 22 +++----------

guix/scripts/refresh.scm | 10 +++---

guix/upstream.scm | 68 +++++++++++++++++++++++++++++++++++-----

tests/minetest.scm | 7 ++---

12 files changed, 190 insertions(+), 133 deletions(-)

create mode 100644 guix/hash.scm

base-commit: 9708681f1a9f221ae6cad64625ba8309b6742653

2.30.2

Maxime Devos wrote on 4 Jan 2022 16:09

[PATCH v3 3/4] refresh: Support non-tarball sources.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:20220104150937.35872-4-maximedevos@telenet.be

* 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(-)

Toggle diff (57 lines)diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 8806f0f740..68bb9040d8 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; 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...~%")
@@ -363,8 +364,7 @@ warn about packages that have no matching updater."
                       (info loc (G_ "~a: consider removing this propagated input: ~a~%")
                             name change-name))))
                  (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~%")
-- 
2.30.2

Maxime Devos wrote on 4 Jan 2022 16:09

[PATCH v3 4/4] upstream: Support updating and fetching 'git-fetch' origins.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:20220104150937.35872-5-maximedevos@telenet.be

From: Sarah Morgensen <iskarian@mgsn.dev>

Updaters need to be modified to return 'git-reference' objects.
This patch modifies the 'generic-git' and 'minetest' updater,
but others might need to be modified as well.

* guix/git.scm (git-reference->git-checkout): New procedure.
* guix/upstream.scm (package-update/git-fetch): New procedure.
  (<upstream-source>)[urls]: Document it can be a 'git-reference'.
  (%method-updates): Add 'git-fetch' mapping.
  (update-package-source): Support 'git-reference' sources.
  (upstream-source-compiler/url-fetch): Split off from ...
  (upstream-source-compiler): ... this, and call ...
  (upstream-source-compiler/git-fetch): ... this new procedure if the URL
  field contains a 'git-reference'.
* guix/import/git.scm
  (latest-git-tag-version): Always return two values and document that the tag
  is returned as well.
  (latest-git-release)[urls]: Use the 'git-reference' instead of the
  repository URL.
* guix/import/minetest.scm (latest-minetest-release)[urls]: Don't wrap the
  'git-reference' in a list.
* tests/minetest.scm (upstream-source->sexp): Adjust to new convention.

Co-authored-by: Maxime Devos <maximedevos@telenet.be>
---
 guix/git.scm             | 14 ++++++++-
 guix/import/git.scm      | 22 +++++++------
 guix/import/minetest.scm |  6 ++--
 guix/upstream.scm        | 68 +++++++++++++++++++++++++++++++++++-----
 tests/minetest.scm       |  7 ++---
 5 files changed, 93 insertions(+), 24 deletions(-)

Toggle diff (289 lines)diff --git a/guix/git.scm b/guix/git.scm
index dc2ca1be84..43e85a5026 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Kyle Meyer <kyle@kyleam.com>
 ;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,6 +34,8 @@
   #:use-module (guix utils)
   #:use-module (guix records)
   #:use-module (guix gexp)
+  #:autoload   (guix git-download)
+  (git-reference-url git-reference-commit git-reference-recursive?)
   #:use-module (guix sets)
   #:use-module ((guix diagnostics) #:select (leave warning))
   #:use-module (guix progress)
@@ -65,7 +68,9 @@
             git-checkout-url
             git-checkout-branch
             git-checkout-commit
-            git-checkout-recursive?))
+            git-checkout-recursive?
+
+            git-reference->git-checkout))
 
 (define %repository-cache-directory
   (make-parameter (string-append (cache-directory #:ensure? #f)
@@ -672,6 +677,13 @@ is true, limit to only refs/tags."
   (commit  git-checkout-commit (default #f))      ;#f | tag | commit
   (recursive? git-checkout-recursive? (default #f)))
 
+(define (git-reference->git-checkout reference)
+  "Convert the <git-reference> REFERENCE to an equivalent <git-checkout>."
+  (git-checkout
+   (url (git-reference-url reference))
+   (commit (git-reference-commit reference))
+   (recursive? (git-reference-recursive? reference))))
+
 (define* (latest-repository-commit* url #:key ref recursive? log-port)
   ;; Monadic variant of 'latest-repository-commit'.
   (lambda (store)
diff --git a/guix/import/git.scm b/guix/import/git.scm
index 1eb219f3fe..4cf404677c 100644
--- a/guix/import/git.scm
+++ b/guix/import/git.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -34,6 +35,7 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
   #:export (%generic-git-updater
 
             ;; For tests.
@@ -172,21 +174,21 @@ repository at URL."
          (values version tag)))))))
 
 (define (latest-git-tag-version package)
-  "Given a PACKAGE, return the latest version of it, or #f if the latest version
-could not be determined."
+  "Given a PACKAGE, return the latest version of it and the corresponding git
+tag, or #false and #false if the latest version could not be determined."
   (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
              (warning (or (package-field-location package 'source)
                           (package-location package))
                       (G_ "~a for ~a~%")
                       (condition-message c)
                       (package-name package))
-             #f)
+             (values #f #f))
             ((eq? (exception-kind c) 'git-error)
              (warning (or (package-field-location package 'source)
                           (package-location package))
                       (G_ "failed to fetch Git repository for ~a~%")
                       (package-name package))
-             #f))
+             (values #f #f)))
     (let* ((source (package-source package))
            (url (git-reference-url (origin-uri source)))
            (property (cute assq-ref (package-properties package) <>)))
@@ -208,14 +210,16 @@ could not be determined."
   "Return an <upstream-source> for the latest release of PACKAGE."
   (let* ((name (package-name package))
          (old-version (package-version package))
-         (url (git-reference-url (origin-uri (package-source package))))
-         (new-version (latest-git-tag-version package)))
-
-    (and new-version
+         (old-reference (origin-uri (package-source package)))
+         (new-version new-version-tag (latest-git-tag-version package)))
+    (and new-version new-version-tag
          (upstream-source
           (package name)
           (version new-version)
-          (urls (list url))))))
+          (urls (git-reference
+                 (url (git-reference-url old-reference))
+                 (commit new-version-tag)
+                 (recursive? (git-reference-recursive? old-reference))))))))
 
 (define %generic-git-updater
   (upstream-updater
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index a7bdbfebca..3b2cdcdcac 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -504,9 +504,9 @@ or #false if the latest release couldn't be determined."
        (upstream-source
         (package (package:package-name pkg))
         (version (release-version release))
-        (urls (list (download:git-reference
-                     (url (package-repository contentdb-package))
-                     (commit (release-commit release))))))))
+        (urls (download:git-reference
+               (url (package-repository contentdb-package))
+               (commit (release-commit release)))))))
 
 (define %minetest-updater
   (upstream-updater
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 632e9ebc4f..bb6db2cedb 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -2,6 +2,8 @@
 ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,12 +26,14 @@
   #: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)
   #:use-module (guix ui)
   #:use-module (guix base32)
   #:use-module (guix gexp)
+  #:use-module (guix git)
   #:use-module (guix store)
   #:use-module ((guix derivations) #:select (built-derivations derivation->output-path))
   #:autoload   (gcrypt hash) (port-sha256)
@@ -93,7 +97,7 @@
   upstream-source?
   (package        upstream-source-package)        ;string
   (version        upstream-source-version)        ;string
-  (urls           upstream-source-urls)           ;list of strings
+  (urls           upstream-source-urls)           ;list of strings|git-reference
   (signature-urls upstream-source-signature-urls  ;#f | list of strings
                   (default #f))
   (input-changes  upstream-source-input-changes
@@ -357,10 +361,20 @@ values: 'interactive' (default), 'always', and 'never'."
                         data url)
                #f)))))))
 
-(define-gexp-compiler (upstream-source-compiler (source <upstream-source>)
-                                                system target)
-  "Download SOURCE from its first URL and lower it as a fixed-output
-derivation that would fetch it."
+(define (upstream-source-compiler/git-fetch source system target)
+  "Lower SOURCE, an <upstream-source> using git."
+  ;; TODO: it would be nice to support provenance tracking, as
+  ;; in 'upstream-source-compiler/url-fetch'.
+  ;;
+  ;; TODO: this causes
+  ;;
+  ;; ‘Wrong type to apply: #<<git-checkout> url: "https://github.com/minetest-mods/unified_inventory" branch: #f commit: "d6688872c84417d2f61d6f5e607aea39d78920aa" recursive?: #f>’?
+  ;; (Another error results if it is wrapped in a 'return'.)
+  (git-reference->git-checkout (upstream-source-urls source)))
+
+(define (upstream-source-compiler/url-fetch source system target)
+  "Lower SOURCE, an <upstream-source> pointing to a tarball, as a
+fixed-output derivation that would fetch it, and verify its authenticity."
   (mlet* %store-monad ((url -> (first (upstream-source-urls source)))
                        (signature
                         -> (and=> (upstream-source-signature-urls source)
@@ -378,6 +392,15 @@ derivation that would fetch it."
       (url-fetch url 'sha256 hash (store-path-package-name tarball)
                  #:system system))))
 
+(define-gexp-compiler (upstream-source-compiler (source <upstream-source>)
+                                                system target)
+  "Download SOURCE and verify its authenticity if possible.  When feasible,
+lower it as a fixed-output derivation that would fetch it, to improve
+provenance tracking."
+  (if (git-reference? (upstream-source-urls source))
+      (upstream-source-compiler/git-fetch source system target)
+      (upstream-source-compiler/url-fetch source system target)))
+
 (define (find2 pred lst1 lst2)
   "Like 'find', but operate on items from both LST1 and LST2.  Return two
 values: the item from LST1 and the item from LST2 that match PRED."
@@ -430,9 +453,24 @@ SOURCE, an <upstream-source>."
                                         #:key-download key-download)))
          (values version tarball source))))))
 
+(define* (package-update/git-fetch store package source #:key key-download)
+  "Return the version, checkout, and SOURCE, to update PACKAGE to
+SOURCE, an <upstream-source>."
+  ;; TODO: it would be nice to authenticate commits, e.g. with
+  ;; "guix git authenticate" or a list of permitted signing keys.
+  (define ref (upstream-source-urls source)) ; a <git-reference>
+  (values (upstream-source-version source)
+          (latest-repository-commit
+           store
+           (git-reference-url ref)
+           #:ref `(tag-or-commit . ,(git-reference-commit ref))
+           #:recursive? (git-reference-recursive? ref))
+          source))
+
 (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))
@@ -492,9 +530,22 @@ new version string if an update was made, and #f otherwise."
                              (origin-hash (package-source package))))
                (old-url     (match (origin-uri (package-source package))
                               ((? string? url) url)
+                              ((? git-reference? ref)
+                               (git-reference-url ref))
                               (_ #f)))
                (new-url     (match (upstream-source-urls source)
-                              ((first _ ...) first)))
+                              ((first _ ...) first)
+                              ((? git-reference? ref)
+                               (git-reference-url ref))
+                              (_ #f)))
+               (old-commit  (match (origin-uri (package-source package))
+                              ((? git-reference? ref)
+                               (git-reference-commit ref))
+                              (_ #f)))
+               (new-commit  (match (upstream-source-urls source)
+                              ((? git-reference? ref)
+                               (git-reference-commit ref))
+                              (_ #f)))
                (file        (and=> (location-file loc)
                                    (cut search-path %load-path <>))))
           (if file
@@ -508,6 +559,9 @@ new version string if an update was made, and #f otherwise."
                                            'filename file))
                     (replacements `((,old-version . ,version)
                                     (,old-hash . ,hash)
+                                    ,@(if (and old-commit new-commit)
+                                          `((,old-commit . ,new-commit))
+                                          '())
                                     ,@(if (and old-url new-url)
                                           `((,(dirname old-url) .
                                              ,(dirname new-url)))
diff --git a/tests/minetest.scm b/tests/minetest.scm
index 77b9aa928f..cbb9e83889 100644
--- a/tests/minetest.scm
+++ b/tests/minetest.scm
@@ -387,10 +387,9 @@ during a dynamic extent where that package is available on ContentDB."
 
 ;; Update detection
 (define (upstream-source->sexp upstream-source)
-  (define urls (upstream-source-urls upstream-source))
-  (unless (= 1 (length urls))
-    (error "only a single URL is expected"))
-  (define url (first urls))
+  (define url (upstream-source-urls upstream-source))
+  (unless (git-reference? url)
+    (error "a <git-reference> is expected"))
   `(,(upstream-source-package upstream-source)
     ,(upstream-source-version upstream-source)
     ,(git-reference-url url)
-- 
2.30.2

Maxime Devos wrote on 4 Jan 2022 20:05

Re: [PATCH v3 0/4] Add upstream updater for git-fetch origins

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:13761a088afab728d9e0b390533648c99b409824.camel@telenet.be

Maxime Devos schreef op di 04-01-2022 om 15:09 [+0000]:

Toggle quote (7 lines)

> � * the compiler <upstream-source> has been modified to support git-fetch

> �� origins.

> �� However, it is broken, and I don't know how to resolve the issue.

> �� (Except perhaps by using latest-repository-commit directly but that

> �� shouldn't be necessary, since <git-checkout> objects are lowerable?)

I think I have an idea how to solve this. Will send a v4 later

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYdSaXxccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7u2rAP90Ms3Df8ESR7bSBjuFq5hNpwsw

FasX3LwO+Yj7V2GG3QEAkp5MXFsztZpj2SmAMdv+h+7FndOgDphCpzs0L0Pf/wk=

=OmBU

-----END PGP SIGNATURE-----

Maxime Devos wrote on 4 Jan 2022 21:06

[PATCH v4 2/4] import: Factorize file hashing.

Recipients:(address . 50072@debbugs.gnu.org)(name . Sarah Morgensen)(address . iskarian@mgsn.dev)

Message-ID:20220104200643.43374-3-maximedevos@telenet.be

From: Sarah Morgensen <iskarian@mgsn.dev>

* 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/minetest.scm (file-hash): Remove procedure.
  (make-minetest-sexp): Use 'file-hash*' instead.
---
 guix/import/cran.scm     | 32 +++-----------------------------
 guix/import/elpa.scm     | 29 +++++------------------------
 guix/import/go.scm       | 25 +++----------------------
 guix/import/minetest.scm | 19 ++++++++-----------
 4 files changed, 19 insertions(+), 86 deletions(-)

Toggle diff (256 lines)diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 1389576cad..b61402078d 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -35,10 +36,9 @@
   #:use-module (guix memoization)
   #:use-module (guix http-client)
   #:use-module (guix diagnostics)
+  #:use-module (guix hash)
   #:use-module (guix i18n)
-  #:use-module (gcrypt 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)
@@ -196,17 +196,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
@@ -464,16 +453,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."
@@ -571,12 +550,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 #:recursive? (or git? hg?)))))))
               ,@(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 edabb88b7a..c5167eacb5 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,10 +38,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)
@@ -229,27 +230,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."
@@ -271,7 +251,7 @@ RECIPE."
        (sha256
         (base32
          ,(bytevector->nix-base32-string
-           (file-hash directory (negate vcs-file?) #t)))))))
+           (file-hash* directory #:recursive? #true)))))))
 
 (define* (melpa-recipe->origin recipe)
   "Fetch origin details from the MELPA recipe and associated repository for
@@ -380,7 +360,8 @@ type '<elpa-package>'."
                         (sha256
                          (base32
                           ,(if tarball
-                               (bytevector->nix-base32-string (file-sha256 tarball))
+                               (bytevector->nix-base32-string
+                                (file-hash* tarball #:recursive? #false))
                                "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 26dbc34b63..c7673e6a1a 100644
--- a/guix/import/go.scm
+++ b/guix/import/go.scm
@@ -26,6 +26,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)
@@ -36,11 +37,10 @@
   #: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   (guix base32) (bytevector->nix-base32-string)
   #:autoload   (guix build utils) (mkdir-p)
+  #:autoload   (gcrypt hash) (hash-algorithm sha256)
   #:use-module (ice-9 match)
   #:use-module (ice-9 peg)
   #:use-module (ice-9 rdelim)
@@ -499,25 +499,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."
@@ -536,7 +517,7 @@ tag."
                   (update-cached-checkout url
                                           #:ref
                                           `(tag-or-commit . ,reference)))))
-    (file-hash checkout algorithm)))
+    (file-hash* checkout #:algorithm algorithm #:recursive? #true)))
 
 (define (vcs->origin vcs-type vcs-repo-url version)
   "Generate the `origin' block of a package depending on what type of source
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index abddd885ee..a7bdbfebca 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,6 +39,7 @@
   #:use-module (guix base32)
   #:use-module (guix git)
   #:use-module ((guix git-download) #:prefix download:)
+  #:use-module (guix hash)
   #:use-module (guix store)
   #:export (%default-sort-key
             %contentdb-api
@@ -286,14 +287,6 @@ results.  The return value is a list of <package-keys> records."
   (with-store store
     (latest-repository-commit store url #:ref ref)))
 
-;; XXX adapted from (guix scripts hash)
-(define (file-hash file)
-  "Compute the hash of FILE."
-  (let-values (((port get-hash) (open-sha256-port)))
-    (write-file file port)
-    (force-output port)
-    (get-hash)))
-
 (define (make-minetest-sexp author/name version repository commit
                             inputs home-page synopsis
                             description media-license license)
@@ -314,9 +307,13 @@ MEDIA-LICENSE and LICENSE."
            ;; The git commit is not always available.
            ,(and commit
                  (bytevector->nix-base32-string
-                  (file-hash
+                  (file-hash*
                    (download-git-repository repository
-                                            `(commit . ,commit)))))))
+                                            `(commit . ,commit))
+                   ;; 'download-git-repository' already filtered out the '.git'
+                   ;; directory.
+                   #:select? (const #true)
+                   #:recursive? #true)))))
          (file-name (git-file-name name version))))
      (build-system minetest-mod-build-system)
      ,@(maybe-propagated-inputs (map contentdb->package-name inputs))
-- 
2.30.2

Maxime Devos wrote on 4 Jan 2022 21:06

[PATCH v4 1/4] guix hash: Extract file hashing procedures.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:20220104200643.43374-2-maximedevos@telenet.be

* guix/scripts/hash.scm (guix-hash)[vcs-file?] (nar-hash, default-hash):

Extract hashing logic to...

* guix/hash.scm (vcs-file?, file-hash*): ... these new procedures in this

new file.

Modified-by: Maxime Devos <maximedevos@telenet.be>

---

Makefile.am | 1 +

guix/hash.scm | 68 +++++++++++++++++++++++++++++++++++++++++++

guix/scripts/hash.scm | 22 +++-----------

3 files changed, 73 insertions(+), 18 deletions(-)

create mode 100644 guix/hash.scm

Toggle diff (148 lines)diff --git a/Makefile.am b/Makefile.am
index 8c5682a1c6..bc3d0087d0 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -99,6 +99,7 @@ MODULES =					\
   guix/extracting-download.scm			\
   guix/git-download.scm				\
   guix/hg-download.scm				\
+  guix/hash.scm					\
   guix/swh.scm					\
   guix/monads.scm				\
   guix/monad-repl.scm				\
diff --git a/guix/hash.scm b/guix/hash.scm
new file mode 100644
index 0000000000..19cbc41ad1
--- /dev/null
+++ b/guix/hash.scm
@@ -0,0 +1,68 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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? 'auto)
+                     (select? (negate vcs-file?)))
+  "Compute the hash of FILE with ALGORITHM.  If RECURSIVE? is #true or 'auto',
+recurse into subdirectories of FILE, computing the combined hash (nar hash) of
+all files for which (SELECT?  FILE STAT) returns true.
+
+Symbolic links are not dereferenced unless RECURSIVE? is false.
+
+This procedure must only be used under controlled circumstances;
+the detection of symbolic links in FILE is racy.
+
+Keep in mind that the hash of a regular file depends on RECURSIVE?:
+if the recursive hash is desired, it must be set to #true.  Otherwise, it must
+be set to #false or 'auto'. In most situations, the non-recursive hash is desired
+for regular files."
+  (if (or (eq? recursive? #true)
+          (and (eq? recursive? 'auto)
+               ;; Don't change this to (eq? 'directory ...), because otherwise
+               ;; if 'file' denotes a symbolic link, the 'file-hash' below
+               ;; would dereference it -- dereferencing symbolic links would
+               ;; open an avoidable can of potential worms.
+               (not (eq? 'regular (stat:type (lstat file))))))
+      (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 d73e3d13dd..28d587b944 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +25,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)
@@ -46,20 +48,14 @@
 (define* (nar-hash file #:optional
                    (algorithm (assoc-ref %default-options 'hash-algorithm))
                    select?)
-  (let-values (((port get-hash)
-                (open-hash-port algorithm)))
-    (write-file file port #:select? select?)
-    (force-output port)
-    (get-hash)))
+  (file-hash* file #:algorithm algorithm #:select? select? #:recursive? #true))
 
 (define* (default-hash file #:optional
                        (algorithm (assoc-ref %default-options 'hash-algorithm))
                        select?)
   (match file
     ("-" (port-hash algorithm (current-input-port)))
-    (_
-     (call-with-input-file file
-       (cute port-hash algorithm <>)))))
+    (_ (file-hash* file #:algorithm algorithm #:recursive? #false))))
 
 (define* (git-hash file #:optional
                        (algorithm (assoc-ref %default-options 'hash-algorithm))
@@ -181,16 +177,6 @@ use '--serializer' instead~%"))
     (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)
-- 
2.30.2

Maxime Devos wrote on 4 Jan 2022 21:06

[PATCH v4 3/4] refresh: Support non-tarball sources.

Recipients:(address . 50072@debbugs.gnu.org)(name . Sarah Morgensen)(address . iskarian@mgsn.dev)

Message-ID:20220104200643.43374-4-maximedevos@telenet.be

* 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(-)

Toggle diff (57 lines)diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 8806f0f740..68bb9040d8 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; 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...~%")
@@ -363,8 +364,7 @@ warn about packages that have no matching updater."
                       (info loc (G_ "~a: consider removing this propagated input: ~a~%")
                             name change-name))))
                  (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~%")
-- 
2.30.2

Maxime Devos wrote on 4 Jan 2022 21:06

[PATCH v4 0/4] Add upstream updater for git-fetch origins

Recipients:(address . 50072@debbugs.gnu.org)(name . Maxime Devos)(address . maximedevos@telenet.be)

Message-ID:20220104200643.43374-1-maximedevos@telenet.be

I've found a solution to the upstream-source-compiler/git-fetch
problem: returning the result of git-fetch like
upstream-source-compiler/url-fetch returns the result of url-fetch.

The following now works:
$ ./pre-inst-env guix build --source minetest-unified-inventory --with-latest=minetest-unified-inventory

Unrelated change: I let (guix git) be autoloaded, to avoid loading
guile-git when not necessary.

I think this patch series is ready now?

Sarah Morgensen (4):
  guix hash: Extract file hashing procedures.
  import: Factorize file hashing.
  refresh: Support non-tarball sources.
  upstream: Support updating and fetching 'git-fetch' origins.

 Makefile.am              |  1 +
 guix/git.scm             | 14 +++++++-
 guix/hash.scm            | 68 +++++++++++++++++++++++++++++++++++++
 guix/import/cran.scm     | 32 ++----------------
 guix/import/elpa.scm     | 29 +++-------------
 guix/import/git.scm      | 22 +++++++-----
 guix/import/go.scm       | 25 ++------------
 guix/import/minetest.scm | 25 ++++++--------
 guix/scripts/hash.scm    | 22 +++---------
 guix/scripts/refresh.scm | 10 +++---
 guix/upstream.scm        | 73 ++++++++++++++++++++++++++++++++++++----
 tests/minetest.scm       |  7 ++--
 12 files changed, 195 insertions(+), 133 deletions(-)
 create mode 100644 guix/hash.scm


base-commit: 9708681f1a9f221ae6cad64625ba8309b6742653
-- 
2.30.2

Maxime Devos wrote on 4 Jan 2022 21:06

[PATCH v4 4/4] upstream: Support updating and fetching 'git-fetch' origins.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:20220104200643.43374-5-maximedevos@telenet.be

From: Sarah Morgensen <iskarian@mgsn.dev>

Updaters need to be modified to return 'git-reference' objects.
This patch modifies the 'generic-git' and 'minetest' updater,
but others might need to be modified as well.

* guix/git.scm (git-reference->git-checkout): New procedure.
* guix/upstream.scm (package-update/git-fetch): New procedure.
  (<upstream-source>)[urls]: Document it can be a 'git-reference'.
  (%method-updates): Add 'git-fetch' mapping.
  (update-package-source): Support 'git-reference' sources.
  (upstream-source-compiler/url-fetch): Split off from ...
  (upstream-source-compiler): ... this, and call ...
  (upstream-source-compiler/git-fetch): ... this new procedure if the URL
  field contains a 'git-reference'.
* guix/import/git.scm
  (latest-git-tag-version): Always return two values and document that the tag
  is returned as well.
  (latest-git-release)[urls]: Use the 'git-reference' instead of the
  repository URL.
* guix/import/minetest.scm (latest-minetest-release)[urls]: Don't wrap the
  'git-reference' in a list.
* tests/minetest.scm (upstream-source->sexp): Adjust to new convention.

Co-authored-by: Maxime Devos <maximedevos@telenet.be>
---
 guix/git.scm             | 14 +++++++-
 guix/import/git.scm      | 22 +++++++-----
 guix/import/minetest.scm |  6 ++--
 guix/upstream.scm        | 73 ++++++++++++++++++++++++++++++++++++----
 tests/minetest.scm       |  7 ++--
 5 files changed, 98 insertions(+), 24 deletions(-)

Toggle diff (294 lines)diff --git a/guix/git.scm b/guix/git.scm
index dc2ca1be84..43e85a5026 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Kyle Meyer <kyle@kyleam.com>
 ;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,6 +34,8 @@
   #:use-module (guix utils)
   #:use-module (guix records)
   #:use-module (guix gexp)
+  #:autoload   (guix git-download)
+  (git-reference-url git-reference-commit git-reference-recursive?)
   #:use-module (guix sets)
   #:use-module ((guix diagnostics) #:select (leave warning))
   #:use-module (guix progress)
@@ -65,7 +68,9 @@
             git-checkout-url
             git-checkout-branch
             git-checkout-commit
-            git-checkout-recursive?))
+            git-checkout-recursive?
+
+            git-reference->git-checkout))
 
 (define %repository-cache-directory
   (make-parameter (string-append (cache-directory #:ensure? #f)
@@ -672,6 +677,13 @@ is true, limit to only refs/tags."
   (commit  git-checkout-commit (default #f))      ;#f | tag | commit
   (recursive? git-checkout-recursive? (default #f)))
 
+(define (git-reference->git-checkout reference)
+  "Convert the <git-reference> REFERENCE to an equivalent <git-checkout>."
+  (git-checkout
+   (url (git-reference-url reference))
+   (commit (git-reference-commit reference))
+   (recursive? (git-reference-recursive? reference))))
+
 (define* (latest-repository-commit* url #:key ref recursive? log-port)
   ;; Monadic variant of 'latest-repository-commit'.
   (lambda (store)
diff --git a/guix/import/git.scm b/guix/import/git.scm
index 1eb219f3fe..4cf404677c 100644
--- a/guix/import/git.scm
+++ b/guix/import/git.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -34,6 +35,7 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
   #:export (%generic-git-updater
 
             ;; For tests.
@@ -172,21 +174,21 @@ repository at URL."
          (values version tag)))))))
 
 (define (latest-git-tag-version package)
-  "Given a PACKAGE, return the latest version of it, or #f if the latest version
-could not be determined."
+  "Given a PACKAGE, return the latest version of it and the corresponding git
+tag, or #false and #false if the latest version could not be determined."
   (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
              (warning (or (package-field-location package 'source)
                           (package-location package))
                       (G_ "~a for ~a~%")
                       (condition-message c)
                       (package-name package))
-             #f)
+             (values #f #f))
             ((eq? (exception-kind c) 'git-error)
              (warning (or (package-field-location package 'source)
                           (package-location package))
                       (G_ "failed to fetch Git repository for ~a~%")
                       (package-name package))
-             #f))
+             (values #f #f)))
     (let* ((source (package-source package))
            (url (git-reference-url (origin-uri source)))
            (property (cute assq-ref (package-properties package) <>)))
@@ -208,14 +210,16 @@ could not be determined."
   "Return an <upstream-source> for the latest release of PACKAGE."
   (let* ((name (package-name package))
          (old-version (package-version package))
-         (url (git-reference-url (origin-uri (package-source package))))
-         (new-version (latest-git-tag-version package)))
-
-    (and new-version
+         (old-reference (origin-uri (package-source package)))
+         (new-version new-version-tag (latest-git-tag-version package)))
+    (and new-version new-version-tag
          (upstream-source
           (package name)
           (version new-version)
-          (urls (list url))))))
+          (urls (git-reference
+                 (url (git-reference-url old-reference))
+                 (commit new-version-tag)
+                 (recursive? (git-reference-recursive? old-reference))))))))
 
 (define %generic-git-updater
   (upstream-updater
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index a7bdbfebca..3b2cdcdcac 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -504,9 +504,9 @@ or #false if the latest release couldn't be determined."
        (upstream-source
         (package (package:package-name pkg))
         (version (release-version release))
-        (urls (list (download:git-reference
-                     (url (package-repository contentdb-package))
-                     (commit (release-commit release))))))))
+        (urls (download:git-reference
+               (url (package-repository contentdb-package))
+               (commit (release-commit release)))))))
 
 (define %minetest-updater
   (upstream-updater
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 632e9ebc4f..1fe996ef3d 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -2,6 +2,8 @@
 ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,12 +26,15 @@
   #: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)
   #:use-module (guix ui)
   #:use-module (guix base32)
   #:use-module (guix gexp)
+  #:autoload   (guix git) (latest-repository-commit git-reference->git-checkout)
+  #:use-module (guix hash)
   #:use-module (guix store)
   #:use-module ((guix derivations) #:select (built-derivations derivation->output-path))
   #:autoload   (gcrypt hash) (port-sha256)
@@ -93,7 +98,7 @@
   upstream-source?
   (package        upstream-source-package)        ;string
   (version        upstream-source-version)        ;string
-  (urls           upstream-source-urls)           ;list of strings
+  (urls           upstream-source-urls)           ;list of strings|git-reference
   (signature-urls upstream-source-signature-urls  ;#f | list of strings
                   (default #f))
   (input-changes  upstream-source-input-changes
@@ -357,10 +362,9 @@ values: 'interactive' (default), 'always', and 'never'."
                         data url)
                #f)))))))
 
-(define-gexp-compiler (upstream-source-compiler (source <upstream-source>)
-                                                system target)
-  "Download SOURCE from its first URL and lower it as a fixed-output
-derivation that would fetch it."
+(define (upstream-source-compiler/url-fetch source system)
+  "Lower SOURCE, an <upstream-source> pointing to a tarball, as a
+fixed-output derivation that would fetch it, and verify its authenticity."
   (mlet* %store-monad ((url -> (first (upstream-source-urls source)))
                        (signature
                         -> (and=> (upstream-source-signature-urls source)
@@ -378,6 +382,30 @@ derivation that would fetch it."
       (url-fetch url 'sha256 hash (store-path-package-name tarball)
                  #:system system))))
 
+(define (upstream-source-compiler/git-fetch source system)
+  "Lower SOURCE, an <upstream-source> using git, as a fixed-output
+derivation that would fetch it."
+  (mlet* %store-monad ((reference -> (upstream-source-urls source))
+                       (checkout
+                        (lower-object
+                         (git-reference->git-checkout reference)
+                         system)))
+    ;; Like in 'upstream-source-compiler/url-fetch', return a fixed-output
+    ;; derivation instead of CHECKOUT.
+    (git-fetch reference 'sha256
+               (file-hash* checkout #:recursive? #true #:select? (const #true))
+               (git-file-name (upstream-source-package source)
+                              (upstream-source-version source))
+               #:system system)))
+
+(define-gexp-compiler (upstream-source-compiler (source <upstream-source>)
+                                                system target)
+  "Download SOURCE, lower it as a fixed-output derivation that would fetch it,
+and verify its authenticity if possible."
+  (if (git-reference? (upstream-source-urls source))
+      (upstream-source-compiler/git-fetch source system)
+      (upstream-source-compiler/url-fetch source system)))
+
 (define (find2 pred lst1 lst2)
   "Like 'find', but operate on items from both LST1 and LST2.  Return two
 values: the item from LST1 and the item from LST2 that match PRED."
@@ -430,9 +458,24 @@ SOURCE, an <upstream-source>."
                                         #:key-download key-download)))
          (values version tarball source))))))
 
+(define* (package-update/git-fetch store package source #:key key-download)
+  "Return the version, checkout, and SOURCE, to update PACKAGE to
+SOURCE, an <upstream-source>."
+  ;; TODO: it would be nice to authenticate commits, e.g. with
+  ;; "guix git authenticate" or a list of permitted signing keys.
+  (define ref (upstream-source-urls source)) ; a <git-reference>
+  (values (upstream-source-version source)
+          (latest-repository-commit
+           store
+           (git-reference-url ref)
+           #:ref `(tag-or-commit . ,(git-reference-commit ref))
+           #:recursive? (git-reference-recursive? ref))
+          source))
+
 (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))
@@ -492,9 +535,22 @@ new version string if an update was made, and #f otherwise."
                              (origin-hash (package-source package))))
                (old-url     (match (origin-uri (package-source package))
                               ((? string? url) url)
+                              ((? git-reference? ref)
+                               (git-reference-url ref))
                               (_ #f)))
                (new-url     (match (upstream-source-urls source)
-                              ((first _ ...) first)))
+                              ((first _ ...) first)
+                              ((? git-reference? ref)
+                               (git-reference-url ref))
+                              (_ #f)))
+               (old-commit  (match (origin-uri (package-source package))
+                              ((? git-reference? ref)
+                               (git-reference-commit ref))
+                              (_ #f)))
+               (new-commit  (match (upstream-source-urls source)
+                              ((? git-reference? ref)
+                               (git-reference-commit ref))
+                              (_ #f)))
                (file        (and=> (location-file loc)
                                    (cut search-path %load-path <>))))
           (if file
@@ -508,6 +564,9 @@ new version string if an update was made, and #f otherwise."
                                            'filename file))
                     (replacements `((,old-version . ,version)
                                     (,old-hash . ,hash)
+                                    ,@(if (and old-commit new-commit)
+                                          `((,old-commit . ,new-commit))
+                                          '())
                                     ,@(if (and old-url new-url)
                                           `((,(dirname old-url) .
                                              ,(dirname new-url)))
diff --git a/tests/minetest.scm b/tests/minetest.scm
index 77b9aa928f..cbb9e83889 100644
--- a/tests/minetest.scm
+++ b/tests/minetest.scm
@@ -387,10 +387,9 @@ during a dynamic extent where that package is available on ContentDB."
 
 ;; Update detection
 (define (upstream-source->sexp upstream-source)
-  (define urls (upstream-source-urls upstream-source))
-  (unless (= 1 (length urls))
-    (error "only a single URL is expected"))
-  (define url (first urls))
+  (define url (upstream-source-urls upstream-source))
+  (unless (git-reference? url)
+    (error "a <git-reference> is expected"))
   `(,(upstream-source-package upstream-source)
     ,(upstream-source-version upstream-source)
     ,(git-reference-url url)
-- 
2.30.2

zimoun wrote on 4 Jan 2022 23:22

Re: bug#50072: [PATCH WIP 0/4] Add upstream updater for git-fetch origins.

Recipients:(name . Maxime Devos)(address . maximedevos@telenet.be)

Message-ID:867dbfcf9n.fsf_-_@gmail.com

Hi Maxime,

Thanks! All LGTM and I have two naive remarks.

On Tue, 04 Jan 2022 at 20:06, Maxime Devos <maximedevos@telenet.be> wrote:

Toggle quote (2 lines)

> diff --git a/guix/hash.scm b/guix/hash.scm

[...]

Toggle quote (19 lines)> +(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)))

1) Why ’vcs-file?’ requires to be exported? Is it used elsewhere?

Toggle quote (4 lines)

> +(define* (file-hash* file #:key

> + (algorithm (hash-algorithm sha256))

> + (recursive? 'auto)

2) ’auto’ is confusing…

Toggle quote (4 lines)

> + (select? (negate vcs-file?)))

> + "Compute the hash of FILE with ALGORITHM. If RECURSIVE? is #true or 'auto',

> +recurse into subdirectories of FILE, computing the combined hash (nar hash) of

…here I understand that ’auto’ means #true…

Toggle quote (5 lines)

> +Keep in mind that the hash of a regular file depends on RECURSIVE?:

> +if the recursive hash is desired, it must be set to #true. Otherwise, it must

> +be set to #false or 'auto'. In most situations, the non-recursive hash is desired

> +for regular files."

…but there it is the contrary. :-) To me, #true/#false or #t/#f are

meaningful, especially when…

Toggle quote (3 lines)

> + (if (or (eq? recursive? #true)

> + (and (eq? recursive? 'auto)

…the symbol ’auto’ is only used here. IIRC all the series. :-)

(I know Ricardo is for instance in favor of #true/#false compared to

#t/#f. I have an opinion but I would like to avoid another

bikeshed. ;-))

Cheers,

simon

Maxime Devos wrote on 5 Jan 2022 11:07

Recipients:(name . zimoun)(address . zimon.toutoune@gmail.com)

Message-ID:52e7be94d926aa06c2a0132090e8c212381e7900.camel@telenet.be

zimoun schreef op di 04-01-2022 om 23:22 [+0100]:

Toggle quote (8 lines)

> 2) ’auto’ is confusing…

> > +�� (select? (negate vcs-file?)))

> > +� "Compute the hash of FILE with ALGORITHM.� If RECURSIVE? is #true or 'auto',

> > +recurse into subdirectories of FILE, computing the combined hash (nar hash) of

> …here I understand that ’auto’ means #true…

Precisely, in the sense 'auto' means #true in that 'auto' recurses.

But sometimes #true / auto compute a different hash ...

Toggle quote (7 lines)

> > +Keep in mind that the hash of a regular file depends on RECURSIVE?:

> > +if the recursive hash is desired, it must be set to #true.� Otherwise, it must

> > +be set to #false or 'auto'. In most situations, the non-recursive hash is desired

> > +for regular files."

> …but there it is the contrary. :-)

No, when #:recursive? is 'auto' and the file is a directory, it

recurses. When it is 'auto' and the file is a regular file, then

it also recurses, albeit in a trivial way (because regular files don't

contain other files).

This comment explains that the 'recursive hash' (nar hash) and 'regular

hash' of a regular file are different, that usually you want the

regular hash for regular files, and implies that '#:recursive? auto'

usually does the right thing.

But if you really want the recursive hash for regular files, then you

can still compute that by setting #:recursive? #true.

Toggle quote (8 lines)

> � To me, #true/#false or #t/#f are

> meaningful, especially when…

> > +� (if (or (eq? recursive? #true)

> > +�� (and (eq? recursive? 'auto)

> …the symbol ’auto’ is only used here.� IIRC all the series. :-)

In ‘[PATCH v4 3/4] refresh: Support non-tarball sources.’, there's

Toggle quote (2 lines)

> + (let ((hash (file-hash* output)))

There, #:recursive? is 'auto'.

Greetings,

Maxime

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYdVtyhccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7vd0AQC28roqlHxi5wsBXMukpA1Xlmp+

j8YOaunayI8shlCfbwEA2LdofI6Mqy06DFcjCFRONrh8BDgdD5wQ4yFSoU6qgg0=

=sKUQ

-----END PGP SIGNATURE-----

Maxime Devos wrote on 5 Jan 2022 11:09

Recipients:(name . zimoun)(address . zimon.toutoune@gmail.com)

Message-ID:919c1eeba549b11de04d30629b2deaef3bac048e.camel@telenet.be

zimoun schreef op di 04-01-2022 om 23:22 [+0100]:

Toggle quote (14 lines)> > +(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)))
> 
> 1) Why ’vcs-file?’ requires to be exported?� Is it used elsewhere?

It is used in (guix scripts hash):

(select? (if (assq-ref opts 'exclude-vcs?)

(negate vcs-file?)

(const #t)))

Greetings,

Maxime.

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYdVuUhccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7lnGAQDcrnBJvZcsGyDFuXW3WEycH4Qc

fdcvUNF5O1AZag719wEA4JHIo3ibZ/ZWM9Q6X04c/3mzu1duWKhMK/o4z9/hiAU=

=9Wpl

-----END PGP SIGNATURE-----

zimoun wrote on 5 Jan 2022 12:48

Recipients:(name . Maxime Devos)(address . maximedevos@telenet.be)

Message-ID:86y23u768v.fsf@gmail.com

Hi Maxime,

On Wed, 05 Jan 2022 at 11:07, Maxime Devos <maximedevos@telenet.be> wrote:

Toggle quote (3 lines)

> Precisely, in the sense 'auto' means #true in that 'auto' recurses.

> But sometimes #true / auto compute a different hash ...

[...]

Toggle quote (13 lines)> No, when #:recursive? is 'auto' and the file is a directory, it
> recurses. When it is 'auto' and the file is a regular file, then
> it also recurses, albeit in a trivial way (because regular files don't
> contain other files).
>
> This comment explains that the 'recursive hash' (nar hash) and 'regular
> hash' of a regular file are different, that usually you want the
> regular hash for regular files, and implies that '#:recursive? auto'
> usually does the right thing.
>
> But if you really want the recursive hash for regular files, then you
> can still compute that by setting #:recursive? #true.

Thanks for explaining.

Hm, my confusion is probably the same as #51307 [1].

1: https://issues.guix.gnu.org/51307#12

Well, I think ’#:recursive?’ is confusing, and ’auto’ too because it is

not POLA for a plumbing function, IMHO. Anyway. It is v4 and it is

ready to merge. :-)

I just propose to replace ’#:recursive?’ by ’#:nar-serializer?’ and a

docstring along these lines,

Toggle snippet (18 lines)

"Compute the hash of FILE with ALGORITHM. If NAR-SERIALIZER? is

#true, compute the combined hash (NAR hash) of FILE for which (SELECT?

FILE STAT) returns true.

If NAR-SERIALIZER? is #false, compute the regular hash using the

default serializer. It is meant to be used for a regular file.

If NAR-SERIALIZER? is 'auto', when FILE is a directory, compute the

combined hash (NAR hash). When FILE is a regular file, compute the

regular hash using the default serializer. The option ’auto’ is meant

to apply by default the expected hash computation.

Symbolic links are not dereferenced unless NAR-SERIALIZER? is false.

This procedure must only be used under controlled circumstances; the

detection of symbolic links in FILE is racy.

WDYT?

Toggle quote (11 lines)>> > +� (if (or (eq? recursive? #true)
>> > +��������� (and (eq? recursive? 'auto)
>> 
>> …the symbol ’auto’ is only used here.� IIRC all the series. :-)
>
> In ‘[PATCH v4 3/4] refresh: Support non-tarball sources.’, there's
>
>> +                (let ((hash (file-hash* output)))
>
> There, #:recursive? is 'auto'.

Naive questions: Is it mandatory? Or can be explicitly set?

(I have nothing against, just to me ’auto’ is somehow ambiguous and «In

the face of ambiguity, refuse the temptation to guess» as ’pyhon3 -c

'import this'’ says ;-))

Cheers,

simon

Maxime Devos wrote on 5 Jan 2022 13:10

Recipients:(name . zimoun)(address . zimon.toutoune@gmail.com)

Message-ID:af4460e7191238612140fc4dc7196b08ee9ac442.camel@telenet.be

zimoun schreef op wo 05-01-2022 om 12:48 [+0100]:

Toggle quote (18 lines)> > > > +� (if (or (eq? recursive? #true)
> > > > +��������� (and (eq? recursive? 'auto)
> > > 
> > > …the symbol ’auto’ is only used here.� IIRC all the series. :-)
> > 
> > In ‘[PATCH v4 3/4] refresh: Support non-tarball sources.’, there's
> > 
> > > +��������������� (let ((hash (file-hash* output)))
> > 
> > There, #:recursive? is 'auto'.
> 
> Naive questions: Is it mandatory?� Or can be explicitly set?
> 
> (I have nothing against, just to me ’auto’ is somehow ambiguous and
> «In
> the face of ambiguity, refuse the temptation to guess» as ’pyhon3 -c
> 'import this'’ says ;-))

'auto' is indeed a little ambigious, so I adjusted most calls to

file-hash* to set #:recursive? #true/#false appropriately in�v3.

But in this particular case (guix/scripts/refresh.scm), it not known in

advance, so some guesswork is necessary.

Anyway, these calls to file-hash* are bothering me a little: can't

we just record the hash in the 'upstream-source' record or ask the

daemon for the hash of a store item (*) or something?

(*) Maybe query-path-hash works or maybe there are problems.

Also, would be nice if there was a variant of query-path-hash

that works on non-sha256 (in principle guix supports other hashes,

though currently they are unused). Or maybe query-path-hash is

works differently.

That would complicate this patch series more, so I'd prefer to delay

that for a future patch series.

Greetings,

Maxime.

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYdWKmRccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7mAvAPoDCzK6yPbZ1D2qdvfMDzNbDQzJ

jFXBd3z2jNS8cWaH1AEA7We4WsrSQdz1EFwe9VyERTX7yazUrIkAvrZdOxxjbQg=

=u1xx

-----END PGP SIGNATURE-----

Maxime Devos wrote on 5 Jan 2022 13:27

Recipients:(name . zimoun)(address . zimon.toutoune@gmail.com)

Message-ID:defa9116cb390f20706315f5ea0fa17338817409.camel@telenet.be

zimoun schreef op wo 05-01-2022 om 12:48 [+0100]:

Toggle quote (3 lines)

> Well, I think ’#:recursive?’ is confusing, and ’auto’ too because it is

> not POLA for a plumbing function, IMHO.� [...]

Principle of least authority, or principle of least astonishment?

I presume the latter.

Toggle quote (2 lines)

> Anyway. It is v4 and it is ready to merge. :-)

I vote for a purple bikeshed! But your orange bikeshed would also keep

the bikes out of the rain.

Toggle quote (24 lines)> I just propose to replace ’#:recursive?’ by ’#:nar-serializer?’ and a
> docstring along these lines,
> 
> --8<---------------cut here---------------start------------->8---
> � "Compute the hash of FILE with ALGORITHM.� If NAR-SERIALIZER? is
> � #true, compute the combined hash (NAR hash) of FILE for which (SELECT?
> � FILE STAT) returns true.
> 
> � If NAR-SERIALIZER? is #false, compute the regular hash using the
> � default serializer.� It is meant to be used for a regular file.
> 
> � If NAR-SERIALIZER? is 'auto', when FILE is a directory, compute the
> � combined hash (NAR hash).� When FILE is a regular file, compute the
> � regular hash using the default serializer.� The option ’auto’ is meant
> � to apply by default the expected hash computation.
> 
> � Symbolic links are not dereferenced unless NAR-SERIALIZER? is false.
> 
> � This procedure must only be used under controlled circumstances; the
> � detection of symbolic links in FILE is racy.
> --8<---------------cut here---------------end--------------->8---
> 
> WDYT?

The nar hash / regular hash difference seems a very low-level detail to
me, that most (all?) users don't need to be bothered about. Except
maybe if FILE denotes an executable regular file, but file-hash* is
currently only used on tarballs/zip files/git checkouts, which aren't
executable files unless weirdness or some kind of attack is happening.

I think that, the ‘least astonishing’ thing to do here, is computing
the hash that would go into the 'hash' / 'sha256' field of 'origin'
objects by default, and not the nar hash for regular files that's
almost never used.

Greetings,
Maxime.

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYdWOrRccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7jgpAP9+O6ncyElAGv5aH/Ms7kJaCrgJ

hliVO7GJcnNP6aHGWwD+LmM5YbS1h9BcGt6hCRB5MNTZnJH6pa7Fitz6pzZuYwY=

=PyXl

-----END PGP SIGNATURE-----

zimoun wrote on 5 Jan 2022 13:58

Recipients:(name . Maxime Devos)(address . maximedevos@telenet.be)

Message-ID:86pmp6730h.fsf@gmail.com

Hi Maxime,

On Wed, 05 Jan 2022 at 12:27, Maxime Devos <maximedevos@telenet.be> wrote:

Toggle quote (7 lines)

> zimoun schreef op wo 05-01-2022 om 12:48 [+0100]:

>> Well, I think ’#:recursive?’ is confusing, and ’auto’ too because it is

>> not POLA for a plumbing function, IMHO.� [...]

> Principle of least authority, or principle of least astonishment?

> I presume the latter.

Latter. :-)

Toggle quote (5 lines)

>> Anyway. It is v4 and it is ready to merge. :-)

> I vote for a purple bikeshed! But your orange bikeshed would also keep

> the bikes out of the rain.

:-)

Toggle quote (30 lines)>> --8<---------------cut here---------------start------------->8---
>> � "Compute the hash of FILE with ALGORITHM.� If NAR-SERIALIZER? is
>> � #true, compute the combined hash (NAR hash) of FILE for which (SELECT?
>> � FILE STAT) returns true.
>> 
>> � If NAR-SERIALIZER? is #false, compute the regular hash using the
>> � default serializer.� It is meant to be used for a regular file.
>> 
>> � If NAR-SERIALIZER? is 'auto', when FILE is a directory, compute the
>> � combined hash (NAR hash).� When FILE is a regular file, compute the
>> � regular hash using the default serializer.� The option ’auto’ is meant
>> � to apply by default the expected hash computation.
>> 
>> � Symbolic links are not dereferenced unless NAR-SERIALIZER? is false.
>> 
>> � This procedure must only be used under controlled circumstances; the
>> � detection of symbolic links in FILE is racy.
>> --8<---------------cut here---------------end--------------->8---

> The nar hash / regular hash difference seems a very low-level detail to
> me, that most (all?) users don't need to be bothered about. Except
> maybe if FILE denotes an executable regular file, but file-hash* is
> currently only used on tarballs/zip files/git checkouts, which aren't
> executable files unless weirdness or some kind of attack is happening.
>
> I think that, the ‘least astonishing’ thing to do here, is computing
> the hash that would go into the 'hash' / 'sha256' field of 'origin'
> objects by default, and not the nar hash for regular files that's
> almost never used.

I do not understand what you mean here. ’file-hash*’ is a low-level

detail, no? Whatever. :-)

Well, I am sorry if my 3 naive comments are not convenient. Just, to be

sure, I am proposing:

1) It is v4 and ready, I guess. About ’auto’, I could have waken up

earlier. :-) And it can be still improved later as you are saying in

the other answer. So, we are done, right?

2) From my point of view, ’#:recursive?’ needs to be adapted in

agreement with the discussion [1], quoting Ludo:

Thinking more about it, I think confusion stems from the term

“recursive” (inherited from Nix) because, as you write, it

doesn’t necessarily have to do with recursion and directory

traversal.

Instead, it has to do with the serialization method.

1: http://issues.guix.gnu.org/issue/51307

And I do not have a strong opinion. Just a naive remark.

3) Whatever the keyword for the current v4 ’#:recursive?’ is picked, I

still find the current docstring wording unclear. In fact, reading

the code is more helpful. :-) I am just proposing a reword which

appears to me clearer than the current v4 one. Maybe, I am missing

the obvious. Or maybe this proposed rewording is not clearer. :-)

WDYT?

Cheers,

simon

Maxime Devos wrote on 5 Jan 2022 15:06

Recipients:(name . zimoun)(address . zimon.toutoune@gmail.com)

Message-ID:6fcbe52781b0678ea44db9beea2e1bd3f404b840.camel@telenet.be

zimoun schreef op wo 05-01-2022 om 13:58 [+0100]:

Toggle quote (34 lines)> [...]
> > > --8<---------------cut here---------------start------------->8---
> > > � "Compute the hash of FILE with ALGORITHM.� If NAR-SERIALIZER? is
> > > � #true, compute the combined hash (NAR hash) of FILE for which (SELECT?
> > > � FILE STAT) returns true.
> > > 
> > > � If NAR-SERIALIZER? is #false, compute the regular hash using the
> > > � default serializer.� It is meant to be used for a regular file.
> > > 
> > > � If NAR-SERIALIZER? is 'auto', when FILE is a directory, compute the
> > > � combined hash (NAR hash).� When FILE is a regular file, compute the
> > > � regular hash using the default serializer.� The option ’auto’ is meant
> > > � to apply by default the expected hash computation.
> > > 
> > > � Symbolic links are not dereferenced unless NAR-SERIALIZER? is false.
> > > 
> > > � This procedure must only be used under controlled circumstances; the
> > > � detection of symbolic links in FILE is racy.
> > > --8<---------------cut here---------------end--------------->8---
> 
> > The nar hash / regular hash difference seems a very low-level detail to
> > me, that most (all?) users don't need to be bothered about. Except
> > maybe if FILE denotes an executable regular file, but file-hash* is
> > currently only used on tarballs/zip files/git checkouts, which aren't
> > executable files unless weirdness or some kind of attack is happening.
> > 
> > I think that, the ‘least astonishing’ thing to do here, is computing
> > the hash that would go into the 'hash' / 'sha256' field of 'origin'
> > objects by default, and not the nar hash for regular files that's
> > almost never used.
> 
> I do not understand what you mean here.  ’file-hash*’ is a low-level
> detail, no?  Whatever. :-)

I don't see what it matters if 'file-hash*' is classified as low-level
or high-level. �But what I do care about, is how easy to use file-hash*
is.

A low-level argument like #:nar-hash? #true/#false would make file-
hash* much more complicated: this patch series uses file-hash* to
compute the hash for 'origin' records, and the documentation of
'origin' doesn't mention 'nar' anywhere and if I search for 'nar hash'
in the manual, I find zero results.

Instead, file-hash* talks about directories, regular files, recursion
and claims that the default value of #:recursive? usually does the
right thing, so I don't have to look up any complicated terminology
to figure out how to use file-hash* to compute hashes for 'origin'
records.

And in the rare situation where file-hash* doesn't do the right thing,
the documentation tells me I can set #:recursive? #true/#false.
 

Toggle quote (6 lines)

> Just, to be sure, I am proposing:

> �1) It is v4 and ready, I guess. About ’auto’, I could have waken up

> �earlier. :-) And it can be still improved later as you are saying in

> �the other answer. So, we are done, right?

I think so, yes, except for a docstring change I'll send as a v5.

I'm also out of bikeshed paint.

Anway, keep in mind that I'm not a committer.

Toggle quote (14 lines)> �2) From my point of view, ’#:recursive?’ needs to be adapted in
> �agreement with the discussion [1], quoting Ludo:
> 
> ��������Thinking more about it, I think confusion stems from the term
> ��������“recursive” (inherited from Nix) because, as you write, it
> ��������doesn’t necessarily have to do with recursion and directory
> ��������traversal.
> 
> ��������Instead, it has to do with the serialization method.
> 
> ��������1: <http://issues.guix.gnu.org/issue/51307>
> 
> ���And I do not have a strong opinion.  Just a naive remark.

I don't think the arguments for (guix scripts hash) apply directly

to (guix hash) -- (guix scripts hash) supports multiple serialisers:

* none (regular in (guix hash) terminology)

* git

* nar

* swh

so something like -S nar makes a lot of sense there. But (guix hash)

is only for computing the hash of something that would become a store

item after interning, more specifically is is currently only used for

computing the hash that would go into an (origin ...) object

(though I suppose it could be extended to support git/swh/... if

someone wants do that).

Possibly some name like

#:treat-it-as-a-directory-or-an-executable-file-or-a-symlink-and-

compute-the-alternative-hash-even-if-it-is-regular?

would be clearer and technically more accurate than #:recursive?, but

that's a bit of a mouthful.

Toggle quote (6 lines)

> �3) Whatever the keyword for the current v4 ’#:recursive?’ is picked, I

> ��still find the current docstring wording unclear. In fact, reading

> ��the code is more helpful. :-) I am just proposing a reword which

> ��appears to me clearer than the current v4 one. Maybe, I am missing

> ��the obvious. Or maybe this proposed rewording is not clearer. :-)

I've reworded it a bit; it falsely claimed that the nar hash was always
computed when recursive? is 'auto' (even if FILE is a regular file). It
also mentions executable files and SELECT? now.

Greetings,
Maxime.

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYdWl/xccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7kV8AP4wlEra0f9+TjAh5gilOW0+dpCi

A7JDyk0HGyq5KBHYqQD/YnmNTRMHePpYKxXaIUV/Z9WFmVuSkLO1RbgnAl7fcQk=

=JDQE

-----END PGP SIGNATURE-----

Maxime Devos wrote on 5 Jan 2022 15:07

[PATCH v5 1/4] guix hash: Extract file hashing procedures.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:20220105140750.18214-1-maximedevos@telenet.be

* guix/scripts/hash.scm (guix-hash)[vcs-file?] (nar-hash, default-hash):

Extract hashing logic to...

* guix/hash.scm (vcs-file?, file-hash*): ... these new procedures in this

new file.

Modified-by: Maxime Devos <maximedevos@telenet.be>

---

Makefile.am | 1 +

guix/hash.scm | 73 +++++++++++++++++++++++++++++++++++++++++++

guix/scripts/hash.scm | 22 +++----------

3 files changed, 78 insertions(+), 18 deletions(-)

create mode 100644 guix/hash.scm

Toggle diff (155 lines)diff --git a/Makefile.am b/Makefile.am
index 8c5682a1c6..bc3d0087d0 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -99,6 +99,7 @@ MODULES =					\
   guix/extracting-download.scm			\
   guix/git-download.scm				\
   guix/hg-download.scm				\
+  guix/hash.scm					\
   guix/swh.scm					\
   guix/monads.scm				\
   guix/monad-repl.scm				\
diff --git a/guix/hash.scm b/guix/hash.scm
new file mode 100644
index 0000000000..3cb68e5c44
--- /dev/null
+++ b/guix/hash.scm
@@ -0,0 +1,73 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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? 'auto)
+                     (select? (negate vcs-file?)))
+  "Compute the hash of FILE with ALGORITHM.
+
+Symbolic links are only dereferenced if RECURSIVE? is false.
+Directories are only supported if RECURSIVE? is #true or 'auto'.
+The executable bit is only recorded if RECURSIVE? is #true.
+If FILE is a symbolic link, it is only followed if RECURSIVE? is false.
+
+For regular files, there are two different hashes when the executable
+hash isn't recorded: the regular hash and the nar hash. In most situations,
+the regular hash is desired and setting RECURSIVE? to 'auto' does the right
+thing for both regular files and directories.
+
+This procedure must only be used under controlled circumstances;
+the detection of symbolic links in FILE is racy.
+
+When FILE is a directory, the procedure SELECT? called as (SELECT? FILE STAT)
+decides which files to include. By default, version control files are
+excluded. To include everything, SELECT? can be set to (const #true)."
+  (if (or (eq? recursive? #true)
+          (and (eq? recursive? 'auto)
+               ;; Don't change this to (eq? 'directory ...), because otherwise
+               ;; if 'file' denotes a symbolic link, the 'file-hash' below
+               ;; would dereference it -- dereferencing symbolic links would
+               ;; open an avoidable can of potential worms.
+               (not (eq? 'regular (stat:type (lstat file))))))
+      (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 d73e3d13dd..28d587b944 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +25,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)
@@ -46,20 +48,14 @@
 (define* (nar-hash file #:optional
                    (algorithm (assoc-ref %default-options 'hash-algorithm))
                    select?)
-  (let-values (((port get-hash)
-                (open-hash-port algorithm)))
-    (write-file file port #:select? select?)
-    (force-output port)
-    (get-hash)))
+  (file-hash* file #:algorithm algorithm #:select? select? #:recursive? #true))
 
 (define* (default-hash file #:optional
                        (algorithm (assoc-ref %default-options 'hash-algorithm))
                        select?)
   (match file
     ("-" (port-hash algorithm (current-input-port)))
-    (_
-     (call-with-input-file file
-       (cute port-hash algorithm <>)))))
+    (_ (file-hash* file #:algorithm algorithm #:recursive? #false))))
 
 (define* (git-hash file #:optional
                        (algorithm (assoc-ref %default-options 'hash-algorithm))
@@ -181,16 +177,6 @@ use '--serializer' instead~%"))
     (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)

base-commit: 9708681f1a9f221ae6cad64625ba8309b6742653
-- 
2.30.2

Maxime Devos wrote on 5 Jan 2022 15:07

[PATCH v5 3/4] refresh: Support non-tarball sources.

Recipients:(address . 50072@debbugs.gnu.org)(name . Sarah Morgensen)(address . iskarian@mgsn.dev)

Message-ID:20220105140750.18214-3-maximedevos@telenet.be

* 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(-)

Toggle diff (57 lines)diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 8806f0f740..68bb9040d8 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; 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...~%")
@@ -363,8 +364,7 @@ warn about packages that have no matching updater."
                       (info loc (G_ "~a: consider removing this propagated input: ~a~%")
                             name change-name))))
                  (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~%")
-- 
2.30.2

Maxime Devos wrote on 5 Jan 2022 15:07

[PATCH v5 4/4] upstream: Support updating and fetching 'git-fetch' origins.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:20220105140750.18214-4-maximedevos@telenet.be

From: Sarah Morgensen <iskarian@mgsn.dev>

Updaters need to be modified to return 'git-reference' objects.
This patch modifies the 'generic-git' and 'minetest' updater,
but others might need to be modified as well.

* guix/git.scm (git-reference->git-checkout): New procedure.
* guix/upstream.scm (package-update/git-fetch): New procedure.
  (<upstream-source>)[urls]: Document it can be a 'git-reference'.
  (%method-updates): Add 'git-fetch' mapping.
  (update-package-source): Support 'git-reference' sources.
  (upstream-source-compiler/url-fetch): Split off from ...
  (upstream-source-compiler): ... this, and call ...
  (upstream-source-compiler/git-fetch): ... this new procedure if the URL
  field contains a 'git-reference'.
* guix/import/git.scm
  (latest-git-tag-version): Always return two values and document that the tag
  is returned as well.
  (latest-git-release)[urls]: Use the 'git-reference' instead of the
  repository URL.
* guix/import/minetest.scm (latest-minetest-release)[urls]: Don't wrap the
  'git-reference' in a list.
* tests/minetest.scm (upstream-source->sexp): Adjust to new convention.

Co-authored-by: Maxime Devos <maximedevos@telenet.be>
---
 guix/git.scm             | 14 +++++++-
 guix/import/git.scm      | 22 +++++++-----
 guix/import/minetest.scm |  6 ++--
 guix/upstream.scm        | 73 ++++++++++++++++++++++++++++++++++++----
 tests/minetest.scm       |  7 ++--
 5 files changed, 98 insertions(+), 24 deletions(-)

Toggle diff (294 lines)diff --git a/guix/git.scm b/guix/git.scm
index dc2ca1be84..43e85a5026 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Kyle Meyer <kyle@kyleam.com>
 ;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,6 +34,8 @@
   #:use-module (guix utils)
   #:use-module (guix records)
   #:use-module (guix gexp)
+  #:autoload   (guix git-download)
+  (git-reference-url git-reference-commit git-reference-recursive?)
   #:use-module (guix sets)
   #:use-module ((guix diagnostics) #:select (leave warning))
   #:use-module (guix progress)
@@ -65,7 +68,9 @@
             git-checkout-url
             git-checkout-branch
             git-checkout-commit
-            git-checkout-recursive?))
+            git-checkout-recursive?
+
+            git-reference->git-checkout))
 
 (define %repository-cache-directory
   (make-parameter (string-append (cache-directory #:ensure? #f)
@@ -672,6 +677,13 @@ is true, limit to only refs/tags."
   (commit  git-checkout-commit (default #f))      ;#f | tag | commit
   (recursive? git-checkout-recursive? (default #f)))
 
+(define (git-reference->git-checkout reference)
+  "Convert the <git-reference> REFERENCE to an equivalent <git-checkout>."
+  (git-checkout
+   (url (git-reference-url reference))
+   (commit (git-reference-commit reference))
+   (recursive? (git-reference-recursive? reference))))
+
 (define* (latest-repository-commit* url #:key ref recursive? log-port)
   ;; Monadic variant of 'latest-repository-commit'.
   (lambda (store)
diff --git a/guix/import/git.scm b/guix/import/git.scm
index 1eb219f3fe..4cf404677c 100644
--- a/guix/import/git.scm
+++ b/guix/import/git.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -34,6 +35,7 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
   #:export (%generic-git-updater
 
             ;; For tests.
@@ -172,21 +174,21 @@ repository at URL."
          (values version tag)))))))
 
 (define (latest-git-tag-version package)
-  "Given a PACKAGE, return the latest version of it, or #f if the latest version
-could not be determined."
+  "Given a PACKAGE, return the latest version of it and the corresponding git
+tag, or #false and #false if the latest version could not be determined."
   (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
              (warning (or (package-field-location package 'source)
                           (package-location package))
                       (G_ "~a for ~a~%")
                       (condition-message c)
                       (package-name package))
-             #f)
+             (values #f #f))
             ((eq? (exception-kind c) 'git-error)
              (warning (or (package-field-location package 'source)
                           (package-location package))
                       (G_ "failed to fetch Git repository for ~a~%")
                       (package-name package))
-             #f))
+             (values #f #f)))
     (let* ((source (package-source package))
            (url (git-reference-url (origin-uri source)))
            (property (cute assq-ref (package-properties package) <>)))
@@ -208,14 +210,16 @@ could not be determined."
   "Return an <upstream-source> for the latest release of PACKAGE."
   (let* ((name (package-name package))
          (old-version (package-version package))
-         (url (git-reference-url (origin-uri (package-source package))))
-         (new-version (latest-git-tag-version package)))
-
-    (and new-version
+         (old-reference (origin-uri (package-source package)))
+         (new-version new-version-tag (latest-git-tag-version package)))
+    (and new-version new-version-tag
          (upstream-source
           (package name)
           (version new-version)
-          (urls (list url))))))
+          (urls (git-reference
+                 (url (git-reference-url old-reference))
+                 (commit new-version-tag)
+                 (recursive? (git-reference-recursive? old-reference))))))))
 
 (define %generic-git-updater
   (upstream-updater
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index a7bdbfebca..3b2cdcdcac 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -504,9 +504,9 @@ or #false if the latest release couldn't be determined."
        (upstream-source
         (package (package:package-name pkg))
         (version (release-version release))
-        (urls (list (download:git-reference
-                     (url (package-repository contentdb-package))
-                     (commit (release-commit release))))))))
+        (urls (download:git-reference
+               (url (package-repository contentdb-package))
+               (commit (release-commit release)))))))
 
 (define %minetest-updater
   (upstream-updater
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 632e9ebc4f..1fe996ef3d 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -2,6 +2,8 @@
 ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,12 +26,15 @@
   #: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)
   #:use-module (guix ui)
   #:use-module (guix base32)
   #:use-module (guix gexp)
+  #:autoload   (guix git) (latest-repository-commit git-reference->git-checkout)
+  #:use-module (guix hash)
   #:use-module (guix store)
   #:use-module ((guix derivations) #:select (built-derivations derivation->output-path))
   #:autoload   (gcrypt hash) (port-sha256)
@@ -93,7 +98,7 @@
   upstream-source?
   (package        upstream-source-package)        ;string
   (version        upstream-source-version)        ;string
-  (urls           upstream-source-urls)           ;list of strings
+  (urls           upstream-source-urls)           ;list of strings|git-reference
   (signature-urls upstream-source-signature-urls  ;#f | list of strings
                   (default #f))
   (input-changes  upstream-source-input-changes
@@ -357,10 +362,9 @@ values: 'interactive' (default), 'always', and 'never'."
                         data url)
                #f)))))))
 
-(define-gexp-compiler (upstream-source-compiler (source <upstream-source>)
-                                                system target)
-  "Download SOURCE from its first URL and lower it as a fixed-output
-derivation that would fetch it."
+(define (upstream-source-compiler/url-fetch source system)
+  "Lower SOURCE, an <upstream-source> pointing to a tarball, as a
+fixed-output derivation that would fetch it, and verify its authenticity."
   (mlet* %store-monad ((url -> (first (upstream-source-urls source)))
                        (signature
                         -> (and=> (upstream-source-signature-urls source)
@@ -378,6 +382,30 @@ derivation that would fetch it."
       (url-fetch url 'sha256 hash (store-path-package-name tarball)
                  #:system system))))
 
+(define (upstream-source-compiler/git-fetch source system)
+  "Lower SOURCE, an <upstream-source> using git, as a fixed-output
+derivation that would fetch it."
+  (mlet* %store-monad ((reference -> (upstream-source-urls source))
+                       (checkout
+                        (lower-object
+                         (git-reference->git-checkout reference)
+                         system)))
+    ;; Like in 'upstream-source-compiler/url-fetch', return a fixed-output
+    ;; derivation instead of CHECKOUT.
+    (git-fetch reference 'sha256
+               (file-hash* checkout #:recursive? #true #:select? (const #true))
+               (git-file-name (upstream-source-package source)
+                              (upstream-source-version source))
+               #:system system)))
+
+(define-gexp-compiler (upstream-source-compiler (source <upstream-source>)
+                                                system target)
+  "Download SOURCE, lower it as a fixed-output derivation that would fetch it,
+and verify its authenticity if possible."
+  (if (git-reference? (upstream-source-urls source))
+      (upstream-source-compiler/git-fetch source system)
+      (upstream-source-compiler/url-fetch source system)))
+
 (define (find2 pred lst1 lst2)
   "Like 'find', but operate on items from both LST1 and LST2.  Return two
 values: the item from LST1 and the item from LST2 that match PRED."
@@ -430,9 +458,24 @@ SOURCE, an <upstream-source>."
                                         #:key-download key-download)))
          (values version tarball source))))))
 
+(define* (package-update/git-fetch store package source #:key key-download)
+  "Return the version, checkout, and SOURCE, to update PACKAGE to
+SOURCE, an <upstream-source>."
+  ;; TODO: it would be nice to authenticate commits, e.g. with
+  ;; "guix git authenticate" or a list of permitted signing keys.
+  (define ref (upstream-source-urls source)) ; a <git-reference>
+  (values (upstream-source-version source)
+          (latest-repository-commit
+           store
+           (git-reference-url ref)
+           #:ref `(tag-or-commit . ,(git-reference-commit ref))
+           #:recursive? (git-reference-recursive? ref))
+          source))
+
 (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))
@@ -492,9 +535,22 @@ new version string if an update was made, and #f otherwise."
                              (origin-hash (package-source package))))
                (old-url     (match (origin-uri (package-source package))
                               ((? string? url) url)
+                              ((? git-reference? ref)
+                               (git-reference-url ref))
                               (_ #f)))
                (new-url     (match (upstream-source-urls source)
-                              ((first _ ...) first)))
+                              ((first _ ...) first)
+                              ((? git-reference? ref)
+                               (git-reference-url ref))
+                              (_ #f)))
+               (old-commit  (match (origin-uri (package-source package))
+                              ((? git-reference? ref)
+                               (git-reference-commit ref))
+                              (_ #f)))
+               (new-commit  (match (upstream-source-urls source)
+                              ((? git-reference? ref)
+                               (git-reference-commit ref))
+                              (_ #f)))
                (file        (and=> (location-file loc)
                                    (cut search-path %load-path <>))))
           (if file
@@ -508,6 +564,9 @@ new version string if an update was made, and #f otherwise."
                                            'filename file))
                     (replacements `((,old-version . ,version)
                                     (,old-hash . ,hash)
+                                    ,@(if (and old-commit new-commit)
+                                          `((,old-commit . ,new-commit))
+                                          '())
                                     ,@(if (and old-url new-url)
                                           `((,(dirname old-url) .
                                              ,(dirname new-url)))
diff --git a/tests/minetest.scm b/tests/minetest.scm
index 77b9aa928f..cbb9e83889 100644
--- a/tests/minetest.scm
+++ b/tests/minetest.scm
@@ -387,10 +387,9 @@ during a dynamic extent where that package is available on ContentDB."
 
 ;; Update detection
 (define (upstream-source->sexp upstream-source)
-  (define urls (upstream-source-urls upstream-source))
-  (unless (= 1 (length urls))
-    (error "only a single URL is expected"))
-  (define url (first urls))
+  (define url (upstream-source-urls upstream-source))
+  (unless (git-reference? url)
+    (error "a <git-reference> is expected"))
   `(,(upstream-source-package upstream-source)
     ,(upstream-source-version upstream-source)
     ,(git-reference-url url)
-- 
2.30.2

Maxime Devos wrote on 5 Jan 2022 15:07

[PATCH v5 2/4] import: Factorize file hashing.

Recipients:(address . 50072@debbugs.gnu.org)(name . Sarah Morgensen)(address . iskarian@mgsn.dev)

Message-ID:20220105140750.18214-2-maximedevos@telenet.be

From: Sarah Morgensen <iskarian@mgsn.dev>

* 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/minetest.scm (file-hash): Remove procedure.
  (make-minetest-sexp): Use 'file-hash*' instead.
---
 guix/import/cran.scm     | 32 +++-----------------------------
 guix/import/elpa.scm     | 29 +++++------------------------
 guix/import/go.scm       | 25 +++----------------------
 guix/import/minetest.scm | 19 ++++++++-----------
 4 files changed, 19 insertions(+), 86 deletions(-)

Toggle diff (256 lines)diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 1389576cad..b61402078d 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -35,10 +36,9 @@
   #:use-module (guix memoization)
   #:use-module (guix http-client)
   #:use-module (guix diagnostics)
+  #:use-module (guix hash)
   #:use-module (guix i18n)
-  #:use-module (gcrypt 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)
@@ -196,17 +196,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
@@ -464,16 +453,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."
@@ -571,12 +550,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 #:recursive? (or git? hg?)))))))
               ,@(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 edabb88b7a..c5167eacb5 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,10 +38,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)
@@ -229,27 +230,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."
@@ -271,7 +251,7 @@ RECIPE."
        (sha256
         (base32
          ,(bytevector->nix-base32-string
-           (file-hash directory (negate vcs-file?) #t)))))))
+           (file-hash* directory #:recursive? #true)))))))
 
 (define* (melpa-recipe->origin recipe)
   "Fetch origin details from the MELPA recipe and associated repository for
@@ -380,7 +360,8 @@ type '<elpa-package>'."
                         (sha256
                          (base32
                           ,(if tarball
-                               (bytevector->nix-base32-string (file-sha256 tarball))
+                               (bytevector->nix-base32-string
+                                (file-hash* tarball #:recursive? #false))
                                "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 26dbc34b63..c7673e6a1a 100644
--- a/guix/import/go.scm
+++ b/guix/import/go.scm
@@ -26,6 +26,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)
@@ -36,11 +37,10 @@
   #: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   (guix base32) (bytevector->nix-base32-string)
   #:autoload   (guix build utils) (mkdir-p)
+  #:autoload   (gcrypt hash) (hash-algorithm sha256)
   #:use-module (ice-9 match)
   #:use-module (ice-9 peg)
   #:use-module (ice-9 rdelim)
@@ -499,25 +499,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."
@@ -536,7 +517,7 @@ tag."
                   (update-cached-checkout url
                                           #:ref
                                           `(tag-or-commit . ,reference)))))
-    (file-hash checkout algorithm)))
+    (file-hash* checkout #:algorithm algorithm #:recursive? #true)))
 
 (define (vcs->origin vcs-type vcs-repo-url version)
   "Generate the `origin' block of a package depending on what type of source
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index abddd885ee..a7bdbfebca 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,6 +39,7 @@
   #:use-module (guix base32)
   #:use-module (guix git)
   #:use-module ((guix git-download) #:prefix download:)
+  #:use-module (guix hash)
   #:use-module (guix store)
   #:export (%default-sort-key
             %contentdb-api
@@ -286,14 +287,6 @@ results.  The return value is a list of <package-keys> records."
   (with-store store
     (latest-repository-commit store url #:ref ref)))
 
-;; XXX adapted from (guix scripts hash)
-(define (file-hash file)
-  "Compute the hash of FILE."
-  (let-values (((port get-hash) (open-sha256-port)))
-    (write-file file port)
-    (force-output port)
-    (get-hash)))
-
 (define (make-minetest-sexp author/name version repository commit
                             inputs home-page synopsis
                             description media-license license)
@@ -314,9 +307,13 @@ MEDIA-LICENSE and LICENSE."
            ;; The git commit is not always available.
            ,(and commit
                  (bytevector->nix-base32-string
-                  (file-hash
+                  (file-hash*
                    (download-git-repository repository
-                                            `(commit . ,commit)))))))
+                                            `(commit . ,commit))
+                   ;; 'download-git-repository' already filtered out the '.git'
+                   ;; directory.
+                   #:select? (const #true)
+                   #:recursive? #true)))))
          (file-name (git-file-name name version))))
      (build-system minetest-mod-build-system)
      ,@(maybe-propagated-inputs (map contentdb->package-name inputs))
-- 
2.30.2

zimoun wrote on 5 Jan 2022 16:08

Re: bug#50072: [PATCH WIP 0/4] Add upstream updater for git-fetch origins.

Recipients:(name . Maxime Devos)(address . maximedevos@telenet.be)

Message-ID:86h7ai6wzd.fsf@gmail.com

Hi Maxime,

On Wed, 05 Jan 2022 at 14:06, Maxime Devos <maximedevos@telenet.be> wrote:

Toggle quote (6 lines)

> A low-level argument like #:nar-hash? #true/#false would make file-

> hash* much more complicated: this patch series uses file-hash* to

> compute the hash for 'origin' records, and the documentation of

> 'origin' doesn't mention 'nar' anywhere and if I search for 'nar hash'

> in the manual, I find zero results.

I agree, it was my point #1. :-)

Toggle quote (6 lines)

> Instead, file-hash* talks about directories, regular files, recursion

> and claims that the default value of #:recursive? usually does the

> right thing, so I don't have to look up any complicated terminology

> to figure out how to use file-hash* to compute hashes for 'origin'

> records.

I also agree, it was my point #3. :-)

Toggle quote (3 lines)

> And in the rare situation where file-hash* doesn't do the right thing,

> the documentation tells me I can set #:recursive? #true/#false.

Yes.

Toggle quote (10 lines)>> Just, to be sure, I am proposing:
>> 
>> �1) It is v4 and ready, I guess.  About ’auto’, I could have waken up
>> �earlier. :-) And it can be still improved later as you are saying in
>> �the other answer.  So, we are done, right?
>
> I think so, yes, except for a docstring change I'll send as a v5.
> I'm also out of bikeshed paint.
> Anway, keep in mind that I'm not a committer.

I am not either. If I had this power, I would have already pushed your

v4 with the docstring reword. :-)

Toggle quote (3 lines)

>> �2) From my point of view, ’#:recursive?’ needs to be adapted in

>> �agreement with the discussion [1], quoting Ludo:

[...]

Toggle quote (2 lines)

>> ��And I do not have a strong opinion. Just a naive remark.

[...]

Toggle quote (6 lines)

> Possibly some name like

> #:treat-it-as-a-directory-or-an-executable-file-or-a-symlink-and-

> compute-the-alternative-hash-even-if-it-is-regular?

> would be clearer and technically more accurate than #:recursive?, but

> that's a bit of a mouthful.

I trust you, I do not have a strong opinion. I was just a naive remark.

Toggle quote (10 lines)>> �3) Whatever the keyword for the current v4 ’#:recursive?’ is picked, I
>> ��still find the current docstring wording unclear.  In fact, reading
>> ��the code is more helpful. :-) I am just proposing a reword which
>> ��appears to me clearer than the current v4 one.  Maybe, I am missing
>> ��the obvious.  Or maybe this proposed rewording is not clearer. :-)
>
> I've reworded it a bit; it falsely claimed that the nar hash was always
> computed when recursive? is 'auto' (even if FILE is a regular file). It
> also mentions executable files and SELECT? now.

Thank you for your patient work.

Cheers,

simon

Maxime Devos wrote on 5 Jan 2022 16:54

Recipients:(name . zimoun)(address . zimon.toutoune@gmail.com)

Message-ID:47fb7c8fe5c8106f96439f590b05e7ca21d20679.camel@telenet.be

zimoun schreef op wo 05-01-2022 om 16:08 [+0100]:

Toggle quote (3 lines)

> [...]

> Thank you for your patient work.

And thank you for double-checking things!

I'll drop a message on #guix that all appears to be ready for merging.

Greetings,

Maxime.

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYdW/LhccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7iDmAQD3i+fD+DnBtEdKaHFatvlx4cY6

fo6Gooifxi/a+fmyWAEAxp4fK7q3mwQmI37y2F26TFJijtdA/1gU8X7NXG3eIAE=

=vuuv

-----END PGP SIGNATURE-----

Maxime Devos wrote on 5 Jan 2022 16:56

[PATCH v5 1/4] guix hash: Extract file hashing procedures.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:20220105155637.20153-1-maximedevos@telenet.be

* guix/scripts/hash.scm (guix-hash)[vcs-file?] (nar-hash, default-hash):

Extract hashing logic to...

* guix/hash.scm (vcs-file?, file-hash*): ... these new procedures in this

new file.

Modified-by: Maxime Devos <maximedevos@telenet.be>

---

Makefile.am | 1 +

guix/hash.scm | 73 +++++++++++++++++++++++++++++++++++++++++++

guix/scripts/hash.scm | 22 +++----------

3 files changed, 78 insertions(+), 18 deletions(-)

create mode 100644 guix/hash.scm

Toggle diff (155 lines)diff --git a/Makefile.am b/Makefile.am
index 8c5682a1c6..bc3d0087d0 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -99,6 +99,7 @@ MODULES =					\
   guix/extracting-download.scm			\
   guix/git-download.scm				\
   guix/hg-download.scm				\
+  guix/hash.scm					\
   guix/swh.scm					\
   guix/monads.scm				\
   guix/monad-repl.scm				\
diff --git a/guix/hash.scm b/guix/hash.scm
new file mode 100644
index 0000000000..3cb68e5c44
--- /dev/null
+++ b/guix/hash.scm
@@ -0,0 +1,73 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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? 'auto)
+                     (select? (negate vcs-file?)))
+  "Compute the hash of FILE with ALGORITHM.
+
+Symbolic links are only dereferenced if RECURSIVE? is false.
+Directories are only supported if RECURSIVE? is #true or 'auto'.
+The executable bit is only recorded if RECURSIVE? is #true.
+If FILE is a symbolic link, it is only followed if RECURSIVE? is false.
+
+For regular files, there are two different hashes when the executable
+hash isn't recorded: the regular hash and the nar hash. In most situations,
+the regular hash is desired and setting RECURSIVE? to 'auto' does the right
+thing for both regular files and directories.
+
+This procedure must only be used under controlled circumstances;
+the detection of symbolic links in FILE is racy.
+
+When FILE is a directory, the procedure SELECT? called as (SELECT? FILE STAT)
+decides which files to include. By default, version control files are
+excluded. To include everything, SELECT? can be set to (const #true)."
+  (if (or (eq? recursive? #true)
+          (and (eq? recursive? 'auto)
+               ;; Don't change this to (eq? 'directory ...), because otherwise
+               ;; if 'file' denotes a symbolic link, the 'file-hash' below
+               ;; would dereference it -- dereferencing symbolic links would
+               ;; open an avoidable can of potential worms.
+               (not (eq? 'regular (stat:type (lstat file))))))
+      (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 d73e3d13dd..28d587b944 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +25,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)
@@ -46,20 +48,14 @@
 (define* (nar-hash file #:optional
                    (algorithm (assoc-ref %default-options 'hash-algorithm))
                    select?)
-  (let-values (((port get-hash)
-                (open-hash-port algorithm)))
-    (write-file file port #:select? select?)
-    (force-output port)
-    (get-hash)))
+  (file-hash* file #:algorithm algorithm #:select? select? #:recursive? #true))
 
 (define* (default-hash file #:optional
                        (algorithm (assoc-ref %default-options 'hash-algorithm))
                        select?)
   (match file
     ("-" (port-hash algorithm (current-input-port)))
-    (_
-     (call-with-input-file file
-       (cute port-hash algorithm <>)))))
+    (_ (file-hash* file #:algorithm algorithm #:recursive? #false))))
 
 (define* (git-hash file #:optional
                        (algorithm (assoc-ref %default-options 'hash-algorithm))
@@ -181,16 +177,6 @@ use '--serializer' instead~%"))
     (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)

base-commit: 9708681f1a9f221ae6cad64625ba8309b6742653
-- 
2.30.2

Maxime Devos wrote on 5 Jan 2022 16:56

[PATCH v5 3/4] refresh: Support non-tarball sources.

Recipients:(address . 50072@debbugs.gnu.org)(name . Sarah Morgensen)(address . iskarian@mgsn.dev)

Message-ID:20220105155637.20153-3-maximedevos@telenet.be

* 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(-)

Toggle diff (57 lines)diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 8806f0f740..68bb9040d8 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; 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...~%")
@@ -363,8 +364,7 @@ warn about packages that have no matching updater."
                       (info loc (G_ "~a: consider removing this propagated input: ~a~%")
                             name change-name))))
                  (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~%")
-- 
2.30.2

Maxime Devos wrote on 5 Jan 2022 16:56

[PATCH v5 2/4] import: Factorize file hashing.

Recipients:(address . 50072@debbugs.gnu.org)(name . Sarah Morgensen)(address . iskarian@mgsn.dev)

Message-ID:20220105155637.20153-2-maximedevos@telenet.be

From: Sarah Morgensen <iskarian@mgsn.dev>

* 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/minetest.scm (file-hash): Remove procedure.
  (make-minetest-sexp): Use 'file-hash*' instead.
---
 guix/import/cran.scm     | 32 +++-----------------------------
 guix/import/elpa.scm     | 29 +++++------------------------
 guix/import/go.scm       | 25 +++----------------------
 guix/import/minetest.scm | 19 ++++++++-----------
 4 files changed, 19 insertions(+), 86 deletions(-)

Toggle diff (256 lines)diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 1389576cad..b61402078d 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -35,10 +36,9 @@
   #:use-module (guix memoization)
   #:use-module (guix http-client)
   #:use-module (guix diagnostics)
+  #:use-module (guix hash)
   #:use-module (guix i18n)
-  #:use-module (gcrypt 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)
@@ -196,17 +196,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
@@ -464,16 +453,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."
@@ -571,12 +550,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 #:recursive? (or git? hg?)))))))
               ,@(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 edabb88b7a..c5167eacb5 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,10 +38,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)
@@ -229,27 +230,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."
@@ -271,7 +251,7 @@ RECIPE."
        (sha256
         (base32
          ,(bytevector->nix-base32-string
-           (file-hash directory (negate vcs-file?) #t)))))))
+           (file-hash* directory #:recursive? #true)))))))
 
 (define* (melpa-recipe->origin recipe)
   "Fetch origin details from the MELPA recipe and associated repository for
@@ -380,7 +360,8 @@ type '<elpa-package>'."
                         (sha256
                          (base32
                           ,(if tarball
-                               (bytevector->nix-base32-string (file-sha256 tarball))
+                               (bytevector->nix-base32-string
+                                (file-hash* tarball #:recursive? #false))
                                "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 26dbc34b63..c7673e6a1a 100644
--- a/guix/import/go.scm
+++ b/guix/import/go.scm
@@ -26,6 +26,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)
@@ -36,11 +37,10 @@
   #: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   (guix base32) (bytevector->nix-base32-string)
   #:autoload   (guix build utils) (mkdir-p)
+  #:autoload   (gcrypt hash) (hash-algorithm sha256)
   #:use-module (ice-9 match)
   #:use-module (ice-9 peg)
   #:use-module (ice-9 rdelim)
@@ -499,25 +499,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."
@@ -536,7 +517,7 @@ tag."
                   (update-cached-checkout url
                                           #:ref
                                           `(tag-or-commit . ,reference)))))
-    (file-hash checkout algorithm)))
+    (file-hash* checkout #:algorithm algorithm #:recursive? #true)))
 
 (define (vcs->origin vcs-type vcs-repo-url version)
   "Generate the `origin' block of a package depending on what type of source
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index abddd885ee..a7bdbfebca 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,6 +39,7 @@
   #:use-module (guix base32)
   #:use-module (guix git)
   #:use-module ((guix git-download) #:prefix download:)
+  #:use-module (guix hash)
   #:use-module (guix store)
   #:export (%default-sort-key
             %contentdb-api
@@ -286,14 +287,6 @@ results.  The return value is a list of <package-keys> records."
   (with-store store
     (latest-repository-commit store url #:ref ref)))
 
-;; XXX adapted from (guix scripts hash)
-(define (file-hash file)
-  "Compute the hash of FILE."
-  (let-values (((port get-hash) (open-sha256-port)))
-    (write-file file port)
-    (force-output port)
-    (get-hash)))
-
 (define (make-minetest-sexp author/name version repository commit
                             inputs home-page synopsis
                             description media-license license)
@@ -314,9 +307,13 @@ MEDIA-LICENSE and LICENSE."
            ;; The git commit is not always available.
            ,(and commit
                  (bytevector->nix-base32-string
-                  (file-hash
+                  (file-hash*
                    (download-git-repository repository
-                                            `(commit . ,commit)))))))
+                                            `(commit . ,commit))
+                   ;; 'download-git-repository' already filtered out the '.git'
+                   ;; directory.
+                   #:select? (const #true)
+                   #:recursive? #true)))))
          (file-name (git-file-name name version))))
      (build-system minetest-mod-build-system)
      ,@(maybe-propagated-inputs (map contentdb->package-name inputs))
-- 
2.30.2

Maxime Devos wrote on 5 Jan 2022 16:56

[PATCH v5 4/4] upstream: Support updating and fetching 'git-fetch' origins.

Recipients:(address . 50072@debbugs.gnu.org)

Message-ID:20220105155637.20153-4-maximedevos@telenet.be

From: Sarah Morgensen <iskarian@mgsn.dev>

Updaters need to be modified to return 'git-reference' objects.
This patch modifies the 'generic-git' and 'minetest' updater,
but others might need to be modified as well.

* guix/git.scm (git-reference->git-checkout): New procedure.
* guix/upstream.scm (package-update/git-fetch): New procedure.
  (<upstream-source>)[urls]: Document it can be a 'git-reference'.
  (%method-updates): Add 'git-fetch' mapping.
  (update-package-source): Support 'git-reference' sources.
  (upstream-source-compiler/url-fetch): Split off from ...
  (upstream-source-compiler): ... this, and call ...
  (upstream-source-compiler/git-fetch): ... this new procedure if the URL
  field contains a 'git-reference'.
* guix/import/git.scm
  (latest-git-tag-version): Always return two values and document that the tag
  is returned as well.
  (latest-git-release)[urls]: Use the 'git-reference' instead of the
  repository URL.
* guix/import/minetest.scm (latest-minetest-release)[urls]: Don't wrap the
  'git-reference' in a list.
* tests/minetest.scm (upstream-source->sexp): Adjust to new convention.

Co-authored-by: Maxime Devos <maximedevos@telenet.be>
---
 guix/git.scm             | 14 +++++++-
 guix/import/git.scm      | 22 +++++++-----
 guix/import/minetest.scm |  6 ++--
 guix/upstream.scm        | 73 ++++++++++++++++++++++++++++++++++++----
 tests/minetest.scm       |  7 ++--
 5 files changed, 98 insertions(+), 24 deletions(-)

Toggle diff (294 lines)diff --git a/guix/git.scm b/guix/git.scm
index dc2ca1be84..43e85a5026 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Kyle Meyer <kyle@kyleam.com>
 ;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,6 +34,8 @@
   #:use-module (guix utils)
   #:use-module (guix records)
   #:use-module (guix gexp)
+  #:autoload   (guix git-download)
+  (git-reference-url git-reference-commit git-reference-recursive?)
   #:use-module (guix sets)
   #:use-module ((guix diagnostics) #:select (leave warning))
   #:use-module (guix progress)
@@ -65,7 +68,9 @@
             git-checkout-url
             git-checkout-branch
             git-checkout-commit
-            git-checkout-recursive?))
+            git-checkout-recursive?
+
+            git-reference->git-checkout))
 
 (define %repository-cache-directory
   (make-parameter (string-append (cache-directory #:ensure? #f)
@@ -672,6 +677,13 @@ is true, limit to only refs/tags."
   (commit  git-checkout-commit (default #f))      ;#f | tag | commit
   (recursive? git-checkout-recursive? (default #f)))
 
+(define (git-reference->git-checkout reference)
+  "Convert the <git-reference> REFERENCE to an equivalent <git-checkout>."
+  (git-checkout
+   (url (git-reference-url reference))
+   (commit (git-reference-commit reference))
+   (recursive? (git-reference-recursive? reference))))
+
 (define* (latest-repository-commit* url #:key ref recursive? log-port)
   ;; Monadic variant of 'latest-repository-commit'.
   (lambda (store)
diff --git a/guix/import/git.scm b/guix/import/git.scm
index 1eb219f3fe..4cf404677c 100644
--- a/guix/import/git.scm
+++ b/guix/import/git.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -34,6 +35,7 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
   #:export (%generic-git-updater
 
             ;; For tests.
@@ -172,21 +174,21 @@ repository at URL."
          (values version tag)))))))
 
 (define (latest-git-tag-version package)
-  "Given a PACKAGE, return the latest version of it, or #f if the latest version
-could not be determined."
+  "Given a PACKAGE, return the latest version of it and the corresponding git
+tag, or #false and #false if the latest version could not be determined."
   (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
              (warning (or (package-field-location package 'source)
                           (package-location package))
                       (G_ "~a for ~a~%")
                       (condition-message c)
                       (package-name package))
-             #f)
+             (values #f #f))
             ((eq? (exception-kind c) 'git-error)
              (warning (or (package-field-location package 'source)
                           (package-location package))
                       (G_ "failed to fetch Git repository for ~a~%")
                       (package-name package))
-             #f))
+             (values #f #f)))
     (let* ((source (package-source package))
            (url (git-reference-url (origin-uri source)))
            (property (cute assq-ref (package-properties package) <>)))
@@ -208,14 +210,16 @@ could not be determined."
   "Return an <upstream-source> for the latest release of PACKAGE."
   (let* ((name (package-name package))
          (old-version (package-version package))
-         (url (git-reference-url (origin-uri (package-source package))))
-         (new-version (latest-git-tag-version package)))
-
-    (and new-version
+         (old-reference (origin-uri (package-source package)))
+         (new-version new-version-tag (latest-git-tag-version package)))
+    (and new-version new-version-tag
          (upstream-source
           (package name)
           (version new-version)
-          (urls (list url))))))
+          (urls (git-reference
+                 (url (git-reference-url old-reference))
+                 (commit new-version-tag)
+                 (recursive? (git-reference-recursive? old-reference))))))))
 
 (define %generic-git-updater
   (upstream-updater
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index a7bdbfebca..3b2cdcdcac 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -504,9 +504,9 @@ or #false if the latest release couldn't be determined."
        (upstream-source
         (package (package:package-name pkg))
         (version (release-version release))
-        (urls (list (download:git-reference
-                     (url (package-repository contentdb-package))
-                     (commit (release-commit release))))))))
+        (urls (download:git-reference
+               (url (package-repository contentdb-package))
+               (commit (release-commit release)))))))
 
 (define %minetest-updater
   (upstream-updater
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 632e9ebc4f..1fe996ef3d 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -2,6 +2,8 @@
 ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,12 +26,15 @@
   #: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)
   #:use-module (guix ui)
   #:use-module (guix base32)
   #:use-module (guix gexp)
+  #:autoload   (guix git) (latest-repository-commit git-reference->git-checkout)
+  #:use-module (guix hash)
   #:use-module (guix store)
   #:use-module ((guix derivations) #:select (built-derivations derivation->output-path))
   #:autoload   (gcrypt hash) (port-sha256)
@@ -93,7 +98,7 @@
   upstream-source?
   (package        upstream-source-package)        ;string
   (version        upstream-source-version)        ;string
-  (urls           upstream-source-urls)           ;list of strings
+  (urls           upstream-source-urls)           ;list of strings|git-reference
   (signature-urls upstream-source-signature-urls  ;#f | list of strings
                   (default #f))
   (input-changes  upstream-source-input-changes
@@ -357,10 +362,9 @@ values: 'interactive' (default), 'always', and 'never'."
                         data url)
                #f)))))))
 
-(define-gexp-compiler (upstream-source-compiler (source <upstream-source>)
-                                                system target)
-  "Download SOURCE from its first URL and lower it as a fixed-output
-derivation that would fetch it."
+(define (upstream-source-compiler/url-fetch source system)
+  "Lower SOURCE, an <upstream-source> pointing to a tarball, as a
+fixed-output derivation that would fetch it, and verify its authenticity."
   (mlet* %store-monad ((url -> (first (upstream-source-urls source)))
                        (signature
                         -> (and=> (upstream-source-signature-urls source)
@@ -378,6 +382,30 @@ derivation that would fetch it."
       (url-fetch url 'sha256 hash (store-path-package-name tarball)
                  #:system system))))
 
+(define (upstream-source-compiler/git-fetch source system)
+  "Lower SOURCE, an <upstream-source> using git, as a fixed-output
+derivation that would fetch it."
+  (mlet* %store-monad ((reference -> (upstream-source-urls source))
+                       (checkout
+                        (lower-object
+                         (git-reference->git-checkout reference)
+                         system)))
+    ;; Like in 'upstream-source-compiler/url-fetch', return a fixed-output
+    ;; derivation instead of CHECKOUT.
+    (git-fetch reference 'sha256
+               (file-hash* checkout #:recursive? #true #:select? (const #true))
+               (git-file-name (upstream-source-package source)
+                              (upstream-source-version source))
+               #:system system)))
+
+(define-gexp-compiler (upstream-source-compiler (source <upstream-source>)
+                                                system target)
+  "Download SOURCE, lower it as a fixed-output derivation that would fetch it,
+and verify its authenticity if possible."
+  (if (git-reference? (upstream-source-urls source))
+      (upstream-source-compiler/git-fetch source system)
+      (upstream-source-compiler/url-fetch source system)))
+
 (define (find2 pred lst1 lst2)
   "Like 'find', but operate on items from both LST1 and LST2.  Return two
 values: the item from LST1 and the item from LST2 that match PRED."
@@ -430,9 +458,24 @@ SOURCE, an <upstream-source>."
                                         #:key-download key-download)))
          (values version tarball source))))))
 
+(define* (package-update/git-fetch store package source #:key key-download)
+  "Return the version, checkout, and SOURCE, to update PACKAGE to
+SOURCE, an <upstream-source>."
+  ;; TODO: it would be nice to authenticate commits, e.g. with
+  ;; "guix git authenticate" or a list of permitted signing keys.
+  (define ref (upstream-source-urls source)) ; a <git-reference>
+  (values (upstream-source-version source)
+          (latest-repository-commit
+           store
+           (git-reference-url ref)
+           #:ref `(tag-or-commit . ,(git-reference-commit ref))
+           #:recursive? (git-reference-recursive? ref))
+          source))
+
 (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))
@@ -492,9 +535,22 @@ new version string if an update was made, and #f otherwise."
                              (origin-hash (package-source package))))
                (old-url     (match (origin-uri (package-source package))
                               ((? string? url) url)
+                              ((? git-reference? ref)
+                               (git-reference-url ref))
                               (_ #f)))
                (new-url     (match (upstream-source-urls source)
-                              ((first _ ...) first)))
+                              ((first _ ...) first)
+                              ((? git-reference? ref)
+                               (git-reference-url ref))
+                              (_ #f)))
+               (old-commit  (match (origin-uri (package-source package))
+                              ((? git-reference? ref)
+                               (git-reference-commit ref))
+                              (_ #f)))
+               (new-commit  (match (upstream-source-urls source)
+                              ((? git-reference? ref)
+                               (git-reference-commit ref))
+                              (_ #f)))
                (file        (and=> (location-file loc)
                                    (cut search-path %load-path <>))))
           (if file
@@ -508,6 +564,9 @@ new version string if an update was made, and #f otherwise."
                                            'filename file))
                     (replacements `((,old-version . ,version)
                                     (,old-hash . ,hash)
+                                    ,@(if (and old-commit new-commit)
+                                          `((,old-commit . ,new-commit))
+                                          '())
                                     ,@(if (and old-url new-url)
                                           `((,(dirname old-url) .
                                              ,(dirname new-url)))
diff --git a/tests/minetest.scm b/tests/minetest.scm
index 77b9aa928f..cbb9e83889 100644
--- a/tests/minetest.scm
+++ b/tests/minetest.scm
@@ -387,10 +387,9 @@ during a dynamic extent where that package is available on ContentDB."
 
 ;; Update detection
 (define (upstream-source->sexp upstream-source)
-  (define urls (upstream-source-urls upstream-source))
-  (unless (= 1 (length urls))
-    (error "only a single URL is expected"))
-  (define url (first urls))
+  (define url (upstream-source-urls upstream-source))
+  (unless (git-reference? url)
+    (error "a <git-reference> is expected"))
   `(,(upstream-source-package upstream-source)
     ,(upstream-source-version upstream-source)
     ,(git-reference-url url)
-- 
2.30.2

zimoun wrote on 5 Jan 2022 16:57

Re: [bug#50072] [PATCH v5 1/4] guix hash: Extract file hashing procedures.

Recipients:

Message-ID:86bl0q6uq2.fsf@gmail.com

Hi Maxime

Thanks for all the work.

All the series LGTM!

Cheers,

simon

Ludovic Courtès wrote on 6 Jan 2022 11:06

Re: bug#50072: [PATCH WIP 0/4] Add upstream updater for git-fetch origins.

Recipients:(name . Maxime Devos)(address . maximedevos@telenet.be)

Message-ID:87mtk9faaq.fsf_-_@gnu.org

Hi,

Maxime Devos <maximedevos@telenet.be> skribis:

Toggle quote (5 lines)

> 'auto' is indeed a little ambigious, so I adjusted most calls to

> file-hash* to set #:recursive? #true/#false appropriately in�v3.

> But in this particular case (guix/scripts/refresh.scm), it not known in

> advance, so some guesswork is necessary.

We could move guesswork at the call site. No big deal IMO, though.

Toggle quote (4 lines)

> Anyway, these calls to file-hash* are bothering me a little: can't

> we just record the hash in the 'upstream-source' record or ask the

> daemon for the hash of a store item (*) or something?

<upstream-source> represents available source that has usually not been

downloaded yet (that’s what happens when running ‘guix refresh’ without

‘-u’), so it cannot contain the hash.

Toggle quote (3 lines)

> That would complicate this patch series more, so I'd prefer to delay

> that for a future patch series.

Yes, this series LGTM as-is, but let’s keep these improvements in mind.

Ludo’.

Ludovic Courtès wrote on 6 Jan 2022 11:13

Recipients:(name . Maxime Devos)(address . maximedevos@telenet.be)

Message-ID:87h7ahf9ym.fsf_-_@gnu.org

Maxime Devos <maximedevos@telenet.be> skribis:

Toggle quote (2 lines)

> zimoun schreef op wo 05-01-2022 om 13:58 [+0100]:

[...]

Toggle quote (22 lines)>> �2) From my point of view, ’#:recursive?’ needs to be adapted in
>> �agreement with the discussion [1], quoting Ludo:
>> 
>> ��������Thinking more about it, I think confusion stems from the term
>> ��������“recursive” (inherited from Nix) because, as you write, it
>> ��������doesn’t necessarily have to do with recursion and directory
>> ��������traversal.
>> 
>> ��������Instead, it has to do with the serialization method.
>> 
>> ��������1: <http://issues.guix.gnu.org/issue/51307>
>> 
>> ���And I do not have a strong opinion.  Just a naive remark.
>
> I don't think the arguments for (guix scripts hash) apply directly
> to (guix hash) -- (guix scripts hash) supports multiple serialisers:
>
>  * none (regular in (guix hash) terminology)
>  * git
>  * nar
>  * swh

I think IWBN eventually for ‘file-hash*’ to have a #:serializer

argument. (guix scripts hash) would then become a thin layer above

(guix hash).

That #:serializer would have a default value, probably “none”, but no

“auto-detection” as this amount of guessing would make for a fragile

interface IMO.

(Perhaps ‘file-hash’ is too generic-sounding; for a ‘source-code-hash’

or similarly-named procedure, some defaults and guesswork would be more

obvious.)

Thanks,

Ludo’.

Ludovic Courtès wrote on 6 Jan 2022 11:20

Recipients:(name . Maxime Devos)(address . maximedevos@telenet.be)

Message-ID:87bl0pf9mz.fsf_-_@gnu.org

Applied v5 of this patch series, thanks a lot Sarah, Maxime, and zimoun!

\o/

One thing we should eventually address IMO is how the <upstream-source>

abstraction could be made to better model both tarballs and checkouts:

https://issues.guix.gnu.org/50072#29

Ludo’.

Closed

Maxime Devos wrote on 6 Jan 2022 11:32

Recipients:(name . Ludovic Courtès)(address . ludo@gnu.org)

Message-ID:0b4a85a3bac9ea2df6baf3e5c6d182e497724817.camel@telenet.be

Ludovic Courtès schreef op do 06-01-2022 om 11:13 [+0100]:

Toggle quote (4 lines)

> That #:serializer would have a default value, probably “none”, but no

> “auto-detection” as this amount of guessing would make for a fragile

> interface IMO.

The auto-detection could be put into a separate procedure

(define (guess-nar-or-none-serializer file) ; to be renamed

(if directory?

'nar

'none))

so that 'file-hash*' is not fragile, but auto-detection can still

happen if explicitely asked for:

(file-hash* file #:serializer (guess-nar-or-serializer file))

WDYT?

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYdbFIBccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7kiIAPsH/S+Ni1aPpMMje0cTGQdeWyco

Tsrh2i4drZcCMearewEAogGNLfkbLX3ngYyA2N0qWIgafgn4hwl1emOU36KBBQo=

=E+Ak

-----END PGP SIGNATURE-----

zimoun wrote on 6 Jan 2022 12:19

Recipients:

Message-ID:86h7ah5cy2.fsf@gmail.com

Hi,

On Thu, 06 Jan 2022 at 11:13, Ludovic Courtès <ludo@gnu.org> wrote:

Toggle quote (8 lines)

> I think IWBN eventually for ‘file-hash*’ to have a #:serializer

> argument. (guix scripts hash) would then become a thin layer above

> (guix hash).

> That #:serializer would have a default value, probably “none”, but no

> “auto-detection” as this amount of guessing would make for a fragile

> interface IMO.

It was my idea behind when I proposed to rename #:recursive? to
#:nar-serializer?. ;-) The name #:nar-serializer? was somehow an
intermediary step since the patch was already ready and, as Maxime
explained, the change for #:serializer was implying another round for
adjusting and v4/v5 was already enough effort put in. :-)

Anyway, the patch is ready (probably already pushed \o/ :-)).  Nothing
prevent us (me?) to propose later a patch for this adjustment. ;-)

Cheers,
simon

Maxime Devos wrote on 6 Jan 2022 15:12

Recipients:(name . Ludovic Courtès)(address . ludo@gnu.org)

Message-ID:7c90d6fcd2ad81706f59a48437c0be46bb4e8428.camel@telenet.be

Ludovic Courtès schreef op do 06-01-2022 om 11:20 [+0100]:

Toggle quote (4 lines)

> Applied v5 of this patch series, thanks a lot Sarah, Maxime, and zimoun!

> \o/

I'm not seeing it in the git repo and after a "guix pull" I still have

$ guix refresh -u minetest-advtrains

gnu/packages/minetest.scm:652:2: fout: cannot download for this method:

#<procedure git-fetch (ref hash-algo hash #:optional name #:key system

guile git)>

Has it been pushed?

Greetings,

Maxime.

-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYdb4zBccbWF4aW1lZGV2

b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7p8ZAP4u/wIsH77Wd3Wt1tqua6yo6M4O

l/1vvO3abIVVmGuMLgD9FX5NV4YdVKdHTjFojVWOfAGBOSIVWu7rVSA0AkqavQw=

=iGcP

-----END PGP SIGNATURE-----

Your comment

This issue is archived.

To comment on this conversation send an email to 50072@debbugs.gnu.org

is:open	open issues
is:done	closed issues
submitter:<who>	search issue submitter
author:<who>	search by message author
date:yesterday..now	search by issue date
mdate:3m..2d	search by message date