From 06aac933e1cc97781db0d28eb86b5d984099a30e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 26 Jan 2015 00:19:04 +0100 Subject: guix lint: Make the 'source' checker happy if at least one URI is valid. Before that it would check all the URIs of each package. * guix/scripts/lint.scm (validate-uri): Really return #f on failure and #t otherwise. (check-source): Replace 'for-each' with 'any'. --- guix/scripts/lint.scm | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) (limited to 'guix/scripts/lint.scm') diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index eb0c9f7da0..229b73702e 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Cyril Roelandt ;;; Copyright © 2014 Eric Bavier -;;; Copyright © 2013, 2014 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -264,21 +264,22 @@ (define (validate-uri uri package field) (probe-uri uri))) (case status ((http-response) - (unless (= 200 (response-code argument)) - (emit-warning package - (format #f - (_ "URI ~a not reachable: ~a (~s)") - (uri->string uri) - (response-code argument) - (response-reason-phrase argument)) - field))) + (or (= 200 (response-code argument)) + (emit-warning package + (format #f + (_ "URI ~a not reachable: ~a (~s)") + (uri->string uri) + (response-code argument) + (response-reason-phrase argument)) + field))) ((getaddrinfo-error) (emit-warning package (format #f (_ "URI ~a domain not found: ~a") (uri->string uri) (gai-strerror (car argument))) - field)) + field) + #f) ((system-error) (emit-warning package (format #f @@ -287,15 +288,15 @@ (define (validate-uri uri package field) (strerror (system-error-errno (cons status argument)))) - field)) + field) + #f) ((invalid-http-response gnutls-error) ;; Probably a misbehaving server; ignore. #f) ((not-http) ;nothing we can do #f) (else - (error "internal linter error" status))) - #t)) + (error "internal linter error" status))))) (define (check-home-page package) "Emit a warning if PACKAGE has an invalid 'home-page' field, or if that @@ -396,9 +397,10 @@ (define (check-source package) (uris (if (list? strings) (map string->uri strings) (list (string->uri strings))))) - (for-each - (cut validate-uri <> package 'source) - (append-map (cut maybe-expand-mirrors <> %mirrors) uris)))))) + ;; Just make sure that at least one of the URIs is valid. + (any (cut validate-uri <> package 'source) + (append-map (cut maybe-expand-mirrors <> %mirrors) + uris)))))) -- cgit v1.2.3