summary refs log tree commit diff
path: root/guix/lint.scm
diff options
context:
space:
mode:
authorMaxim Cournoyer <maxim.cournoyer@gmail.com>2022-09-27 15:59:30 -0400
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2022-09-27 15:59:30 -0400
commit990a4822f1cb45c1470fe38cbf17fd7bb54d0088 (patch)
tree1c1ff41c9264fe5af5ee0b8723d1e367e958c051 /guix/lint.scm
parent91db77c955cc7ef95dd8b535e40d6b4cf28669ec (diff)
parent3c6e220d8100281074c414a43c1efe9a01b53771 (diff)
downloadguix-990a4822f1cb45c1470fe38cbf17fd7bb54d0088.tar.gz
Merge branch 'staging' into core-updates
Conflicts resolved in:
	gnu/local.mk
	gnu/packages/cran.scm
	gnu/packages/gnome.scm
	gnu/packages/gtk.scm
	gnu/packages/icu4c.scm
	gnu/packages/java.scm
	gnu/packages/machine-learning.scm
	gnu/packages/tex.scm
Diffstat (limited to 'guix/lint.scm')
-rw-r--r--guix/lint.scm26
1 files changed, 9 insertions, 17 deletions
diff --git a/guix/lint.scm b/guix/lint.scm
index 7d6fd5ee7e..4ef3a46838 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -12,7 +12,7 @@
 ;;; Copyright © 2020 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
-;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -1221,22 +1221,14 @@ descriptions maintained upstream."
 
 (define (check-mirror-url package)
   "Check whether PACKAGE uses source URLs that should be 'mirror://'."
-  (define (check-mirror-uri uri)                  ;XXX: could be optimized
-    (let loop ((mirrors %mirrors))
-      (match mirrors
-        (()
-         #f)
-        (((mirror-id mirror-urls ...) rest ...)
-         (match (find (cut string-prefix? <> uri) mirror-urls)
-           (#f
-            (loop rest))
-           (prefix
-            (make-warning package
-                          (G_ "URL should be \
-'mirror://~a/~a'")
-                          (list mirror-id
-                                (string-drop uri (string-length prefix)))
-                          #:field 'source)))))))
+  (define (check-mirror-uri uri)
+    (define rewritten-uri
+      (uri-mirror-rewrite uri))
+
+    (and (not (string=? uri rewritten-uri))
+         (make-warning package (G_ "URL should be '~a'")
+                       (list rewritten-uri)
+                       #:field 'source)))
 
   (let ((origin (package-source package)))
     (if (and (origin? origin)