From bfcb3d767bbc24dc6c6d834619073351fbcc61b5 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 13 Jul 2016 00:50:05 +0200
Subject: lint: 'validate-uri' reports suspiciously small 200 responses.

* guix/scripts/lint.scm (validate-uri): Upon 200 http-response, check
the 'response-content-length' and emit a warning when it is <= 1000.
* tests/lint.scm (call-with-http-server): Add 'data' parameter.
(with-http-server): Likewise.
(%long-string): New variable.
("home-page: 200"): Pass %LONG-STRING to 'with-http-server'.
("home-page: 404", "source: 200", "source: 404"): Likewise.
("home-page: 200 but short length"): New test.
("source: 200 but short length"): New test.
---
 guix/scripts/lint.scm | 17 ++++++++++++++++-
 1 file changed, 16 insertions(+), 1 deletion(-)

(limited to 'guix')

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index b4fdb6f905..d5e9197cc9 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -359,7 +359,22 @@ warning for PACKAGE mentionning the FIELD."
                 (probe-uri uri #:timeout 3)))     ;wait at most 3 seconds
     (case status
       ((http-response)
-       (or (= 200 (response-code argument))
+       (if (= 200 (response-code argument))
+           (match (response-content-length argument)
+             ((? number? length)
+              ;; As of July 2016, SourceForge returns 200 (instead of 404)
+              ;; with a small HTML page upon failure.  Attempt to detect such
+              ;; malicious behavior.
+              (or (> length 1000)
+                  (begin
+                    (emit-warning package
+                                  (format #f
+                                          (_ "URI ~a returned \
+suspiciously small file (~a bytes)")
+                                          (uri->string uri)
+                                          length))
+                    #f)))
+             (_ #t))
            (begin
              (emit-warning package
                            (format #f
-- 
cgit v1.2.3