nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
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)) (upstream-source-input-changes source))
(let ((hash (call-with-input-file tarball (let ((hash (call-with-input-file tarball
port-sha256))) port-sha256)))
(update-package-source package version hash))) (update-package-source package source hash)))
(warning (G_ "~a: version ~a could not be \ (warning (G_ "~a: version ~a could not be \
downloaded and authenticated; not updating~%") downloaded and authenticated; not updating~%")
(package-name package) version)))) (package-name package) version))))

62
guix/upstream.scm
View File

@ -39,6 +39,7 @@
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
#:use-module (rnrs bytevectors)
#: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
@ -404,36 +405,57 @@ this method: ~s")
(#f (#f
(values #f #f #f)))) (values #f #f #f))))
(define (update-package-source package version hash) (define* (update-package-source package source hash)
"Modify the source file that defines PACKAGE to refer to VERSION, "Modify the source file that defines PACKAGE to refer to SOURCE, an
whose tarball has SHA256 HASH (a bytevector). Return the new version string <upstream-source> whose tarball has SHA256 HASH (a bytevector). Return the
if an update was made, and #f otherwise." new version string if an update was made, and #f otherwise."
(define (update-expression expr old-version version old-hash hash) (define (update-expression expr replacements)
;; Update package expression EXPR, replacing occurrences OLD-VERSION by ;; Apply REPLACEMENTS to package expression EXPR, a string. REPLACEMENTS
;; VERSION and occurrences of OLD-HASH by HASH (base32 representation ;; must be a list of replacement pairs, either bytevectors or strings.
;; thereof). (fold (lambda (replacement str)
(let ((old-hash (bytevector->nix-base32-string old-hash)) (match replacement
(hash (bytevector->nix-base32-string hash))) (((? bytevector? old-bv) . (? bytevector? new-bv))
(string-replace-substring (string-replace-substring
(string-replace-substring expr old-hash hash) str
old-version version))) (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)) (let ((name (package-name package))
(version (upstream-source-version source))
(version-loc (package-field-location package 'version))) (version-loc (package-field-location package 'version)))
(if version-loc (if version-loc
(let* ((loc (package-location package)) (let* ((loc (package-location package))
(old-version (package-version package)) (old-version (package-version package))
(old-hash (origin-sha256 (package-source 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) (file (and=> (location-file loc)
(cut search-path %load-path <>)))) (cut search-path %load-path <>))))
(if file (if file
(and (edit-expression ;; Be sure to use absolute filename. Replace the URL directory
;; Be sure to use absolute filename. ;; when OLD-URL is available; this is useful notably for
(assq-set! (location->source-properties loc) ;; mirror://cpan/ URLs where the directory may change as a
'filename file) ;; function of the person who uploads the package. Note that
(cut update-expression <> ;; package definitions usually concatenate fragments of the URL,
old-version version old-hash hash)) ;; which is why we only attempt to replace a subset of the URL.
version) (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 (begin
(warning (G_ "~a: could not locate source file") (warning (G_ "~a: could not locate source file")
(location-file loc)) (location-file loc))