upstream: Correctly report failure to update Git checkouts.
Fixes <https://bugs.gnu.org/34778>. Reported by Gábor Boskovits <boskovits@gmail.com>. * 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.
This commit is contained in:
parent
d429878daf
commit
0bd1498fc4
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||||||
;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
|
;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
|
||||||
;;;
|
;;;
|
||||||
|
@ -23,7 +23,7 @@
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
#:use-module (guix discovery)
|
#:use-module (guix discovery)
|
||||||
#:use-module ((guix download)
|
#:use-module ((guix download)
|
||||||
#:select (download-to-store))
|
#:select (download-to-store url-fetch))
|
||||||
#:use-module (guix gnupg)
|
#:use-module (guix gnupg)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix ui)
|
#:use-module (guix ui)
|
||||||
|
@ -37,6 +37,8 @@
|
||||||
#:use-module (srfi srfi-9)
|
#:use-module (srfi srfi-9)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
|
#:use-module (srfi srfi-34)
|
||||||
|
#:use-module (srfi srfi-35)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 regex)
|
#:use-module (ice-9 regex)
|
||||||
#:export (upstream-source
|
#:export (upstream-source
|
||||||
|
@ -340,17 +342,13 @@ values: the item from LST1 and the item from LST2 that match PRED."
|
||||||
(()
|
(()
|
||||||
(values #f #f)))))
|
(values #f #f)))))
|
||||||
|
|
||||||
(define* (package-update store package updaters
|
(define* (package-update/url-fetch store package source
|
||||||
#:key (key-download 'interactive))
|
#:key key-download)
|
||||||
"Return the new version, the file name of the new version tarball, and input
|
"Return the version, tarball, and input changes needed to update PACKAGE to
|
||||||
changes for PACKAGE; return #f (three values) when PACKAGE is up-to-date.
|
SOURCE, an <upstream-source>."
|
||||||
KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
|
(match source
|
||||||
values: 'always', 'never', and 'interactive' (default)."
|
|
||||||
(match (package-latest-release* package updaters)
|
|
||||||
(($ <upstream-source> _ version urls signature-urls changes)
|
(($ <upstream-source> _ version urls signature-urls changes)
|
||||||
(let*-values (((name)
|
(let*-values (((archive-type)
|
||||||
(package-name package))
|
|
||||||
((archive-type)
|
|
||||||
(match (and=> (package-source package) origin-uri)
|
(match (and=> (package-source package) origin-uri)
|
||||||
((? string? uri)
|
((? string? uri)
|
||||||
(let ((type (file-extension (basename uri))))
|
(let ((type (file-extension (basename uri))))
|
||||||
|
@ -373,7 +371,36 @@ values: 'always', 'never', and 'interactive' (default)."
|
||||||
(or signature-urls (circular-list #f)))))
|
(or signature-urls (circular-list #f)))))
|
||||||
(let ((tarball (download-tarball store url signature-url
|
(let ((tarball (download-tarball store url signature-url
|
||||||
#:key-download key-download)))
|
#: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
|
(#f
|
||||||
(values #f #f #f))))
|
(values #f #f #f))))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue