* [bug#50072] [PATCH WIP 1/4] guix hash: Extract file hashing procedures.
2021-08-15 23:16 [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins Sarah Morgensen
@ 2021-08-15 23:25 ` Sarah Morgensen
2021-08-15 23:25 ` [bug#50072] [PATCH WIP 2/4] import: Factorize file hashing Sarah Morgensen
` (8 subsequent siblings)
9 siblings, 0 replies; 66+ messages in thread
From: Sarah Morgensen @ 2021-08-15 23:25 UTC (permalink / raw)
To: 50072
* guix/scripts/hash.scm (guix-hash)[vcs-file?, file-hash]: Extract logic
to...
* guix/hash.scm: ...here. New file.
---
guix/hash.scm | 51 +++++++++++++++++++++++++++++++++++++++++++
guix/scripts/hash.scm | 29 ++++++------------------
2 files changed, 58 insertions(+), 22 deletions(-)
create mode 100644 guix/hash.scm
diff --git a/guix/hash.scm b/guix/hash.scm
new file mode 100644
index 0000000000..8c2ab8187f
--- /dev/null
+++ b/guix/hash.scm
@@ -0,0 +1,51 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Sarah Morgensen <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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH WIP 2/4] import: Factorize file hashing.
2021-08-15 23:16 [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins Sarah Morgensen
2021-08-15 23:25 ` [bug#50072] [PATCH WIP 1/4] guix hash: Extract file hashing procedures Sarah Morgensen
@ 2021-08-15 23:25 ` Sarah Morgensen
2021-08-15 23:25 ` [bug#50072] [PATCH WIP 3/4] refresh: Support non-tarball sources Sarah Morgensen
` (7 subsequent siblings)
9 siblings, 0 replies; 66+ messages in thread
From: Sarah Morgensen @ 2021-08-15 23:25 UTC (permalink / raw)
To: 50072
* guix/import/cran.scm (vcs-file?, file-hash): Remove procedures.
(description->package): Use 'file-hash*' instead.
* guix/import/elpa.scm (vcs-file?, file-hash): Remove procedures.
(git-repository->origin, elpa-package->sexp): Use 'file-hash* instead'.
* guix/import/go.scm (vcs-file?, file-hash): Remove procedures.
(git-checkout-hash): Use 'file-hash*' instead.
---
guix/import/cran.scm | 32 +++-----------------------------
guix/import/elpa.scm | 28 ++++------------------------
guix/import/go.scm | 26 +++-----------------------
3 files changed, 10 insertions(+), 76 deletions(-)
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index f649928c5a..ac24bc117e 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH WIP 3/4] refresh: Support non-tarball sources.
2021-08-15 23:16 [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins Sarah Morgensen
2021-08-15 23:25 ` [bug#50072] [PATCH WIP 1/4] guix hash: Extract file hashing procedures Sarah Morgensen
2021-08-15 23:25 ` [bug#50072] [PATCH WIP 2/4] import: Factorize file hashing Sarah Morgensen
@ 2021-08-15 23:25 ` Sarah Morgensen
2021-08-15 23:25 ` [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins Sarah Morgensen
` (6 subsequent siblings)
9 siblings, 0 replies; 66+ messages in thread
From: Sarah Morgensen @ 2021-08-15 23:25 UTC (permalink / raw)
To: 50072
* guix/scripts/refresh.scm (update-package): Use 'file-hash*' instead of
'port-sha256'. Rename TARBALL to OUTPUT.
---
guix/scripts/refresh.scm | 10 +++++-----
1 file changed, 5 insertions(+), 5 deletions(-)
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index fb6c52a567..abb0c24e96 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -8,6 +8,7 @@
;;; Copyright © 2018 Efraim Flashner <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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins.
2021-08-15 23:16 [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins Sarah Morgensen
` (2 preceding siblings ...)
2021-08-15 23:25 ` [bug#50072] [PATCH WIP 3/4] refresh: Support non-tarball sources Sarah Morgensen
@ 2021-08-15 23:25 ` Sarah Morgensen
2021-08-16 10:46 ` Maxime Devos
2021-09-06 10:27 ` [bug#50072] [PATCH WIP 0/4] Add upstream updater for " Ludovic Courtès
2022-01-01 17:35 ` Maxime Devos
` (5 subsequent siblings)
9 siblings, 2 replies; 66+ messages in thread
From: Sarah Morgensen @ 2021-08-15 23:25 UTC (permalink / raw)
To: 50072
* guix/git-download.scm (checkout-to-store): New procedure.
* guix/upstream.scm (guess-version-transform)
(package-update/git-fetch): New procedures.
(%method-updates): Add GIT-FETCH mapping.
---
guix/git-download.scm | 18 +++++++++++++++++-
guix/upstream.scm | 41 ++++++++++++++++++++++++++++++++++++++++-
2 files changed, 57 insertions(+), 2 deletions(-)
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 5e624b9ae9..a7bdc16718 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2017 Mathieu Lirzin <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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins.
2021-08-15 23:25 ` [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins Sarah Morgensen
@ 2021-08-16 10:46 ` Maxime Devos
2021-08-16 13:02 ` Xinglu Chen
` (2 more replies)
2021-09-06 10:27 ` [bug#50072] [PATCH WIP 0/4] Add upstream updater for " Ludovic Courtès
1 sibling, 3 replies; 66+ messages in thread
From: Maxime Devos @ 2021-08-16 10:46 UTC (permalink / raw)
To: Sarah Morgensen, 50072
[-- Attachment #1.1: Type: text/plain, Size: 1177 bytes --]
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)))
[...])))
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 #1.2: git-fetch.patch --]
[-- Type: text/x-patch, Size: 9277 bytes --]
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)))))))
+
+(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)
(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))))))
+(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)))
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins.
2021-08-16 10:46 ` Maxime Devos
@ 2021-08-16 13:02 ` Xinglu Chen
2021-08-16 18:15 ` Maxime Devos
2021-08-16 19:56 ` [bug#50072] [PATCH WIP 0/4] Add upstream updater for " Sarah Morgensen
2021-09-07 1:16 ` [bug#50072] [PATCH WIP 4/4] upstream: Support updating " Sarah Morgensen
2 siblings, 1 reply; 66+ messages in thread
From: Xinglu Chen @ 2021-08-16 13:02 UTC (permalink / raw)
To: Maxime Devos, Sarah Morgensen, 50072
[-- Attachment #1: Type: text/plain, Size: 882 bytes --]
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].
[1]:
<https://git.yoctocell.xyz/guix/commit/?h=guix-upstream-git-fetch&id=0356c7603a4611d40875b4eb352e3378295f34bc>
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins.
2021-08-16 13:02 ` Xinglu Chen
@ 2021-08-16 18:15 ` Maxime Devos
2021-08-18 14:45 ` Xinglu Chen
0 siblings, 1 reply; 66+ messages in thread
From: Maxime Devos @ 2021-08-16 18:15 UTC (permalink / raw)
To: Xinglu Chen, Sarah Morgensen, 50072
[-- Attachment #1: Type: text/plain, Size: 1374 bytes --]
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, 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.
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins.
2021-08-16 18:15 ` Maxime Devos
@ 2021-08-18 14:45 ` Xinglu Chen
0 siblings, 0 replies; 66+ messages in thread
From: Xinglu Chen @ 2021-08-18 14:45 UTC (permalink / raw)
To: Maxime Devos, Sarah Morgensen, 50072
[-- Attachment #1: Type: text/plain, Size: 1779 bytes --]
On Mon, Aug 16 2021, Maxime Devos wrote:
> 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.
> 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! :-)
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2021-08-16 10:46 ` Maxime Devos
2021-08-16 13:02 ` Xinglu Chen
@ 2021-08-16 19:56 ` Sarah Morgensen
2021-08-17 10:18 ` Maxime Devos
2021-09-07 1:16 ` [bug#50072] [PATCH WIP 4/4] upstream: Support updating " Sarah Morgensen
2 siblings, 1 reply; 66+ messages in thread
From: Sarah Morgensen @ 2021-08-16 19:56 UTC (permalink / raw)
To: Maxime Devos; +Cc: Xinglu Chen, 50072
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.
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.
> 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---
Then that wouldn't be too hard to support. There seem to be ~136
packages with this idiom.
> (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.
> +
> +(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)...
> (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.
>
> +(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
^ permalink raw reply [flat|nested] 66+ messages in thread* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2021-08-16 19:56 ` [bug#50072] [PATCH WIP 0/4] Add upstream updater for " Sarah Morgensen
@ 2021-08-17 10:18 ` Maxime Devos
2021-08-30 21:36 ` Maxime Devos
2021-09-06 10:23 ` Ludovic Courtès
0 siblings, 2 replies; 66+ messages in thread
From: Maxime Devos @ 2021-08-17 10:18 UTC (permalink / raw)
To: Sarah Morgensen; +Cc: Xinglu Chen, 50072
[-- Attachment #1.1: Type: text/plain, Size: 8171 bytes --]
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 ...
> 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
like
,@(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
> > 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.
> 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)).
> > [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).
> 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.
> > (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
[-- Attachment #1.2: a.scm --]
[-- Type: text/x-scheme, Size: 2332 bytes --]
;;; 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.
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 66+ messages in thread* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2021-08-17 10:18 ` Maxime Devos
@ 2021-08-30 21:36 ` Maxime Devos
2021-09-06 10:23 ` Ludovic Courtès
1 sibling, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2021-08-30 21:36 UTC (permalink / raw)
To: Sarah Morgensen; +Cc: Xinglu Chen, 50072
[-- Attachment #1: Type: text/plain, Size: 678 bytes --]
Maxime Devos schreef op di 17-08-2021 om 12:18 [+0200]:
> [... 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.
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2021-08-17 10:18 ` Maxime Devos
2021-08-30 21:36 ` Maxime Devos
@ 2021-09-06 10:23 ` Ludovic Courtès
2021-09-06 11:47 ` Maxime Devos
1 sibling, 1 reply; 66+ messages in thread
From: Ludovic Courtès @ 2021-09-06 10:23 UTC (permalink / raw)
To: Maxime Devos; +Cc: Sarah Morgensen, Xinglu Chen, 50072
Hi,
Maxime Devos <maximedevos@telenet.be> skribis:
> 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’.
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2021-09-06 10:23 ` Ludovic Courtès
@ 2021-09-06 11:47 ` Maxime Devos
0 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2021-09-06 11:47 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: Sarah Morgensen, Xinglu Chen, 50072
[-- Attachment #1: Type: text/plain, Size: 2494 bytes --]
Hi,
Ludovic Courtès schreef op ma 06-09-2021 om 12:23 [+0200]:
> > > >
> > > > [...]
> > > > 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.
> But maybe the discussion in <https://issues.guix.gnu.org/50286> will
> give us something nice.
Greetings,
Maxime
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins.
2021-08-16 10:46 ` Maxime Devos
2021-08-16 13:02 ` Xinglu Chen
2021-08-16 19:56 ` [bug#50072] [PATCH WIP 0/4] Add upstream updater for " Sarah Morgensen
@ 2021-09-07 1:16 ` Sarah Morgensen
2021-09-07 10:00 ` Maxime Devos
2 siblings, 1 reply; 66+ messages in thread
From: Sarah Morgensen @ 2021-09-07 1:16 UTC (permalink / raw)
To: Maxime Devos; +Cc: 50072
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?
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
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins.
2021-09-07 1:16 ` [bug#50072] [PATCH WIP 4/4] upstream: Support updating " Sarah Morgensen
@ 2021-09-07 10:00 ` Maxime Devos
2021-09-07 17:51 ` Sarah Morgensen
0 siblings, 1 reply; 66+ messages in thread
From: Maxime Devos @ 2021-09-07 10:00 UTC (permalink / raw)
To: Sarah Morgensen; +Cc: 50072
[-- Attachment #1: Type: text/plain, Size: 1308 bytes --]
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.
See <https://issues.guix.gnu.org/50072#5>.
Greetings,
Maxime.
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins.
2021-09-07 10:00 ` Maxime Devos
@ 2021-09-07 17:51 ` Sarah Morgensen
2021-09-07 20:58 ` Maxime Devos
0 siblings, 1 reply; 66+ messages in thread
From: Sarah Morgensen @ 2021-09-07 17:51 UTC (permalink / raw)
To: Maxime Devos; +Cc: 50072
Hi,
Maxime Devos <maximedevos@telenet.be> writes:
> 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?
> See <https://issues.guix.gnu.org/50072#5>.
That's the message I quoted ;)
--
Sarah
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins.
2021-09-07 17:51 ` Sarah Morgensen
@ 2021-09-07 20:58 ` Maxime Devos
0 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2021-09-07 20:58 UTC (permalink / raw)
To: Sarah Morgensen; +Cc: 50072
[-- Attachment #1: Type: text/plain, Size: 1680 bytes --]
Sarah Morgensen schreef op di 07-09-2021 om 10:51 [-0700]:
> 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).
> Are current minetest packages like this formatted like 'gnash' above?
About a third are formatted like 'gnash' (let ((commit ...) (revision ...)) ...)).
Greetings,
Maxime
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2021-08-15 23:25 ` [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins Sarah Morgensen
2021-08-16 10:46 ` Maxime Devos
@ 2021-09-06 10:27 ` Ludovic Courtès
2021-09-07 1:59 ` Sarah Morgensen
1 sibling, 1 reply; 66+ messages in thread
From: Ludovic Courtès @ 2021-09-06 10:27 UTC (permalink / raw)
To: Sarah Morgensen; +Cc: 50072
Hi Sarah,
I like this patch series. :-)
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.
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.
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2021-09-06 10:27 ` [bug#50072] [PATCH WIP 0/4] Add upstream updater for " Ludovic Courtès
@ 2021-09-07 1:59 ` Sarah Morgensen
2021-09-29 21:28 ` Ludovic Courtès
0 siblings, 1 reply; 66+ messages in thread
From: Sarah Morgensen @ 2021-09-07 1:59 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 50072
Hi Ludo,
Ludovic Courtès <ludo@gnu.org> writes:
> Hi Sarah,
>
> I like this patch series. :-)
Thanks for taking a look!
>
> 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.
>
> 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
^ permalink raw reply [flat|nested] 66+ messages in thread* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2021-09-07 1:59 ` Sarah Morgensen
@ 2021-09-29 21:28 ` Ludovic Courtès
2021-11-17 15:03 ` Ludovic Courtès
0 siblings, 1 reply; 66+ messages in thread
From: Ludovic Courtès @ 2021-09-29 21:28 UTC (permalink / raw)
To: Sarah Morgensen; +Cc: 50072
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’.
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2021-09-29 21:28 ` Ludovic Courtès
@ 2021-11-17 15:03 ` Ludovic Courtès
0 siblings, 0 replies; 66+ messages in thread
From: Ludovic Courtès @ 2021-11-17 15:03 UTC (permalink / raw)
To: Sarah Morgensen; +Cc: 50072
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:
> 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’.
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2021-08-15 23:16 [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins Sarah Morgensen
` (3 preceding siblings ...)
2021-08-15 23:25 ` [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins Sarah Morgensen
@ 2022-01-01 17:35 ` Maxime Devos
2022-01-01 20:39 ` [bug#50072] [PATCH v2 " Maxime Devos
` (4 subsequent siblings)
9 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-01 17:35 UTC (permalink / raw)
To: 50072
[-- Attachment #1: Type: text/plain, Size: 196 bytes --]
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.
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v2 0/4] Add upstream updater for git-fetch origins
2021-08-15 23:16 [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins Sarah Morgensen
` (4 preceding siblings ...)
2022-01-01 17:35 ` Maxime Devos
@ 2022-01-01 20:39 ` Maxime Devos
2022-01-01 20:39 ` [bug#50072] [PATCH v2 1/4] guix hash: Extract file hashing procedures Maxime Devos
` (3 more replies)
2022-01-04 15:09 ` [bug#50072] [PATCH v3 0/4] Add upstream updater for git-fetch origins Maxime Devos
` (3 subsequent siblings)
9 siblings, 4 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-01 20:39 UTC (permalink / raw)
To: 50072; +Cc: Ludovic Courtès, Sarah Morgensen, Maxime Devos
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
^ permalink raw reply [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v2 1/4] guix hash: Extract file hashing procedures.
2022-01-01 20:39 ` [bug#50072] [PATCH v2 " Maxime Devos
@ 2022-01-01 20:39 ` Maxime Devos
2022-01-01 20:39 ` [bug#50072] [PATCH v2 2/4] import: Factorize file hashing Maxime Devos
` (2 subsequent siblings)
3 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-01 20:39 UTC (permalink / raw)
To: 50072; +Cc: Ludovic Courtès, Sarah Morgensen
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
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v2 2/4] import: Factorize file hashing.
2022-01-01 20:39 ` [bug#50072] [PATCH v2 " Maxime Devos
2022-01-01 20:39 ` [bug#50072] [PATCH v2 1/4] guix hash: Extract file hashing procedures Maxime Devos
@ 2022-01-01 20:39 ` Maxime Devos
2022-01-01 20:39 ` [bug#50072] [PATCH v2 3/4] refresh: Support non-tarball sources Maxime Devos
2022-01-01 20:39 ` [bug#50072] [PATCH v2 4/4] upstream: Support updating 'git-fetch' origins Maxime Devos
3 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-01 20:39 UTC (permalink / raw)
To: 50072; +Cc: Ludovic Courtès, Sarah Morgensen
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(-)
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v2 3/4] refresh: Support non-tarball sources.
2022-01-01 20:39 ` [bug#50072] [PATCH v2 " Maxime Devos
2022-01-01 20:39 ` [bug#50072] [PATCH v2 1/4] guix hash: Extract file hashing procedures Maxime Devos
2022-01-01 20:39 ` [bug#50072] [PATCH v2 2/4] import: Factorize file hashing Maxime Devos
@ 2022-01-01 20:39 ` Maxime Devos
2022-01-03 13:55 ` Ludovic Courtès
2022-01-01 20:39 ` [bug#50072] [PATCH v2 4/4] upstream: Support updating 'git-fetch' origins Maxime Devos
3 siblings, 1 reply; 66+ messages in thread
From: Maxime Devos @ 2022-01-01 20:39 UTC (permalink / raw)
To: 50072; +Cc: Ludovic Courtès, Sarah Morgensen
From: Sarah Morgensen <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(-)
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v2 3/4] refresh: Support non-tarball sources.
2022-01-01 20:39 ` [bug#50072] [PATCH v2 3/4] refresh: Support non-tarball sources Maxime Devos
@ 2022-01-03 13:55 ` Ludovic Courtès
0 siblings, 0 replies; 66+ messages in thread
From: Ludovic Courtès @ 2022-01-03 13:55 UTC (permalink / raw)
To: Maxime Devos; +Cc: Sarah Morgensen, 50072
Hi Maxime,
Thanks for the updated patch set! Overall it LGTM. I found this one
bug:
Maxime Devos <maximedevos@telenet.be> skribis:
> From: Sarah Morgensen <iskarian@mgsn.dev>
>
> * guix/scripts/refresh.scm (update-package): Use 'file-hash*' instead of
> 'port-sha256'. Rename TARBALL to OUTPUT.
[...]
> - (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’.
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH v2 4/4] upstream: Support updating 'git-fetch' origins.
2022-01-01 20:39 ` [bug#50072] [PATCH v2 " Maxime Devos
` (2 preceding siblings ...)
2022-01-01 20:39 ` [bug#50072] [PATCH v2 3/4] refresh: Support non-tarball sources Maxime Devos
@ 2022-01-01 20:39 ` Maxime Devos
2022-01-03 14:02 ` Ludovic Courtès
3 siblings, 1 reply; 66+ messages in thread
From: Maxime Devos @ 2022-01-01 20:39 UTC (permalink / raw)
To: 50072; +Cc: Ludovic Courtès, Sarah Morgensen, Maxime Devos
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(-)
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v2 4/4] upstream: Support updating 'git-fetch' origins.
2022-01-01 20:39 ` [bug#50072] [PATCH v2 4/4] upstream: Support updating 'git-fetch' origins Maxime Devos
@ 2022-01-03 14:02 ` Ludovic Courtès
0 siblings, 0 replies; 66+ messages in thread
From: Ludovic Courtès @ 2022-01-03 14:02 UTC (permalink / raw)
To: Maxime Devos; +Cc: Sarah Morgensen, 50072
Maxime Devos <maximedevos@telenet.be> skribis:
> 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>
[...]
> 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.
> +(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’.
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH v3 0/4] Add upstream updater for git-fetch origins
2021-08-15 23:16 [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins Sarah Morgensen
` (5 preceding siblings ...)
2022-01-01 20:39 ` [bug#50072] [PATCH v2 " Maxime Devos
@ 2022-01-04 15:09 ` Maxime Devos
2022-01-04 15:09 ` [bug#50072] [PATCH v3 1/4] guix hash: Extract file hashing procedures Maxime Devos
` (4 more replies)
2022-01-04 20:06 ` [bug#50072] [PATCH v4 " Maxime Devos
` (2 subsequent siblings)
9 siblings, 5 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-04 15:09 UTC (permalink / raw)
To: 50072; +Cc: Ludovic Courtès, Sarah Morgensen, Maxime Devos
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 4264 bytes --]
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
^ permalink raw reply [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v3 1/4] guix hash: Extract file hashing procedures.
2022-01-04 15:09 ` [bug#50072] [PATCH v3 0/4] Add upstream updater for git-fetch origins Maxime Devos
@ 2022-01-04 15:09 ` Maxime Devos
2022-01-04 15:09 ` [bug#50072] [PATCH v3 2/4] import: Factorize file hashing Maxime Devos
` (3 subsequent siblings)
4 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-04 15:09 UTC (permalink / raw)
To: 50072; +Cc: Ludovic Courtès, Sarah Morgensen, Maxime Devos
From: Sarah Morgensen <iskarian@mgsn.dev>
* 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
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v3 2/4] import: Factorize file hashing.
2022-01-04 15:09 ` [bug#50072] [PATCH v3 0/4] Add upstream updater for git-fetch origins Maxime Devos
2022-01-04 15:09 ` [bug#50072] [PATCH v3 1/4] guix hash: Extract file hashing procedures Maxime Devos
@ 2022-01-04 15:09 ` Maxime Devos
2022-01-04 15:09 ` [bug#50072] [PATCH v3 3/4] refresh: Support non-tarball sources Maxime Devos
` (2 subsequent siblings)
4 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-04 15:09 UTC (permalink / raw)
To: 50072; +Cc: Ludovic Courtès, Sarah Morgensen
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(-)
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v3 3/4] refresh: Support non-tarball sources.
2022-01-04 15:09 ` [bug#50072] [PATCH v3 0/4] Add upstream updater for git-fetch origins Maxime Devos
2022-01-04 15:09 ` [bug#50072] [PATCH v3 1/4] guix hash: Extract file hashing procedures Maxime Devos
2022-01-04 15:09 ` [bug#50072] [PATCH v3 2/4] import: Factorize file hashing Maxime Devos
@ 2022-01-04 15:09 ` Maxime Devos
2022-01-04 15:09 ` [bug#50072] [PATCH v3 4/4] upstream: Support updating and fetching 'git-fetch' origins Maxime Devos
2022-01-04 19:05 ` [bug#50072] [PATCH v3 0/4] Add upstream updater for git-fetch origins Maxime Devos
4 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-04 15:09 UTC (permalink / raw)
To: 50072; +Cc: Ludovic Courtès, Sarah Morgensen
From: Sarah Morgensen <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(-)
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v3 4/4] upstream: Support updating and fetching 'git-fetch' origins.
2022-01-04 15:09 ` [bug#50072] [PATCH v3 0/4] Add upstream updater for git-fetch origins Maxime Devos
` (2 preceding siblings ...)
2022-01-04 15:09 ` [bug#50072] [PATCH v3 3/4] refresh: Support non-tarball sources Maxime Devos
@ 2022-01-04 15:09 ` Maxime Devos
2022-01-04 19:05 ` [bug#50072] [PATCH v3 0/4] Add upstream updater for git-fetch origins Maxime Devos
4 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-04 15:09 UTC (permalink / raw)
To: 50072; +Cc: Ludovic Courtès, Sarah Morgensen, Maxime Devos
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(-)
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v3 0/4] Add upstream updater for git-fetch origins
2022-01-04 15:09 ` [bug#50072] [PATCH v3 0/4] Add upstream updater for git-fetch origins Maxime Devos
` (3 preceding siblings ...)
2022-01-04 15:09 ` [bug#50072] [PATCH v3 4/4] upstream: Support updating and fetching 'git-fetch' origins Maxime Devos
@ 2022-01-04 19:05 ` Maxime Devos
4 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-04 19:05 UTC (permalink / raw)
To: 50072; +Cc: Ludovic Courtès, Sarah Morgensen
[-- Attachment #1: Type: text/plain, Size: 457 bytes --]
Maxime Devos schreef op di 04-01-2022 om 15:09 [+0000]:
> * 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
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH v4 0/4] Add upstream updater for git-fetch origins
2021-08-15 23:16 [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins Sarah Morgensen
` (6 preceding siblings ...)
2022-01-04 15:09 ` [bug#50072] [PATCH v3 0/4] Add upstream updater for git-fetch origins Maxime Devos
@ 2022-01-04 20:06 ` Maxime Devos
2022-01-04 20:06 ` [bug#50072] [PATCH v4 1/4] guix hash: Extract file hashing procedures Maxime Devos
` (3 more replies)
2022-01-05 14:07 ` [bug#50072] [PATCH v5 1/4] guix hash: Extract file hashing procedures Maxime Devos
2022-01-05 15:56 ` Maxime Devos
9 siblings, 4 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-04 20:06 UTC (permalink / raw)
To: 50072; +Cc: Maxime Devos
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
^ permalink raw reply [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v4 1/4] guix hash: Extract file hashing procedures.
2022-01-04 20:06 ` [bug#50072] [PATCH v4 " Maxime Devos
@ 2022-01-04 20:06 ` Maxime Devos
2022-01-04 22:22 ` [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins zimoun
2022-01-04 20:06 ` [bug#50072] [PATCH v4 2/4] import: Factorize file hashing Maxime Devos
` (2 subsequent siblings)
3 siblings, 1 reply; 66+ messages in thread
From: Maxime Devos @ 2022-01-04 20:06 UTC (permalink / raw)
To: 50072; +Cc: Sarah Morgensen, Maxime Devos
From: Sarah Morgensen <iskarian@mgsn.dev>
* 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
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2022-01-04 20:06 ` [bug#50072] [PATCH v4 1/4] guix hash: Extract file hashing procedures Maxime Devos
@ 2022-01-04 22:22 ` zimoun
2022-01-05 10:07 ` Maxime Devos
2022-01-05 10:09 ` Maxime Devos
0 siblings, 2 replies; 66+ messages in thread
From: zimoun @ 2022-01-04 22:22 UTC (permalink / raw)
To: Maxime Devos; +Cc: Sarah Morgensen, 50072
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:
> diff --git a/guix/hash.scm b/guix/hash.scm
[...]
> +(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?
> +(define* (file-hash* file #:key
> + (algorithm (hash-algorithm sha256))
> + (recursive? 'auto)
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…
> +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…
> + (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
^ permalink raw reply [flat|nested] 66+ messages in thread* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2022-01-04 22:22 ` [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins zimoun
@ 2022-01-05 10:07 ` Maxime Devos
2022-01-05 11:48 ` zimoun
2022-01-05 10:09 ` Maxime Devos
1 sibling, 1 reply; 66+ messages in thread
From: Maxime Devos @ 2022-01-05 10:07 UTC (permalink / raw)
To: zimoun; +Cc: Sarah Morgensen, 50072
[-- Attachment #1: Type: text/plain, Size: 1878 bytes --]
zimoun schreef op di 04-01-2022 om 23:22 [+0100]:
> 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 ...
> > +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.
> 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
> + (let ((hash (file-hash* output)))
There, #:recursive? is 'auto'.
Greetings,
Maxime
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2022-01-05 10:07 ` Maxime Devos
@ 2022-01-05 11:48 ` zimoun
2022-01-05 12:10 ` Maxime Devos
2022-01-05 12:27 ` Maxime Devos
0 siblings, 2 replies; 66+ messages in thread
From: zimoun @ 2022-01-05 11:48 UTC (permalink / raw)
To: Maxime Devos; +Cc: Sarah Morgensen, 50072
Hi Maxime,
On Wed, 05 Jan 2022 at 11:07, Maxime Devos <maximedevos@telenet.be> wrote:
> Precisely, in the sense 'auto' means #true in that 'auto' recurses.
> But sometimes #true / auto compute a different hash ...
[...]
> 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,
--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?
>> > + (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
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2022-01-05 11:48 ` zimoun
@ 2022-01-05 12:10 ` Maxime Devos
2022-01-06 10:06 ` Ludovic Courtès
2022-01-05 12:27 ` Maxime Devos
1 sibling, 1 reply; 66+ messages in thread
From: Maxime Devos @ 2022-01-05 12:10 UTC (permalink / raw)
To: zimoun; +Cc: Sarah Morgensen, 50072
[-- Attachment #1: Type: text/plain, Size: 1570 bytes --]
zimoun schreef op wo 05-01-2022 om 12:48 [+0100]:
> > > > + (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.
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 66+ messages in thread* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2022-01-05 12:10 ` Maxime Devos
@ 2022-01-06 10:06 ` Ludovic Courtès
0 siblings, 0 replies; 66+ messages in thread
From: Ludovic Courtès @ 2022-01-06 10:06 UTC (permalink / raw)
To: Maxime Devos; +Cc: Sarah Morgensen, 50072, zimoun
Hi,
Maxime Devos <maximedevos@telenet.be> skribis:
> '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.
> 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.
> 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’.
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2022-01-05 11:48 ` zimoun
2022-01-05 12:10 ` Maxime Devos
@ 2022-01-05 12:27 ` Maxime Devos
2022-01-05 12:58 ` zimoun
1 sibling, 1 reply; 66+ messages in thread
From: Maxime Devos @ 2022-01-05 12:27 UTC (permalink / raw)
To: zimoun; +Cc: Sarah Morgensen, 50072
[-- Attachment #1: Type: text/plain, Size: 2138 bytes --]
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.
> 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.
> 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.
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2022-01-05 12:27 ` Maxime Devos
@ 2022-01-05 12:58 ` zimoun
2022-01-05 14:06 ` Maxime Devos
0 siblings, 1 reply; 66+ messages in thread
From: zimoun @ 2022-01-05 12:58 UTC (permalink / raw)
To: Maxime Devos; +Cc: Sarah Morgensen, 50072
Hi Maxime,
On Wed, 05 Jan 2022 at 12:27, Maxime Devos <maximedevos@telenet.be> wrote:
> 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. :-)
>> 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.
:-)
>> --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
^ permalink raw reply [flat|nested] 66+ messages in thread* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2022-01-05 12:58 ` zimoun
@ 2022-01-05 14:06 ` Maxime Devos
2022-01-05 15:08 ` zimoun
2022-01-06 10:13 ` Ludovic Courtès
0 siblings, 2 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-05 14:06 UTC (permalink / raw)
To: zimoun; +Cc: Sarah Morgensen, 50072
[-- Attachment #1: Type: text/plain, Size: 5166 bytes --]
zimoun schreef op wo 05-01-2022 om 13:58 [+0100]:
> [...]
> > > --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.
> 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.
> 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.
> 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.
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2022-01-05 14:06 ` Maxime Devos
@ 2022-01-05 15:08 ` zimoun
2022-01-05 15:54 ` Maxime Devos
2022-01-06 10:13 ` Ludovic Courtès
1 sibling, 1 reply; 66+ messages in thread
From: zimoun @ 2022-01-05 15:08 UTC (permalink / raw)
To: Maxime Devos; +Cc: Sarah Morgensen, 50072
Hi Maxime,
On Wed, 05 Jan 2022 at 14:06, Maxime Devos <maximedevos@telenet.be> wrote:
> 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. :-)
> 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. :-)
> 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.
>> 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. :-)
>> 2) From my point of view, ’#:recursive?’ needs to be adapted in
>> agreement with the discussion [1], quoting Ludo:
[...]
>> And I do not have a strong opinion. Just a naive remark.
[...]
> 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.
>> 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
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2022-01-05 14:06 ` Maxime Devos
2022-01-05 15:08 ` zimoun
@ 2022-01-06 10:13 ` Ludovic Courtès
2022-01-06 10:32 ` Maxime Devos
2022-01-06 11:19 ` zimoun
1 sibling, 2 replies; 66+ messages in thread
From: Ludovic Courtès @ 2022-01-06 10:13 UTC (permalink / raw)
To: Maxime Devos; +Cc: Sarah Morgensen, 50072, zimoun
Maxime Devos <maximedevos@telenet.be> skribis:
> zimoun schreef op wo 05-01-2022 om 13:58 [+0100]:
[...]
>> 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’.
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2022-01-06 10:13 ` Ludovic Courtès
@ 2022-01-06 10:32 ` Maxime Devos
2022-01-06 11:19 ` zimoun
1 sibling, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-06 10:32 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: Sarah Morgensen, 50072, zimoun
[-- Attachment #1: Type: text/plain, Size: 580 bytes --]
Ludovic Courtès schreef op do 06-01-2022 om 11:13 [+0100]:
> 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?
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 66+ messages in thread* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2022-01-06 10:13 ` Ludovic Courtès
2022-01-06 10:32 ` Maxime Devos
@ 2022-01-06 11:19 ` zimoun
1 sibling, 0 replies; 66+ messages in thread
From: zimoun @ 2022-01-06 11:19 UTC (permalink / raw)
To: Ludovic Courtès, Maxime Devos; +Cc: Sarah Morgensen, 50072
Hi,
On Thu, 06 Jan 2022 at 11:13, Ludovic Courtès <ludo@gnu.org> wrote:
> 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
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.
2022-01-04 22:22 ` [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins zimoun
2022-01-05 10:07 ` Maxime Devos
@ 2022-01-05 10:09 ` Maxime Devos
1 sibling, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-05 10:09 UTC (permalink / raw)
To: zimoun; +Cc: Sarah Morgensen, 50072
[-- Attachment #1: Type: text/plain, Size: 762 bytes --]
zimoun schreef op di 04-01-2022 om 23:22 [+0100]:
> > +(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.
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH v4 2/4] import: Factorize file hashing.
2022-01-04 20:06 ` [bug#50072] [PATCH v4 " Maxime Devos
2022-01-04 20:06 ` [bug#50072] [PATCH v4 1/4] guix hash: Extract file hashing procedures Maxime Devos
@ 2022-01-04 20:06 ` Maxime Devos
2022-01-04 20:06 ` [bug#50072] [PATCH v4 3/4] refresh: Support non-tarball sources Maxime Devos
2022-01-04 20:06 ` [bug#50072] [PATCH v4 4/4] upstream: Support updating and fetching 'git-fetch' origins Maxime Devos
3 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-04 20:06 UTC (permalink / raw)
To: 50072; +Cc: Sarah Morgensen
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(-)
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v4 3/4] refresh: Support non-tarball sources.
2022-01-04 20:06 ` [bug#50072] [PATCH v4 " Maxime Devos
2022-01-04 20:06 ` [bug#50072] [PATCH v4 1/4] guix hash: Extract file hashing procedures Maxime Devos
2022-01-04 20:06 ` [bug#50072] [PATCH v4 2/4] import: Factorize file hashing Maxime Devos
@ 2022-01-04 20:06 ` Maxime Devos
2022-01-04 20:06 ` [bug#50072] [PATCH v4 4/4] upstream: Support updating and fetching 'git-fetch' origins Maxime Devos
3 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-04 20:06 UTC (permalink / raw)
To: 50072; +Cc: Sarah Morgensen
From: Sarah Morgensen <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(-)
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v4 4/4] upstream: Support updating and fetching 'git-fetch' origins.
2022-01-04 20:06 ` [bug#50072] [PATCH v4 " Maxime Devos
` (2 preceding siblings ...)
2022-01-04 20:06 ` [bug#50072] [PATCH v4 3/4] refresh: Support non-tarball sources Maxime Devos
@ 2022-01-04 20:06 ` Maxime Devos
3 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-04 20:06 UTC (permalink / raw)
To: 50072; +Cc: Sarah Morgensen, Maxime Devos
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(-)
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
^ permalink raw reply related [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH v5 1/4] guix hash: Extract file hashing procedures.
2021-08-15 23:16 [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins Sarah Morgensen
` (7 preceding siblings ...)
2022-01-04 20:06 ` [bug#50072] [PATCH v4 " Maxime Devos
@ 2022-01-05 14:07 ` Maxime Devos
2022-01-05 14:07 ` [bug#50072] [PATCH v5 2/4] import: Factorize file hashing Maxime Devos
` (3 more replies)
2022-01-05 15:56 ` Maxime Devos
9 siblings, 4 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-05 14:07 UTC (permalink / raw)
To: 50072; +Cc: Sarah Morgensen, Maxime Devos
From: Sarah Morgensen <iskarian@mgsn.dev>
* 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
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v5 2/4] import: Factorize file hashing.
2022-01-05 14:07 ` [bug#50072] [PATCH v5 1/4] guix hash: Extract file hashing procedures Maxime Devos
@ 2022-01-05 14:07 ` Maxime Devos
2022-01-05 14:07 ` [bug#50072] [PATCH v5 3/4] refresh: Support non-tarball sources Maxime Devos
` (2 subsequent siblings)
3 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-05 14:07 UTC (permalink / raw)
To: 50072; +Cc: Sarah Morgensen
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(-)
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v5 3/4] refresh: Support non-tarball sources.
2022-01-05 14:07 ` [bug#50072] [PATCH v5 1/4] guix hash: Extract file hashing procedures Maxime Devos
2022-01-05 14:07 ` [bug#50072] [PATCH v5 2/4] import: Factorize file hashing Maxime Devos
@ 2022-01-05 14:07 ` Maxime Devos
2022-01-05 14:07 ` [bug#50072] [PATCH v5 4/4] upstream: Support updating and fetching 'git-fetch' origins Maxime Devos
2022-01-05 15:57 ` [bug#50072] [PATCH v5 1/4] guix hash: Extract file hashing procedures zimoun
3 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-05 14:07 UTC (permalink / raw)
To: 50072; +Cc: Sarah Morgensen
From: Sarah Morgensen <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(-)
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v5 4/4] upstream: Support updating and fetching 'git-fetch' origins.
2022-01-05 14:07 ` [bug#50072] [PATCH v5 1/4] guix hash: Extract file hashing procedures Maxime Devos
2022-01-05 14:07 ` [bug#50072] [PATCH v5 2/4] import: Factorize file hashing Maxime Devos
2022-01-05 14:07 ` [bug#50072] [PATCH v5 3/4] refresh: Support non-tarball sources Maxime Devos
@ 2022-01-05 14:07 ` Maxime Devos
2022-01-05 15:57 ` [bug#50072] [PATCH v5 1/4] guix hash: Extract file hashing procedures zimoun
3 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-05 14:07 UTC (permalink / raw)
To: 50072; +Cc: Sarah Morgensen, Maxime Devos
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(-)
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v5 1/4] guix hash: Extract file hashing procedures.
2022-01-05 14:07 ` [bug#50072] [PATCH v5 1/4] guix hash: Extract file hashing procedures Maxime Devos
` (2 preceding siblings ...)
2022-01-05 14:07 ` [bug#50072] [PATCH v5 4/4] upstream: Support updating and fetching 'git-fetch' origins Maxime Devos
@ 2022-01-05 15:57 ` zimoun
3 siblings, 0 replies; 66+ messages in thread
From: zimoun @ 2022-01-05 15:57 UTC (permalink / raw)
To: Maxime Devos, 50072, Ludovic Courtès; +Cc: Sarah Morgensen, Maxime Devos
Hi Maxime
Thanks for all the work.
All the series LGTM!
Cheers,
simon
^ permalink raw reply [flat|nested] 66+ messages in thread
* [bug#50072] [PATCH v5 1/4] guix hash: Extract file hashing procedures.
2021-08-15 23:16 [bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins Sarah Morgensen
` (8 preceding siblings ...)
2022-01-05 14:07 ` [bug#50072] [PATCH v5 1/4] guix hash: Extract file hashing procedures Maxime Devos
@ 2022-01-05 15:56 ` Maxime Devos
2022-01-05 15:56 ` [bug#50072] [PATCH v5 2/4] import: Factorize file hashing Maxime Devos
` (2 more replies)
9 siblings, 3 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-05 15:56 UTC (permalink / raw)
To: 50072; +Cc: Sarah Morgensen, Maxime Devos
From: Sarah Morgensen <iskarian@mgsn.dev>
* 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
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v5 2/4] import: Factorize file hashing.
2022-01-05 15:56 ` Maxime Devos
@ 2022-01-05 15:56 ` Maxime Devos
2022-01-05 15:56 ` [bug#50072] [PATCH v5 3/4] refresh: Support non-tarball sources Maxime Devos
2022-01-05 15:56 ` [bug#50072] [PATCH v5 4/4] upstream: Support updating and fetching 'git-fetch' origins Maxime Devos
2 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-05 15:56 UTC (permalink / raw)
To: 50072; +Cc: Sarah Morgensen
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(-)
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v5 3/4] refresh: Support non-tarball sources.
2022-01-05 15:56 ` Maxime Devos
2022-01-05 15:56 ` [bug#50072] [PATCH v5 2/4] import: Factorize file hashing Maxime Devos
@ 2022-01-05 15:56 ` Maxime Devos
2022-01-05 15:56 ` [bug#50072] [PATCH v5 4/4] upstream: Support updating and fetching 'git-fetch' origins Maxime Devos
2 siblings, 0 replies; 66+ messages in thread
From: Maxime Devos @ 2022-01-05 15:56 UTC (permalink / raw)
To: 50072; +Cc: Sarah Morgensen
From: Sarah Morgensen <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(-)
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
^ permalink raw reply related [flat|nested] 66+ messages in thread* [bug#50072] [PATCH v5 4/4] upstream: Support updating and fetching 'git-fetch' origins.
2022-01-05 15:56 ` Maxime Devos
2022-01-05 15:56 ` [bug#50072] [PATCH v5 2/4] import: Factorize file hashing Maxime Devos
2022-01-05 15:56 ` [bug#50072] [PATCH v5 3/4] refresh: Support non-tarball sources Maxime Devos
@ 2022-01-05 15:56 ` Maxime Devos
2022-01-06 10:20 ` bug#50072: [PATCH WIP 0/4] Add upstream updater for git-fetch origins Ludovic Courtès
2 siblings, 1 reply; 66+ messages in thread
From: Maxime Devos @ 2022-01-05 15:56 UTC (permalink / raw)
To: 50072; +Cc: Sarah Morgensen, Maxime Devos
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(-)
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
^ permalink raw reply related [flat|nested] 66+ messages in thread