me
/
guix
Archived
1
0
Fork 0
Code

refresh: Update the source code URL. 

Reported by Tobias Geerinckx-Rice <me@tobias.gr>
in <https://bugs.gnu.org/35010>.

* 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.
master
Ludovic Courtès 2019-03-27 14:56:23 +01:00
parent 1ee3d2dcb8
commit 42314ffa07
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 43 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
guix/scripts/refresh.scm
View File

@ -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))))

62
guix/upstream.scm
View File

@ -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
<upstream-source> 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))