amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

lint: source: Handle <svn-multi-reference> origins.

Browse source 
This is a followup to 2383e14518.

* guix/lint.scm (svn-reference-uri-with-userinfo): Accept REF being
an <svn-multi-reference> record.
(check-source): Handle 'svn-multi-reference?' origins like
'svn-reference?' origins.
This commit is contained in:
Ludovic Courtès 2022-10-20 22:22:31 +02:00
parent c077345539
commit e0b414fc59
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 30 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

40
guix/lint.scm
View file

@ -63,7 +63,12 @@
#:autoload (guix svn-download) (svn-reference? #:autoload (guix svn-download) (svn-reference?
svn-reference-url svn-reference-url
svn-reference-user-name svn-reference-user-name
svn-reference-password) svn-reference-password
svn-multi-reference?
svn-multi-reference-url
svn-multi-reference-user-name
svn-multi-reference-password)
#:use-module (guix import stackage) #:use-module (guix import stackage)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
@ -1143,18 +1148,32 @@ descriptions maintained upstream."
uris))) uris)))
(define (svn-reference-uri-with-userinfo ref) (define (svn-reference-uri-with-userinfo ref)
"Return the URI of REF, an <svn-reference> object, but with an additional "Return the URI of REF, an <svn-reference> or <svn-multi-reference> object,
'userinfo' part corresponding to REF's user name and password, provided REF's but with an additional 'userinfo' part corresponding to REF's user name and
URI is HTTP or HTTPS." password, provided REF's URI is HTTP or HTTPS."
(let ((uri (string->uri (svn-reference-url ref)))) ;; XXX: For lack of record type inheritance.
(if (and (svn-reference-user-name ref) (define ->url
(if (svn-reference? ref)
svn-reference-url
svn-multi-reference-url))
(define ->user-name
(if (svn-reference? ref)
svn-reference-user-name
svn-multi-reference-user-name))
(define ->password
(if (svn-reference? ref)
svn-reference-password
svn-multi-reference-password))
(let ((uri (string->uri (->url ref))))
(if (and (->user-name ref)
(memq (uri-scheme uri) '(http https))) (memq (uri-scheme uri) '(http https)))
(build-uri (uri-scheme uri) (build-uri (uri-scheme uri)
#:userinfo #:userinfo
(string-append (svn-reference-user-name ref) (string-append (->user-name ref)
(if (svn-reference-password ref) (if (->password ref)
(string-append (string-append
":" (svn-reference-password ref)) ":" (->password ref))
"")) ""))
#:host (uri-host uri) #:host (uri-host uri)
#:port (uri-port uri) #:port (uri-port uri)
@ -1207,7 +1226,8 @@ URI is HTTP or HTTPS."
((git-reference? (origin-uri origin)) ((git-reference? (origin-uri origin))
(warnings-for-uris (warnings-for-uris
(list (string->uri (git-reference-url (origin-uri origin)))))) (list (string->uri (git-reference-url (origin-uri origin))))))
((svn-reference? (origin-uri origin)) ((or (svn-reference? (origin-uri origin))
(svn-multi-reference? (origin-uri origin)))
(let ((uri (svn-reference-uri-with-userinfo (origin-uri origin)))) (let ((uri (svn-reference-uri-with-userinfo (origin-uri origin))))
(if (memq (uri-scheme uri) '(http https)) (if (memq (uri-scheme uri) '(http https))
(warnings-for-uris (list uri)) (warnings-for-uris (list uri))