[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/02: upstream: Correctly report failure to update Git checkouts.
From: |
guix-commits |
Subject: |
02/02: upstream: Correctly report failure to update Git checkouts. |
Date: |
Fri, 8 Mar 2019 17:22:07 -0500 (EST) |
civodul pushed a commit to branch master
in repository guix.
commit 0bd1498fc40820be35125cc0a62482d015b58e9b
Author: Ludovic Courtès <address@hidden>
Date: Fri Mar 8 23:13:56 2019 +0100
upstream: Correctly report failure to update Git checkouts.
Fixes <https://bugs.gnu.org/34778>.
Reported by Gábor Boskovits <address@hidden>.
* guix/upstream.scm (package-update/url-fetch): New procedure, with code
formerly in 'package-update'.
(%method-updates): New variable.
(package-update): Check the method to download PACKAGE's source, and
look up a corresponding update method in %METHOD-UPDATES, and raise an
error if none was found.
---
guix/upstream.scm | 53 ++++++++++++++++++++++++++++++++++++++++-------------
1 file changed, 40 insertions(+), 13 deletions(-)
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 9163478..55683dd 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic
Courtès <address@hidden>
+;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019
Ludovic Courtès <address@hidden>
;;; Copyright © 2015 Alex Kost <address@hidden>
;;; Copyright © 2019 Ricardo Wurmus <address@hidden>
;;;
@@ -23,7 +23,7 @@
#:use-module (guix utils)
#:use-module (guix discovery)
#:use-module ((guix download)
- #:select (download-to-store))
+ #:select (download-to-store url-fetch))
#:use-module (guix gnupg)
#:use-module (guix packages)
#:use-module (guix ui)
@@ -37,6 +37,8 @@
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:export (upstream-source
@@ -340,17 +342,13 @@ values: the item from LST1 and the item from LST2 that
match PRED."
(()
(values #f #f)))))
-(define* (package-update store package updaters
- #:key (key-download 'interactive))
- "Return the new version, the file name of the new version tarball, and input
-changes for PACKAGE; return #f (three values) when PACKAGE is up-to-date.
-KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
-values: 'always', 'never', and 'interactive' (default)."
- (match (package-latest-release* package updaters)
+(define* (package-update/url-fetch store package source
+ #:key key-download)
+ "Return the version, tarball, and input changes needed to update PACKAGE to
+SOURCE, an <upstream-source>."
+ (match source
(($ <upstream-source> _ version urls signature-urls changes)
- (let*-values (((name)
- (package-name package))
- ((archive-type)
+ (let*-values (((archive-type)
(match (and=> (package-source package) origin-uri)
((? string? uri)
(let ((type (file-extension (basename uri))))
@@ -373,7 +371,36 @@ values: 'always', 'never', and 'interactive' (default)."
(or signature-urls (circular-list #f)))))
(let ((tarball (download-tarball store url signature-url
#:key-download key-download)))
- (values version tarball changes))))
+ (values version tarball changes))))))
+
+(define %method-updates
+ ;; Mapping of origin methods to source update procedures.
+ `((,url-fetch . ,package-update/url-fetch)))
+
+(define* (package-update store package updaters
+ #:key (key-download 'interactive))
+ "Return the new version, the file name of the new version tarball, and input
+changes for PACKAGE; return #f (three values) when PACKAGE is up-to-date.
+KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
+values: 'always', 'never', and 'interactive' (default)."
+ (match (package-latest-release* package updaters)
+ ((? upstream-source? source)
+ (let ((method (match (package-source package)
+ ((? origin? origin)
+ (origin-method origin))
+ (_
+ #f))))
+ (match (assq method %method-updates)
+ (#f
+ (raise (condition (&message
+ (message (format #f (G_ "cannot download for \
+this method: ~s")
+ method)))
+ (&error-location
+ (location (package-location package))))))
+ ((_ . update)
+ (update store package source
+ #:key-download key-download)))))
(#f
(values #f #f #f))))