From 1ee3d2dcb8892b2ed1a0212fdd6ac2c47f2c8da2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 27 Mar 2019 14:42:07 +0100 Subject: upstream: 'package-update' returns the object. Fixes a regression introduced in abd4d6b33dba4de228e90ad15a8efb456fcf7b6e, where CHANGES would no longer be a thunk. Reported by Ricardo Wurmus. * guix/upstream.scm (package-update/url-fetch): Return SOURCE as the third value instead of CHANGES. * guix/scripts/refresh.scm (update-package): Adjust accordingly. --- guix/upstream.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'guix/upstream.scm') diff --git a/guix/upstream.scm b/guix/upstream.scm index 55683dd9b7..2c70b3422d 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -344,10 +344,10 @@ values: the item from LST1 and the item from LST2 that match PRED." (define* (package-update/url-fetch store package source #:key key-download) - "Return the version, tarball, and input changes needed to update PACKAGE to + "Return the version, tarball, and SOURCE, to update PACKAGE to SOURCE, an ." (match source - (($ _ version urls signature-urls changes) + (($ _ version urls signature-urls) (let*-values (((archive-type) (match (and=> (package-source package) origin-uri) ((? string? uri) @@ -371,7 +371,7 @@ SOURCE, an ." (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 source)))))) (define %method-updates ;; Mapping of origin methods to source update procedures. -- cgit v1.2.3 From 42314ffa072f31cc1cb44df38b1f8fcca19d9d3c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 27 Mar 2019 14:56:23 +0100 Subject: refresh: Update the source code URL. Reported by Tobias Geerinckx-Rice in . * guix/upstream.scm (update-package-source): Take 'source' instead of 'version' as the second argument. [update-expression]: Change to take 'replacements', a list of replacement pairs. Compute OLD-URL and NEW-URL and replace the dirname of the OLD-URL with that of NEW-URL. * guix/scripts/refresh.scm (update-package): Adjust call to 'update-package-source' accordingly. --- guix/scripts/refresh.scm | 2 +- guix/upstream.scm | 62 ++++++++++++++++++++++++++++++++---------------- 2 files changed, 43 insertions(+), 21 deletions(-) (limited to 'guix/upstream.scm') diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 6d77e2642b..dd7026a6a4 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -333,7 +333,7 @@ warn about packages that have no matching updater." (upstream-source-input-changes source)) (let ((hash (call-with-input-file tarball port-sha256))) - (update-package-source package version hash))) + (update-package-source package source hash))) (warning (G_ "~a: version ~a could not be \ downloaded and authenticated; not updating~%") (package-name package) version)))) diff --git a/guix/upstream.scm b/guix/upstream.scm index 2c70b3422d..1326b3db95 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -39,6 +39,7 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (rnrs bytevectors) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:export (upstream-source @@ -404,36 +405,57 @@ this method: ~s") (#f (values #f #f #f)))) -(define (update-package-source package version hash) - "Modify the source file that defines PACKAGE to refer to VERSION, -whose tarball has SHA256 HASH (a bytevector). Return the new version string -if an update was made, and #f otherwise." - (define (update-expression expr old-version version old-hash hash) - ;; Update package expression EXPR, replacing occurrences OLD-VERSION by - ;; VERSION and occurrences of OLD-HASH by HASH (base32 representation - ;; thereof). - (let ((old-hash (bytevector->nix-base32-string old-hash)) - (hash (bytevector->nix-base32-string hash))) - (string-replace-substring - (string-replace-substring expr old-hash hash) - old-version version))) +(define* (update-package-source package source hash) + "Modify the source file that defines PACKAGE to refer to SOURCE, an + whose tarball has SHA256 HASH (a bytevector). Return the +new version string if an update was made, and #f otherwise." + (define (update-expression expr replacements) + ;; Apply REPLACEMENTS to package expression EXPR, a string. REPLACEMENTS + ;; must be a list of replacement pairs, either bytevectors or strings. + (fold (lambda (replacement str) + (match replacement + (((? bytevector? old-bv) . (? bytevector? new-bv)) + (string-replace-substring + str + (bytevector->nix-base32-string old-bv) + (bytevector->nix-base32-string new-bv))) + ((old . new) + (string-replace-substring str old new)))) + expr + replacements)) (let ((name (package-name package)) + (version (upstream-source-version source)) (version-loc (package-field-location package 'version))) (if version-loc (let* ((loc (package-location package)) (old-version (package-version package)) (old-hash (origin-sha256 (package-source package))) + (old-url (match (origin-uri (package-source package)) + ((? string? url) url) + (_ #f))) + (new-url (match (upstream-source-urls source) + ((first _ ...) first))) (file (and=> (location-file loc) (cut search-path %load-path <>)))) (if file - (and (edit-expression - ;; Be sure to use absolute filename. - (assq-set! (location->source-properties loc) - 'filename file) - (cut update-expression <> - old-version version old-hash hash)) - version) + ;; Be sure to use absolute filename. Replace the URL directory + ;; when OLD-URL is available; this is useful notably for + ;; mirror://cpan/ URLs where the directory may change as a + ;; function of the person who uploads the package. Note that + ;; package definitions usually concatenate fragments of the URL, + ;; which is why we only attempt to replace a subset of the URL. + (let ((properties (assq-set! (location->source-properties loc) + 'filename file)) + (replacements `((,old-version . ,version) + (,old-hash . ,hash) + ,@(if (and old-url new-url) + `((,(dirname old-url) . + ,(dirname new-url))) + '())))) + (and (edit-expression properties + (cut update-expression <> replacements)) + version)) (begin (warning (G_ "~a: could not locate source file") (location-file loc)) -- cgit v1.2.3