me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2019-03-08 23:13:56 +01:00
parent d429878daf
commit 0bd1498fc4
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 40 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
guix/upstream.scm
View File

@ -1,5 +1,5 @@
;;; 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 © 2019 Ricardo Wurmus <rekado@elephly.net>
;;;
@ -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))))