Make URL pass the TLS peer status to the caller

* lisp/url/url-http.el (url-http-parse-headers): Pass the GnuTLS
status of the connection to the caller.

diff --git a/etc/NEWS b/etc/NEWS
index 56036f8e5334865ce3fd27281cc5ef87d4957fa2..2b407775d4c4f9aa8c83ba4290e8236f4341daa4 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -328,6 +328,10 @@ a function.
 to specify that we're running in a noninteractive context, and that
 we should not be queried about things like TLS certificate validity.
 
+*** If URL is used with a https connection, the first callback argument
+plist will contain a :peer element that has the output of
+`gnutls-peer-status' (if Emacs is built with GnuTLS support).
+
 ** Tramp
 
 *** New connection method "nc", which allows to access dumb busyboxes.

diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index b39c67effbbb86e4a27a38caab9510146fe8317e..d544cf0d08355c82be141a2e42473f59857d135a 100644 (file)
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,8 @@
+2014-12-09  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * url-http.el (url-http-parse-headers): Pass the GnuTLS status of
+       the connection to the caller.
+
 2014-12-08  Stefan Monnier  <monnier@iro.umontreal.ca>
 
        * url-http.el (url-http-activate-callback): Make debug more verbose.

diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 3d5b6be80ac9b98222d53722b9643b1e6fc4e0f3..f5a214a89d8bb727bf17ddfce6f0512ed33238c7 100644 (file)
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -25,7 +25,9 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl-lib))
+(eval-when-compile
+  (require 'cl-lib)
+  (require 'subr-x))
 
 (defvar url-callback-arguments)
 (defvar url-callback-function)
@@ -492,7 +494,12 @@ should be shown to the user."
   (url-http-mark-connection-as-free (url-host url-current-object)
                                    (url-port url-current-object)
                                    url-http-process)
-
+  ;; Pass the certificate on to the caller.
+  (when (gnutls-available-p)
+    (when-let (status (gnutls-peer-status url-http-process))
+      (setcar url-callback-arguments
+             (plist-put (car url-callback-arguments)
+                        :peer status))))
   (if (or (not (boundp 'url-http-end-of-headers))
          (not url-http-end-of-headers))
       (error "Trying to parse headers in odd buffer: %s" (buffer-name)))