From mboxrd@z Thu Jan 1 00:00:00 1970 From: Cyril Roelandt Subject: [PATCH] lint: handle FTP URIs. Date: Wed, 28 Jan 2015 19:51:07 +0100 Message-ID: <1422471067-32400-1-git-send-email-tipecaml@gmail.com> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:40807) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YGXhy-0004So-FZ for guix-devel@gnu.org; Wed, 28 Jan 2015 13:51:23 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YGXhv-0006M6-95 for guix-devel@gnu.org; Wed, 28 Jan 2015 13:51:22 -0500 Received: from mail-wi0-x231.google.com ([2a00:1450:400c:c05::231]:46711) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YGXhv-0006Lt-29 for guix-devel@gnu.org; Wed, 28 Jan 2015 13:51:19 -0500 Received: by mail-wi0-f177.google.com with SMTP id r20so14017320wiv.4 for ; Wed, 28 Jan 2015 10:51:18 -0800 (PST) List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: guix-devel@gnu.org * guix/scripts/lint.scm (probe-uri): handle FTP URIs. --- guix/scripts/lint.scm | 32 ++++++++++++++++++++++++++++++-- 1 file changed, 30 insertions(+), 2 deletions(-) diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 9d5c689..1e8f0ad 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -21,6 +21,7 @@ (define-module (guix scripts lint) #:use-module (guix base32) #:use-module (guix download) + #:use-module (guix ftp-client) #:use-module (guix packages) #:use-module (guix records) #:use-module (guix ui) @@ -254,8 +255,29 @@ response from URI, and additional details, such as the actual HTTP response." (values key args)) (else (apply throw key args)))))) + ('ftp + (catch #t + (lambda () + (let ((port (ftp-open (uri-host uri) 21))) + (define response + (dynamic-wind + (const #f) + (lambda () + (ftp-chdir port (dirname (uri-path uri))) + (ftp-size port (basename (uri-path uri)))) + (lambda () + (ftp-close port)))) + (values 'ftp-response #t))) + (lambda (key . args) + (case key + ((or ftp-error) + (values 'ftp-response #f)) + ((getaddrinfo-error system-error gnutls-error) + (values key args)) + (else + (apply throw key args)))))) (_ - (values 'not-http #f))))) + (values 'unknown-protocol #f))))) (define (validate-uri uri package field) "Return #t if the given URI can be reached, otherwise emit a @@ -272,6 +294,12 @@ warning for PACKAGE mentionning the FIELD." (response-code argument) (response-reason-phrase argument)) field))) + ((ftp-response) + (when (not argument) + (emit-warning package + (format #f + (_ "URI ~a not reachable") + (uri->string uri))))) ((getaddrinfo-error) (emit-warning package (format #f @@ -293,7 +321,7 @@ warning for PACKAGE mentionning the FIELD." ((invalid-http-response gnutls-error) ;; Probably a misbehaving server; ignore. #f) - ((not-http) ;nothing we can do + ((unknown-protocol) ;nothing we can do #f) (else (error "internal linter error" status))))) -- 1.8.4.rc3