diff options
Diffstat (limited to 'guix/lint.scm')
| -rw-r--r-- | guix/lint.scm | 29 |
1 files changed, 29 insertions, 0 deletions
diff --git a/guix/lint.scm b/guix/lint.scm index 1cbbba75c5..9f155b71d4 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -60,6 +60,10 @@ #:use-module ((guix swh) #:hide (origin?)) #:autoload (guix git-download) (git-reference? git-reference-url git-reference-commit) + #:autoload (guix svn-download) (svn-reference? + svn-reference-url + svn-reference-user-name + svn-reference-password) #:use-module (guix import stackage) #:use-module (ice-9 match) #:use-module (ice-9 regex) @@ -1138,6 +1142,26 @@ descriptions maintained upstream." ((uris ...) uris))) +(define (svn-reference-uri-with-userinfo ref) + "Return the URI of REF, an <svn-reference> 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) + (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 + ":" (svn-reference-password ref)) + "")) + #:host (uri-host uri) + #:port (uri-port uri) + #:query (uri-query uri) + #:fragment (uri-fragment uri)) + uri))) + (define (check-source package) "Emit a warning if PACKAGE has an invalid 'source' field, or if that 'source' is not reachable." @@ -1183,6 +1207,11 @@ descriptions maintained upstream." ((git-reference? (origin-uri origin)) (warnings-for-uris (list (string->uri (git-reference-url (origin-uri origin)))))) + ((svn-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)) + '()))) ;TODO: handle svn:// URLs (else '())) '()))) |