* Re: [PATCH] lint: add 'source' checker.
2014-12-29 3:40 ` [PATCH] lint: add 'source' checker Cyril Roelandt
@ 2014-12-29 13:05 ` David Thompson
2014-12-29 14:23 ` Ludovic Courtès
` (2 subsequent siblings)
3 siblings, 0 replies; 14+ messages in thread
From: David Thompson @ 2014-12-29 13:05 UTC (permalink / raw)
To: Cyril Roelandt, guix-devel
Cyril Roelandt <tipecaml@gmail.com> writes:
> * guix/scripts/lint.scm (uri-available?): New procedure.
> (%checkers): Add 'home-page' checker
> ---
> guix/scripts/lint.scm | 98 ++++++++++++++++++++++++++++++++++-----------------
> 1 file changed, 65 insertions(+), 33 deletions(-)
>
> diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
> index 9a0d997..482b3e4 100644
> --- a/guix/scripts/lint.scm
> +++ b/guix/scripts/lint.scm
> @@ -20,6 +20,7 @@
>
> (define-module (guix scripts lint)
> #:use-module (guix base32)
> + #:use-module (guix download)
> #:use-module (guix packages)
> #:use-module (guix records)
> #:use-module (guix ui)
> @@ -253,45 +254,51 @@ response from URI, and additional details, such as the actual HTTP response."
> (_
> (values 'not-http #f)))))
>
> +(define (uri-available? uri)
> + "Return #t if the given URI can be reached, otherwise throw a
> +'not-available exception along with an appropriate error message."
> + (let-values (((status argument)
> + (probe-uri uri)))
> + (case status
How about using match instead of case?
> + ((http-response)
> + (unless (= 200 (response-code argument))
> + (throw 'not-available
> + (format #f
> + (_ "~a unreachable: ~a (~s)")
> + (uri->string uri)
> + (response-code argument)
> + (response-reason-phrase argument)))))
> + ((getaddrinfo-error)
> + (throw 'not-available
> + (format #f
> + (_ "domain not found: ~a")
> + (gai-strerror (car argument)))))
> + ((system-error)
> + (throw 'not-available
> + (format #f
> + (_ "unreachable: ~a")
> + (strerror
> + (system-error-errno
> + (cons status argument))))))
> + ((invalid-http-response gnutls-error)
> + ;; Probably a misbehaving server; ignore.
> + #f)
> + ((not-http) ;nothing we can do
> + #f)
> + (else
> + (error "internal home-page linter error" status)))
> + #t))
> +
> (define (check-home-page package)
> "Emit a warning if PACKAGE has an invalid 'home-page' field, or if that
> 'home-page' is not reachable."
> (let ((uri (and=> (package-home-page package) string->uri)))
> (cond
> ((uri? uri)
> - (let-values (((status argument)
> - (probe-uri uri)))
> - (case status
> - ((http-response)
> - (unless (= 200 (response-code argument))
> - (emit-warning package
> - (format #f
> - (_ "home page ~a not reachable: ~a (~s)")
> - (uri->string uri)
> - (response-code argument)
> - (response-reason-phrase argument))
> - 'home-page)))
> - ((getaddrinfo-error)
> - (emit-warning package
> - (format #f
> - (_ "home page domain not found: ~a")
> - (gai-strerror (car argument)))
> - 'package))
> - ((system-error)
> - (emit-warning package
> - (format #f
> - (_ "home page unreachable: ~a")
> - (strerror
> - (system-error-errno
> - (cons status argument))))
> - 'home-page))
> - ((invalid-http-response gnutls-error)
> - ;; Probably a misbehaving server; ignore.
> - #f)
> - ((not-http) ;nothing we can do
> - #f)
> - (else
> - (error "internal home-page linter error" status)))))
> + (catch 'not-available
> + (lambda () (uri-available? uri))
> + (lambda (key . args)
> + (emit-warning package (car args) 'home-page))))
> ((not (package-home-page package))
> (unless (or (string-contains (package-name package) "bootstrap")
> (string=? (package-name package) "ld-wrapper"))
> @@ -374,6 +381,27 @@ descriptions maintained upstream."
> (location->string loc) (package-full-name package)
> (fill-paragraph (escape-quotes upstream) 77 7)))))))
>
> +(define (check-source package)
> + ""
> + (let ((origin (package-source package)))
> + (when (and origin
> + (eqv? (origin-method origin) url-fetch))
> + (let* ((strings (origin-uri origin))
> + (uris (if (list? strings)
> + (map string->uri strings)
> + (list (string->uri strings)))))
> + (for-each
> + (lambda (uri)
> + (cond
> + ((uri? uri)
I think this would be more succint if match-lambda were used instead.
> + (catch 'not-available
> + (lambda () (uri-available? uri))
> + (lambda (key . args)
> + (emit-warning package (car args) 'home-page))))
> + (else
> + (error "internal source linter errorl"))))
s/errorl/error/
> + uris)))))
> +
> \f
> ;;;
> ;;; List of checkers.
> @@ -402,6 +430,10 @@ descriptions maintained upstream."
> (description "Validate home-page URLs")
> (check check-home-page))
> (lint-checker
> + (name 'source)
> + (description "Valide source URLs")
s/Valide/Validate/
> + (check check-source))
> + (lint-checker
> (name 'synopsis)
> (description "Validate package synopses")
> (check check-synopsis-style))))
> --
> 1.8.4.rc3
>
>
Thanks!
--
David Thompson
Web Developer - Free Software Foundation - http://fsf.org
GPG Key: 0FF1D807
Support the FSF: https://fsf.org/donate
^ permalink raw reply [flat|nested] 14+ messages in thread* Re: [PATCH] lint: add 'source' checker.
2014-12-29 3:40 ` [PATCH] lint: add 'source' checker Cyril Roelandt
2014-12-29 13:05 ` David Thompson
@ 2014-12-29 14:23 ` Ludovic Courtès
2015-01-03 2:43 ` Cyril Roelandt
2014-12-29 20:32 ` Ludovic Courtès
2015-01-15 7:52 ` [PATCHv2] " Cyril Roelandt
3 siblings, 1 reply; 14+ messages in thread
From: Ludovic Courtès @ 2014-12-29 14:23 UTC (permalink / raw)
To: Cyril Roelandt; +Cc: guix-devel
Cyril Roelandt <tipecaml@gmail.com> skribis:
> * guix/scripts/lint.scm (uri-available?): New procedure.
> (%checkers): Add 'home-page' checker
Some comments in addition to what David already wrote.
> +(define (uri-available? uri)
> + "Return #t if the given URI can be reached, otherwise throw a
> +'not-available exception along with an appropriate error message."
By convention, one would expect ‘uri-available?’ to return #t or #f, not
to throw.
How about calling it ‘validate-uri’ and directly call ‘emit-warning’
from there? It would need the field name as an additional argument.
> + (let-values (((status argument)
> + (probe-uri uri)))
> + (case status
> + ((http-response)
IMO ‘case’ is fine here.
> +(define (check-source package)
> + ""
Missing docstring.
Thanks!
Ludo’.
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: [PATCH] lint: add 'source' checker.
2014-12-29 14:23 ` Ludovic Courtès
@ 2015-01-03 2:43 ` Cyril Roelandt
2015-01-03 19:11 ` Ludovic Courtès
0 siblings, 1 reply; 14+ messages in thread
From: Cyril Roelandt @ 2015-01-03 2:43 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: guix-devel
On 12/29/2014 03:23 PM, Ludovic Courtès wrote:
> Cyril Roelandt <tipecaml@gmail.com> skribis:
>
>> * guix/scripts/lint.scm (uri-available?): New procedure.
>> (%checkers): Add 'home-page' checker
>
> Some comments in addition to what David already wrote.
>
>> +(define (uri-available? uri)
>> + "Return #t if the given URI can be reached, otherwise throw a
>> +'not-available exception along with an appropriate error message."
>
> By convention, one would expect ‘uri-available?’ to return #t or #f, not
> to throw.
>
> How about calling it ‘validate-uri’ and directly call ‘emit-warning’
> from there? It would need the field name as an additional argument.
>
This would also require passing the "package" to validate-uri. How about
we make uri-available? return #t/#f, and just don't really care about
the exact reason why it failed ? Anyway a human being is going to
manually check what happened to know whether this is a real issue or
just a server that went down for a couple hours, or a file that wrongly
got removed...
Cyril.
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: [PATCH] lint: add 'source' checker.
2015-01-03 2:43 ` Cyril Roelandt
@ 2015-01-03 19:11 ` Ludovic Courtès
0 siblings, 0 replies; 14+ messages in thread
From: Ludovic Courtès @ 2015-01-03 19:11 UTC (permalink / raw)
To: Cyril Roelandt; +Cc: guix-devel
Cyril Roelandt <tipecaml@gmail.com> skribis:
> On 12/29/2014 03:23 PM, Ludovic Courtès wrote:
>> Cyril Roelandt <tipecaml@gmail.com> skribis:
>>
>>> * guix/scripts/lint.scm (uri-available?): New procedure.
>>> (%checkers): Add 'home-page' checker
>>
>> Some comments in addition to what David already wrote.
>>
>>> +(define (uri-available? uri)
>>> + "Return #t if the given URI can be reached, otherwise throw a
>>> +'not-available exception along with an appropriate error message."
>>
>> By convention, one would expect ‘uri-available?’ to return #t or #f, not
>> to throw.
>>
>> How about calling it ‘validate-uri’ and directly call ‘emit-warning’
>> from there? It would need the field name as an additional argument.
>>
>
> This would also require passing the "package" to validate-uri.
Right, and I think it’s fine.
> How about we make uri-available? return #t/#f, and just don't really
> care about the exact reason why it failed ? Anyway a human being is
> going to manually check what happened to know whether this is a real
> issue or just a server that went down for a couple hours, or a file
> that wrongly got removed...
Possibly but still, I prefer to have detailed reports since we already
have all the details anyway.
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: [PATCH] lint: add 'source' checker.
2014-12-29 3:40 ` [PATCH] lint: add 'source' checker Cyril Roelandt
2014-12-29 13:05 ` David Thompson
2014-12-29 14:23 ` Ludovic Courtès
@ 2014-12-29 20:32 ` Ludovic Courtès
2015-01-15 7:52 ` [PATCHv2] " Cyril Roelandt
3 siblings, 0 replies; 14+ messages in thread
From: Ludovic Courtès @ 2014-12-29 20:32 UTC (permalink / raw)
To: Cyril Roelandt; +Cc: guix-devel
Cyril Roelandt <tipecaml@gmail.com> skribis:
> +(define (check-source package)
> + ""
> + (let ((origin (package-source package)))
> + (when (and origin
> + (eqv? (origin-method origin) url-fetch))
> + (let* ((strings (origin-uri origin))
> + (uris (if (list? strings)
> + (map string->uri strings)
> + (list (string->uri strings)))))
I realized while fixing it in list-packages.scm that mirror:// URIs
actually need to be expanded here. See commit 1c69e4c for an example.
Ludo’.
^ permalink raw reply [flat|nested] 14+ messages in thread
* [PATCHv2] lint: add 'source' checker.
2014-12-29 3:40 ` [PATCH] lint: add 'source' checker Cyril Roelandt
` (2 preceding siblings ...)
2014-12-29 20:32 ` Ludovic Courtès
@ 2015-01-15 7:52 ` Cyril Roelandt
2015-01-15 21:58 ` Ludovic Courtès
3 siblings, 1 reply; 14+ messages in thread
From: Cyril Roelandt @ 2015-01-15 7:52 UTC (permalink / raw)
To: guix-devel
* guix/scripts/lint.scm (validate-uri?): New procedure.
(%checkers): Add 'home-page' checker
---
guix/scripts/lint.scm | 102 +++++++++++++++++++++++++++++++++-----------------
1 file changed, 68 insertions(+), 34 deletions(-)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 15ae213..7a0b246 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -20,6 +20,7 @@
(define-module (guix scripts lint)
#:use-module (guix base32)
+ #:use-module (guix download)
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (guix ui)
@@ -31,7 +32,8 @@
#:use-module (ice-9 format)
#:use-module (web uri)
#:use-module ((guix build download)
- #:select (open-connection-for-uri))
+ #:select (maybe-expand-mirrors
+ open-connection-for-uri))
#:use-module (web request)
#:use-module (web response)
#:use-module (srfi srfi-1)
@@ -254,45 +256,53 @@ response from URI, and additional details, such as the actual HTTP response."
(_
(values 'not-http #f)))))
+(define (validate-uri uri package field)
+ "Return #t if the given URI can be reached, otherwise emit a
+warning for PACKAGE mentionning the FIELD."
+ (let-values (((status argument)
+ (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)))
+ ((getaddrinfo-error)
+ (emit-warning package
+ (format #f
+ (_ "URI ~a domain not found: ~a")
+ (uri->string uri)
+ (gai-strerror (car argument)))
+ field))
+ ((system-error)
+ (emit-warning package
+ (format #f
+ (_ "URI ~a unreachable: ~a")
+ (uri->string uri)
+ (strerror
+ (system-error-errno
+ (cons status argument))))
+ field))
+ ((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))
+
(define (check-home-page package)
"Emit a warning if PACKAGE has an invalid 'home-page' field, or if that
'home-page' is not reachable."
(let ((uri (and=> (package-home-page package) string->uri)))
(cond
((uri? uri)
- (let-values (((status argument)
- (probe-uri uri)))
- (case status
- ((http-response)
- (unless (= 200 (response-code argument))
- (emit-warning package
- (format #f
- (_ "home page ~a not reachable: ~a (~s)")
- (uri->string uri)
- (response-code argument)
- (response-reason-phrase argument))
- 'home-page)))
- ((getaddrinfo-error)
- (emit-warning package
- (format #f
- (_ "home page domain not found: ~a")
- (gai-strerror (car argument)))
- 'package))
- ((system-error)
- (emit-warning package
- (format #f
- (_ "home page unreachable: ~a")
- (strerror
- (system-error-errno
- (cons status argument))))
- 'home-page))
- ((invalid-http-response gnutls-error)
- ;; Probably a misbehaving server; ignore.
- #f)
- ((not-http) ;nothing we can do
- #f)
- (else
- (error "internal home-page linter error" status)))))
+ (validate-uri uri package 'home-page))
((not (package-home-page package))
(unless (or (string-contains (package-name package) "bootstrap")
(string=? (package-name package) "ld-wrapper"))
@@ -375,6 +385,26 @@ descriptions maintained upstream."
(location->string loc) (package-full-name package)
(fill-paragraph (escape-quotes upstream) 77 7)))))))
+(define (check-source package)
+ "Emit a warning if PACKAGE has an invalid 'source' field, or if that
+'source' is not reachable."
+ (let ((origin (package-source package)))
+ (when (and origin
+ (eqv? (origin-method origin) url-fetch))
+ (let* ((strings (origin-uri origin))
+ (uris (if (list? strings)
+ (map string->uri strings)
+ (list (string->uri strings)))))
+ (for-each
+ (match-lambda
+ ((? uri? uri)
+ (validate-uri uri package 'source))
+ (_ (error "internal linter error")))
+ (concatenate (map (lambda (uri)
+ (maybe-expand-mirrors uri %mirrors))
+ uris)))))))
+
+
\f
;;;
;;; List of checkers.
@@ -403,6 +433,10 @@ descriptions maintained upstream."
(description "Validate home-page URLs")
(check check-home-page))
(lint-checker
+ (name 'source)
+ (description "Validate source URLs")
+ (check check-source))
+ (lint-checker
(name 'synopsis)
(description "Validate package synopses")
(check check-synopsis-style))))
--
1.8.4.rc3
^ permalink raw reply related [flat|nested] 14+ messages in thread* Re: [PATCHv2] lint: add 'source' checker.
2015-01-15 7:52 ` [PATCHv2] " Cyril Roelandt
@ 2015-01-15 21:58 ` Ludovic Courtès
2015-01-23 9:56 ` Ludovic Courtès
0 siblings, 1 reply; 14+ messages in thread
From: Ludovic Courtès @ 2015-01-15 21:58 UTC (permalink / raw)
To: Cyril Roelandt; +Cc: guix-devel
Cyril Roelandt <tipecaml@gmail.com> skribis:
> * guix/scripts/lint.scm (validate-uri?): New procedure.
> (%checkers): Add 'home-page' checker
^^^^^
Typo.
> +(define (check-source package)
> + "Emit a warning if PACKAGE has an invalid 'source' field, or if that
> +'source' is not reachable."
> + (let ((origin (package-source package)))
> + (when (and origin
> + (eqv? (origin-method origin) url-fetch))
> + (let* ((strings (origin-uri origin))
> + (uris (if (list? strings)
> + (map string->uri strings)
> + (list (string->uri strings)))))
> + (for-each
> + (match-lambda
> + ((? uri? uri)
> + (validate-uri uri package 'source))
> + (_ (error "internal linter error")))
Just:
(for-each (cut validate-uri <> package 'source) ...)
> + (concatenate (map (lambda (uri)
> + (maybe-expand-mirrors uri %mirrors))
> + uris)))))))
Here:
(append-map (cut maybe-expand-mirrors <> %mirrors) uris)
OK to push with these changes, thank you!
The next step is to improve ‘probe-uri’ to handle FTP.
Ludo’.
^ permalink raw reply [flat|nested] 14+ messages in thread