summaryrefslogtreecommitdiff
path: root/guix/scripts
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-01-26 00:19:04 +0100
committerLudovic Courtès <ludo@gnu.org>2015-01-26 00:19:33 +0100
commit06aac933e1cc97781db0d28eb86b5d984099a30e (patch)
treebfbc83883b8965639f0dcccbb48ca2105e01b228 /guix/scripts
parentac41737f49402f8717a2f105a1910ffd9c6cfdb4 (diff)
downloadgnu-guix-06aac933e1cc97781db0d28eb86b5d984099a30e.tar
gnu-guix-06aac933e1cc97781db0d28eb86b5d984099a30e.tar.gz
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'.
Diffstat (limited to 'guix/scripts')
-rw-r--r--guix/scripts/lint.scm34
1 files changed, 18 insertions, 16 deletions
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 <tipecaml@gmail.com>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
-;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -264,21 +264,22 @@ warning for PACKAGE mentionning the 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 @@ warning for PACKAGE mentionning the 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 @@ descriptions maintained upstream."
(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))))))