From ec73570be5112a4e4f224b86e06529d1987f2088 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 17 Oct 2022 22:57:39 +0200 Subject: lint: 'probe-uri' honors the 'userinfo' part of URIs. * guix/lint.scm (probe-uri): Honor the 'userinfo' part of URI. --- guix/lint.scm | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) (limited to 'guix/lint.scm') diff --git a/guix/lint.scm b/guix/lint.scm index 7ee3a3122f..1cbbba75c5 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Cyril Roelandt ;;; Copyright © 2014, 2015 Eric Bavier -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès +;;; Copyright © 2013-2022 Ludovic Courtès ;;; Copyright © 2015, 2016 Mathieu Lirzin ;;; Copyright © 2016 Danny Milosavljevic ;;; Copyright © 2016 Hartmut Goebel @@ -34,6 +34,7 @@ #:use-module (guix store) #:autoload (guix base16) (bytevector->base16-string) #:use-module (guix base32) + #:autoload (guix base64) (base64-encode) #:use-module (guix build-system) #:use-module (guix diagnostics) #:use-module (guix download) @@ -63,6 +64,7 @@ #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 format) + #:autoload (rnrs bytevectors) (string->utf8) #:use-module (web client) #:use-module (web uri) #:use-module ((guix build download) @@ -721,8 +723,14 @@ response from URI, and additional details, such as the actual HTTP response. TIMEOUT is the maximum number of seconds (possibly an inexact number) to wait for connections to complete; when TIMEOUT is #f, wait as long as needed." (define headers - '((User-Agent . "GNU Guile") - (Accept . "*/*"))) + `((User-Agent . "GNU Guile") + (Accept . "*/*") + ,@(match (uri-userinfo uri) + ((? string? str) ;"basic authentication" + `((Authorization . ,(string-append "Basic " + (base64-encode + (string->utf8 str)))))) + (_ '())))) (let loop ((uri uri) (visited '())) -- cgit v1.2.3 From 2383e145185efb2e6f99931707ec93d65d166432 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 17 Oct 2022 23:12:07 +0200 Subject: lint: source: Add check for 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. --- guix/lint.scm | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) (limited to 'guix/lint.scm') 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 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 '())) '()))) -- cgit v1.2.3 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: 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(-) (limited to 'guix/lint.scm') 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 @@ #: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 @@ descriptions maintained upstream." 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 @@ URI is HTTP or HTTPS." ((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)) -- cgit v1.2.3 From a3619079f95213c4f983e69210ed12b38fd31022 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 14 Oct 2022 22:19:34 +0200 Subject: Remove now unnecessary uses of (guix grafts). These modules would use (guix grafts) just to access '%graft?' and related bindings, which are now in (guix store). * gnu/ci.scm, guix/gexp.scm, guix/lint.scm, guix/scripts.scm, guix/scripts/archive.scm, guix/scripts/build.scm, guix/scripts/challenge.scm, guix/scripts/deploy.scm, guix/scripts/environment.scm, guix/scripts/home.scm, guix/scripts/pack.scm, guix/scripts/package.scm, guix/scripts/pull.scm, guix/scripts/size.scm, guix/scripts/system.scm, guix/scripts/weather.scm, tests/builders.scm, tests/channels.scm, tests/cpan.scm, tests/derivations.scm, tests/gexp.scm, tests/graph.scm, tests/guix-daemon.sh, tests/monads.scm, tests/pack.scm, tests/packages.scm, tests/profiles.scm, tests/system.scm: Remove #:use-module (guix grafts). --- guix/lint.scm | 1 - 1 file changed, 1 deletion(-) (limited to 'guix/lint.scm') diff --git a/guix/lint.scm b/guix/lint.scm index 6e9d11074b..8e3976171f 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -47,7 +47,6 @@ gexp->approximate-sexp)) #:use-module (guix licenses) #:use-module (guix records) - #:use-module (guix grafts) #:use-module (guix upstream) #:use-module (guix utils) #:use-module (guix memoization) -- cgit v1.2.3