summaryrefslogtreecommitdiff
path: root/guix/lint.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-07-12 22:41:09 +0200
committerLudovic Courtès <ludo@gnu.org>2020-07-12 22:41:51 +0200
commitc10526672e515f07c92dc447bbc592808f67238e (patch)
tree26dc5ea7ed9de7fd77faa2956e800c7780d2c07d /guix/lint.scm
parent7bbe4655a8726a7250837c01c2678d7bcc6262e6 (diff)
lint: source: Validate URLs of Git references.
Until now the 'source' checker would look at URL for 'url-fetch' origins but not for 'git-fetch' origins. * guix/lint.scm (check-source): Add case for 'git-reference?'. * tests/lint.scm ("source, git-reference: 301 -> 200"): New test.
Diffstat (limited to 'guix/lint.scm')
-rw-r--r--guix/lint.scm47
1 files changed, 26 insertions, 21 deletions
diff --git a/guix/lint.scm b/guix/lint.scm
index 445c06f8f4..a550caa237 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -793,27 +793,32 @@ descriptions maintained upstream."
(loop rest (cons warning warnings))))))))
(let ((origin (package-source package)))
- (if (and (origin? origin)
- (eqv? (origin-method origin) url-fetch))
- (let* ((uris (append-map (cut maybe-expand-mirrors <> %mirrors)
- (map string->uri (origin-uris origin))))
- (warnings (warnings-for-uris uris)))
-
- ;; Just make sure that at least one of the URIs is valid.
- (if (= (length uris) (length warnings))
- ;; When everything fails, report all of WARNINGS, otherwise don't
- ;; report anything.
- ;;
- ;; XXX: Ideally we'd still allow warnings to be raised if *some*
- ;; URIs are unreachable, but distinguish that from the error case
- ;; where *all* the URIs are unreachable.
- (cons*
- (make-warning package
- (G_ "all the source URIs are unreachable:")
- #:field 'source)
- warnings)
- '()))
- '())))
+ (if (origin? origin)
+ (cond
+ ((eq? (origin-method origin) url-fetch)
+ (let* ((uris (append-map (cut maybe-expand-mirrors <> %mirrors)
+ (map string->uri (origin-uris origin))))
+ (warnings (warnings-for-uris uris)))
+
+ ;; Just make sure that at least one of the URIs is valid.
+ (if (= (length uris) (length warnings))
+ ;; When everything fails, report all of WARNINGS, otherwise don't
+ ;; report anything.
+ ;;
+ ;; XXX: Ideally we'd still allow warnings to be raised if *some*
+ ;; URIs are unreachable, but distinguish that from the error case
+ ;; where *all* the URIs are unreachable.
+ (cons*
+ (make-warning package
+ (G_ "all the source URIs are unreachable:")
+ #:field 'source)
+ warnings)
+ '())))
+ ((git-reference? (origin-uri origin))
+ (warnings-for-uris
+ (list (string->uri (git-reference-url (origin-uri origin))))))
+ (else
+ '())))))
(define (check-source-file-name package)
"Emit a warning if PACKAGE's origin has no meaningful file name."