From e0b414fc599c2d9092dfa57455f035cbedb7810e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 20 Oct 2022 22:22:31 +0200 Subject: [PATCH] lint: source: Handle origins. This is a followup to 2383e145185efb2e6f99931707ec93d65d166432. * guix/lint.scm (svn-reference-uri-with-userinfo): Accept REF being an record. (check-source): Handle 'svn-multi-reference?' origins like 'svn-reference?' origins. --- guix/lint.scm | 40 ++++++++++++++++++++++++++++++---------- 1 file changed, 30 insertions(+), 10 deletions(-) diff --git a/guix/lint.scm b/guix/lint.scm index 9f155b71d4..6e9d11074b 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -63,7 +63,12 @@ (define-module (guix lint) #:autoload (guix svn-download) (svn-reference? svn-reference-url 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 (ice-9 match) #:use-module (ice-9 regex) @@ -1143,18 +1148,32 @@ (define (origin-uris origin) uris))) (define (svn-reference-uri-with-userinfo ref) - "Return the URI of REF, an object, but with an additional -'userinfo' part corresponding to REF's user name and password, provided REF's -URI is HTTP or HTTPS." - (let ((uri (string->uri (svn-reference-url ref)))) - (if (and (svn-reference-user-name ref) + "Return the URI of REF, an or object, +but with an additional 'userinfo' part corresponding to REF's user name and +password, provided REF's URI is HTTP or HTTPS." + ;; XXX: For lack of record type inheritance. + (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))) (build-uri (uri-scheme uri) #:userinfo - (string-append (svn-reference-user-name ref) - (if (svn-reference-password ref) + (string-append (->user-name ref) + (if (->password ref) (string-append - ":" (svn-reference-password ref)) + ":" (->password ref)) "")) #:host (uri-host uri) #:port (uri-port uri) @@ -1207,7 +1226,8 @@ (define (warnings-for-uris uris) ((git-reference? (origin-uri origin)) (warnings-for-uris (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)))) (if (memq (uri-scheme uri) '(http https)) (warnings-for-uris (list uri))