From c169d91e5a0be92b6bd48a8fd98c43078d2a12ef Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 9 Nov 2016 16:27:29 +0100
Subject: lint: 'cve' checker catches 'tls-certificate-error'.

Reported by Frederick Muriithi <fredmanglis@gmail.com>.

* guix/scripts/lint.scm (tls-certificate-error-string): New procedure.
(validate-uri): Use it.
(current-vulnerabilities*): Catch 'tls-certificate-error' and print a
warning.
---
 guix/scripts/lint.scm | 36 +++++++++++++++++++++++-------------
 1 file changed, 23 insertions(+), 13 deletions(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 049c297224..6e6f550941 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -398,6 +398,13 @@ for connections to complete; when TIMEOUT is #f, wait as long as needed."
       (_
        (values 'unknown-protocol #f)))))
 
+(define (tls-certificate-error-string args)
+  "Return a string explaining the 'tls-certificate-error' arguments ARGS."
+  (call-with-output-string
+    (lambda (port)
+      (print-exception port #f
+                       'tls-certificate-error args))))
+
 (define (validate-uri uri package field)
   "Return #t if the given URI can be reached, otherwise return #f and emit a
 warning for PACKAGE mentionning the FIELD."
@@ -460,13 +467,8 @@ suspiciously small file (~a bytes)")
        #f)
       ((tls-certificate-error)
        (emit-warning package
-                     (format #f
-                             (_ "TLS certificate error: ~a")
-                             (call-with-output-string
-                               (lambda (port)
-                                 (print-exception port #f
-                                                  'tls-certificate-error
-                                                  argument))))))
+                     (format #f (_ "TLS certificate error: ~a")
+                             (tls-certificate-error-string argument))))
       ((invalid-http-response gnutls-error)
        ;; Probably a misbehaving server; ignore.
        #f)
@@ -682,14 +684,22 @@ from ~s: ~a (~s)~%")
                       (http-get-error-reason c))
              (warning (_ "assuming no CVE vulnerabilities~%"))
              '()))
-    (catch 'getaddrinfo-error
+    (catch #t
       (lambda ()
         (current-vulnerabilities))
-      (lambda (key errcode)
-        (warning (_ "failed to lookup NIST host: ~a~%")
-                 (gai-strerror errcode))
-        (warning (_ "assuming no CVE vulnerabilities~%"))
-        '()))))
+      (match-lambda*
+        (('getaddrinfo-error errcode)
+         (warning (_ "failed to lookup NIST host: ~a~%")
+                  (gai-strerror errcode))
+         (warning (_ "assuming no CVE vulnerabilities~%"))
+         '())
+        (('tls-certificate-error args ...)
+         (warning (_ "TLS certificate error: ~a")
+                  (tls-certificate-error-string args))
+         (warning (_ "assuming no CVE vulnerabilities~%"))
+         '())
+        (args
+         (apply throw args))))))
 
 (define package-vulnerabilities
   (let ((lookup (delay (vulnerabilities->lookup-proc
-- 
cgit v1.2.3

ages/xfig.scm?id=6c91c0f3462207ff331e1caf3ba32304be218727'>gnu: transfig: Return #t from phases.</a><span class='msg-avail'>...</span></td><td>Tobias Geerinckx-Rice</td></tr>
<tr><td><span title='2018-04-16 18:45:07 +0200'>2018-04-16</span></td><td><a href='/guix/commit/gnu/packages/xfig.scm?id=eb357e24f7bbbb0348047f427d196e078c605f04'>gnu: xfig: Update to 3.2.7.</a><span class='msg-avail'>...</span></td><td>Tobias Geerinckx-Rice</td></tr>
<tr><td><span title='2017-12-12 22:34:29 +0100'>2017-12-12</span></td><td><a href='/guix/commit/gnu/packages/xfig.scm?id=a7ebe9dc39450efef2543ff7315c69811f9fa6f4'>gnu: xfig: Update to 3.2.6a.</a><span class='msg-avail'>...</span></td><td>Tobias Geerinckx-Rice</td></tr>
<tr><td><span title='2017-12-12 05:12:14 +0100'>2017-12-12</span></td><td><a href='/guix/commit/gnu/packages/xfig.scm?id=6e119bad60b3c1aa3b13f5b6d7e8c2987d3453d0'>gnu: xfig, transfig: Update home pages.</a><span class='msg-avail'>...</span></td><td>Tobias Geerinckx-Rice</td></tr>
<tr><td><span title='2017-12-02 15:06:02 +0100'>2017-12-02</span></td><td><a href='/guix/commit/gnu/packages/xfig.scm?id=63b31b567e4716e6dacb764847f5cdebcb9ed8e5'>gnu: xfig: Don't ignore 'xmkmf' exit code.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>