diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2022-10-17 23:12:07 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2022-10-17 23:15:08 +0200 |
| commit | 2383e145185efb2e6f99931707ec93d65d166432 (patch) | |
| tree | 5c7da83f4b3678761641a7c2baed35fa199154cc /guix/lint.scm | |
| parent | ec73570be5112a4e4f224b86e06529d1987f2088 (diff) | |
| download | guix-patches-2383e145185efb2e6f99931707ec93d65d166432.tar guix-patches-2383e145185efb2e6f99931707ec93d65d166432.tar.gz | |
lint: source: Add check for <svn-reference> over HTTP(S).
* guix/lint.scm (svn-reference-uri-with-userinfo): New procedure.
(check-source): Add 'svn-reference?' clause.
* tests/lint.scm ("source: svn-reference, HTTP 200")
("source: svn-reference, HTTP 404"): New tests.
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 '())) '()))) |