summaryrefslogtreecommitdiff
path: root/guix/upstream.scm
diff options
context:
space:
mode:
authorSarah Morgensen <iskarian@mgsn.dev>2022-01-05 14:07:50 +0000
committerLudovic Courtès <ludo@gnu.org>2022-01-06 16:27:30 +0100
commit9f526f5dad5f4af69d158c50369e182305147f3b (patch)
treedac4605f2ddbd7dae4a1201cd045479ce44ba8d7 /guix/upstream.scm
parent1c32b4c965cd9ea19043271a91b6522eef3a7ade (diff)
upstream: Support updating and fetching 'git-fetch' origins.
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> Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'guix/upstream.scm')
-rw-r--r--guix/upstream.scm73
1 files changed, 66 insertions, 7 deletions
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 66fae5a351..6666803a92 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, 2022 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
@@ -363,10 +368,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)
@@ -384,6 +388,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."
@@ -436,9 +464,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))
@@ -498,9 +541,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
@@ -514,6 +570,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)))