X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/20be23c3b67dd181a2c4b468626490a7eb74e492..727a9a5bd48f214dcbcffbf8eb2be34a030f85d2:/tests/lint.scm

diff --git a/tests/lint.scm b/tests/lint.scm
index 9bc42990ef..ce751c42c9 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -102,14 +102,14 @@
   http-write
   (@@ (web server http) http-close))
 
-(define (call-with-http-server code thunk)
-  "Call THUNK with an HTTP server running and returning CODE on HTTP
-requests."
+(define (call-with-http-server code data thunk)
+  "Call THUNK with an HTTP server running and returning CODE and DATA (a
+string) on HTTP requests."
   (define (server-body)
     (define (handle request body)
       (values (build-response #:code code
                               #:reason-phrase "Such is life")
-              "Hello, world."))
+              data))
 
     (catch 'quit
       (lambda ()
@@ -123,8 +123,11 @@ requests."
       ;; Normally SERVER exits automatically once it has received a request.
       (thunk))))
 
-(define-syntax-rule (with-http-server code body ...)
-  (call-with-http-server code (lambda () body ...)))
+(define-syntax-rule (with-http-server code data body ...)
+  (call-with-http-server code data (lambda () body ...)))
+
+(define %long-string
+  (make-string 2000 #\a))
 
 
 (test-begin "lint")
@@ -402,18 +405,30 @@ requests."
 (test-equal "home-page: 200"
   ""
   (with-warnings
-   (with-http-server 200
+   (with-http-server 200 %long-string
      (let ((pkg (package
                   (inherit (dummy-package "x"))
                   (home-page %local-url))))
        (check-home-page pkg)))))
 
+(test-skip (if %http-server-socket 0 1))
+(test-assert "home-page: 200 but short length"
+  (->bool
+   (string-contains
+    (with-warnings
+      (with-http-server 200 "This is too small."
+        (let ((pkg (package
+                     (inherit (dummy-package "x"))
+                     (home-page %local-url))))
+          (check-home-page pkg))))
+    "suspiciously small")))
+
 (test-skip (if %http-server-socket 0 1))
 (test-assert "home-page: 404"
   (->bool
    (string-contains
     (with-warnings
-      (with-http-server 404
+      (with-http-server 404 %long-string
         (let ((pkg (package
                      (inherit (dummy-package "x"))
                      (home-page %local-url))))
@@ -501,7 +516,7 @@ requests."
 (test-equal "source: 200"
   ""
   (with-warnings
-   (with-http-server 200
+   (with-http-server 200 %long-string
      (let ((pkg (package
                   (inherit (dummy-package "x"))
                   (source (origin
@@ -510,12 +525,27 @@ requests."
                             (sha256 %null-sha256))))))
        (check-source pkg)))))
 
+(test-skip (if %http-server-socket 0 1))
+(test-assert "source: 200 but short length"
+  (->bool
+   (string-contains
+    (with-warnings
+      (with-http-server 200 "This is too small."
+        (let ((pkg (package
+                     (inherit (dummy-package "x"))
+                     (source (origin
+                               (method url-fetch)
+                               (uri %local-url)
+                               (sha256 %null-sha256))))))
+          (check-source pkg))))
+    "suspiciously small")))
+
 (test-skip (if %http-server-socket 0 1))
 (test-assert "source: 404"
   (->bool
    (string-contains
     (with-warnings
-      (with-http-server 404
+      (with-http-server 404 %long-string
         (let ((pkg (package
                      (inherit (dummy-package "x"))
                      (source (origin
@@ -559,6 +589,25 @@ requests."
                              (patches
                               (list "/a/b/pi-CVE-2015-1234.patch"))))))))))
 
+(test-assert "cve: patched vulnerability in replacement"
+  (mock ((guix scripts lint) package-vulnerabilities
+         (lambda (package)
+           (list (make-struct (@@ (guix cve) <vulnerability>) 0
+                              "CVE-2015-1234"
+                              (list (cons (package-name package)
+                                          (package-version package)))))))
+        (string-null?
+         (with-warnings
+           (check-vulnerabilities
+            (dummy-package
+             "pi" (version "3.14") (source (dummy-origin))
+             (replacement (dummy-package
+                           "pi" (version "3.14")
+                           (source
+                            (dummy-origin
+                             (patches
+                              (list "/a/b/pi-CVE-2015-1234.patch"))))))))))))
+
 (test-assert "formatting: lonely parentheses"
   (string-contains
    (with-warnings
@@ -598,6 +647,6 @@ requests."
 (test-end "lint")
 
 ;; Local Variables:
-;; eval: (put 'with-http-server 'scheme-indent-function 1)
+;; eval: (put 'with-http-server 'scheme-indent-function 2)
 ;; eval: (put 'with-warnings 'scheme-indent-function 0)
 ;; End: