From 0bd1498fc40820be35125cc0a62482d015b58e9b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 8 Mar 2019 23:13:56 +0100 Subject: [PATCH] upstream: Correctly report failure to update Git checkouts. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . Reported by Gábor Boskovits . * 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 9163478099..55683dd9b7 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 +;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2015 Alex Kost ;;; Copyright © 2019 Ricardo Wurmus ;;; @@ -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 ." + (match 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))))