diff options
author | Efraim Flashner <efraim@flashner.co.il> | 2023-01-30 11:33:18 +0200 |
---|---|---|
committer | Efraim Flashner <efraim@flashner.co.il> | 2023-01-30 12:39:40 +0200 |
commit | 4cf1acc7f3033b50b0bf19e02c9f522d522d338c (patch) | |
tree | 9fd64956ee60304c15387eb394cd649e49f01467 /guix/lint.scm | |
parent | edb8c09addd186d9538d43b12af74d6c7aeea082 (diff) | |
parent | 595b53b74e3ef57a1c0c96108ba86d38a170a241 (diff) | |
download | guix-patches-4cf1acc7f3033b50b0bf19e02c9f522d522d338c.tar guix-patches-4cf1acc7f3033b50b0bf19e02c9f522d522d338c.tar.gz |
Merge remote-tracking branch 'origin/master' into core-updates
Conflicts:
doc/guix.texi
gnu/local.mk
gnu/packages/admin.scm
gnu/packages/base.scm
gnu/packages/chromium.scm
gnu/packages/compression.scm
gnu/packages/databases.scm
gnu/packages/diffoscope.scm
gnu/packages/freedesktop.scm
gnu/packages/gnome.scm
gnu/packages/gnupg.scm
gnu/packages/guile.scm
gnu/packages/inkscape.scm
gnu/packages/llvm.scm
gnu/packages/openldap.scm
gnu/packages/pciutils.scm
gnu/packages/ruby.scm
gnu/packages/samba.scm
gnu/packages/sqlite.scm
gnu/packages/statistics.scm
gnu/packages/syndication.scm
gnu/packages/tex.scm
gnu/packages/tls.scm
gnu/packages/version-control.scm
gnu/packages/xml.scm
guix/build-system/copy.scm
guix/scripts/home.scm
Diffstat (limited to 'guix/lint.scm')
-rw-r--r-- | guix/lint.scm | 64 |
1 files changed, 60 insertions, 4 deletions
diff --git a/guix/lint.scm b/guix/lint.scm index 4ef3a46838..a8a375e502 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org> -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2016 Danny Milosavljevic <dannym+a@scratchpost.org> ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com> @@ -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) @@ -46,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) @@ -59,10 +59,20 @@ #: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 + + 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) #:use-module (ice-9 format) + #:autoload (rnrs bytevectors) (string->utf8) #:use-module (web client) #:use-module (web uri) #:use-module ((guix build download) @@ -720,8 +730,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 '())) @@ -1129,6 +1145,40 @@ descriptions maintained upstream." ((uris ...) uris))) +(define (svn-reference-uri-with-userinfo ref) + "Return the URI of REF, an <svn-reference> or <svn-multi-reference> 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 (->user-name ref) + (if (->password ref) + (string-append + ":" (->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." @@ -1174,6 +1224,12 @@ descriptions maintained upstream." ((git-reference? (origin-uri origin)) (warnings-for-uris (list (string->uri (git-reference-url (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)) + '()))) ;TODO: handle svn:// URLs (else '())) '()))) |