Return the entire TLS certificate chain back to the caller

* src/gnutls.c (gnutls_deinit_certificates): New function.
(Fgnutls_peer_status): Return all certificates in the chain back
to Lisp land.
(gnutls_verify_boot): Compute all the x509 certificates in the
chain.

* src/process.h (struct Lisp_Process): Adjust gnutls fields so
that we can keep tracks of all certificates in the chain instead
of just the host certificate.

2 files changed, 77 insertions, 34 deletions

diff --git a/src/gnutls.c b/src/gnutls.c
index 903393fed18..5a178472ceb 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -819,6 +819,19 @@ gnutls_make_error (int err)
   return make_number (err);
 }
 
+static void
+gnutls_deinit_certificates (struct Lisp_Process *p)
+{
+  if (! p->gnutls_certificates)
+    return;
+
+  for (int i = 0; i < p->gnutls_certificates_length; i++)
+    gnutls_x509_crt_deinit (p->gnutls_certificates[i]);
+
+  xfree (p->gnutls_certificates);
+  p->gnutls_certificates = NULL;
+}
+
 Lisp_Object
 emacs_gnutls_deinit (Lisp_Object proc)
 {
@@ -853,6 +866,9 @@ emacs_gnutls_deinit (Lisp_Object proc)
         GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
     }
 
+  if (XPROCESS (proc)->gnutls_certificates)
+    gnutls_deinit_certificates (XPROCESS (proc));
+
   XPROCESS (proc)->gnutls_p = false;
   return Qt;
 }
@@ -1238,9 +1254,9 @@ The return value is a property list with top-level keys :warnings and
 
   /* This could get called in the INIT stage, when the certificate is
      not yet set. */
-  if (XPROCESS (proc)->gnutls_certificate != NULL &&
-      gnutls_x509_crt_check_issuer(XPROCESS (proc)->gnutls_certificate,
-                                   XPROCESS (proc)->gnutls_certificate))
+  if (XPROCESS (proc)->gnutls_certificates != NULL &&
+      gnutls_x509_crt_check_issuer(XPROCESS (proc)->gnutls_certificates[0],
+                                   XPROCESS (proc)->gnutls_certificates[0]))
     warnings = Fcons (intern (":self-signed"), warnings);
 
   if (!NILP (warnings))
@@ -1248,10 +1264,23 @@ The return value is a property list with top-level keys :warnings and
 
   /* This could get called in the INIT stage, when the certificate is
      not yet set. */
-  if (XPROCESS (proc)->gnutls_certificate != NULL)
-    result = nconc2 (result, list2
-                     (intern (":certificate"),
-                      gnutls_certificate_details (XPROCESS (proc)->gnutls_certificate)));
+  if (XPROCESS (proc)->gnutls_certificates != NULL)
+    {
+      Lisp_Object certs = Qnil;
+
+      /* Return the host certificate in its own element for
+         compatibility reasons. */
+      result = nconc2 (result, list2
+                       (intern (":certificate"),
+                        gnutls_certificate_details (XPROCESS (proc)->gnutls_certificates[0])));
+
+      /* Return all the certificates in a list. */
+      for (int i = 0; i < XPROCESS (proc)->gnutls_certificates_length; i++)
+        certs = nconc2 (certs, list1 (gnutls_certificate_details
+                                      (XPROCESS (proc)->gnutls_certificates[i])));
+
+      result = nconc2 (result, list2 (intern (":certificates"), certs));
+    }
 
   state = XPROCESS (proc)->gnutls_state;
 
@@ -1394,7 +1423,7 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist)
   if (ret < GNUTLS_E_SUCCESS)
     return gnutls_make_error (ret);
 
-  XPROCESS (proc)->gnutls_peer_verification = peer_verification;
+  p->gnutls_peer_verification = peer_verification;
 
   warnings = Fplist_get (Fgnutls_peer_status (proc), intern (":warnings"));
   if (!NILP (warnings))
@@ -1431,49 +1460,61 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist)
      can be easily extended to work with openpgp keys as well.  */
   if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
     {
-      gnutls_x509_crt_t gnutls_verify_cert;
-      const gnutls_datum_t *gnutls_verify_cert_list;
-      unsigned int gnutls_verify_cert_list_size;
-
-      ret = gnutls_x509_crt_init (&gnutls_verify_cert);
-      if (ret < GNUTLS_E_SUCCESS)
-        return gnutls_make_error (ret);
+      const gnutls_datum_t *cert_list;
+      unsigned int cert_list_length;
+      int failed_import = 0;
 
-      gnutls_verify_cert_list
-        = gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+      cert_list = gnutls_certificate_get_peers (state, &cert_list_length);
 
-      if (gnutls_verify_cert_list == NULL)
+      if (cert_list == NULL)
         {
-          gnutls_x509_crt_deinit (gnutls_verify_cert);
           emacs_gnutls_deinit (proc);
           boot_error (p, "No x509 certificate was found\n");
           return Qnil;
         }
 
-      /* Check only the first certificate in the given chain.  */
-      ret = gnutls_x509_crt_import (gnutls_verify_cert,
-                                    &gnutls_verify_cert_list[0],
-                                    GNUTLS_X509_FMT_DER);
+      /* Check only the first certificate in the given chain, but
+         store them all.  */
+      p->gnutls_certificates =
+        xmalloc (cert_list_length * sizeof (gnutls_x509_crt_t));
+      p->gnutls_certificates_length = cert_list_length;
 
-      if (ret < GNUTLS_E_SUCCESS)
+      for (int i = cert_list_length - 1; i >= 0; i--)
         {
-          gnutls_x509_crt_deinit (gnutls_verify_cert);
-          return gnutls_make_error (ret);
+          gnutls_x509_crt_t cert;
+
+          gnutls_x509_crt_init (&cert);
+
+          if (ret < GNUTLS_E_SUCCESS)
+            failed_import = ret;
+          else
+            {
+              ret = gnutls_x509_crt_import (cert, &cert_list[i],
+                                            GNUTLS_X509_FMT_DER);
+
+              if (ret < GNUTLS_E_SUCCESS)
+                failed_import = ret;
+            }
+
+          p->gnutls_certificates[i] = cert;
         }
 
-      XPROCESS (proc)->gnutls_certificate = gnutls_verify_cert;
+      if (failed_import != 0)
+        {
+          gnutls_deinit_certificates (p);
+          p->gnutls_certificates = NULL;
+          return gnutls_make_error (failed_import);
+        }
 
-      int err = gnutls_x509_crt_check_hostname (gnutls_verify_cert,
+      int err = gnutls_x509_crt_check_hostname (p->gnutls_certificates[0],
                                                 c_hostname);
       check_memory_full (err);
       if (!err)
         {
-          XPROCESS (proc)->gnutls_extra_peer_verification
-            |= CERTIFICATE_NOT_MATCHING;
+          p->gnutls_extra_peer_verification |= CERTIFICATE_NOT_MATCHING;
           if (verify_error_all
               || !NILP (Fmember (QChostname, verify_error)))
             {
-              gnutls_x509_crt_deinit (gnutls_verify_cert);
               emacs_gnutls_deinit (proc);
               boot_error (p, "The x509 certificate does not match \"%s\"",
                           c_hostname);
@@ -1486,7 +1527,7 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist)
     }
 
   /* Set this flag only if the whole initialization succeeded.  */
-  XPROCESS (proc)->gnutls_p = true;
+  p->gnutls_p = true;
 
   return gnutls_make_error (ret);
 }
@@ -1855,7 +1896,8 @@ This function may also return `gnutls-e-again', or
 
   state = XPROCESS (proc)->gnutls_state;
 
-  gnutls_x509_crt_deinit (XPROCESS (proc)->gnutls_certificate);
+  if (XPROCESS (proc)->gnutls_certificates)
+    gnutls_deinit_certificates (XPROCESS (proc));
 
   ret = gnutls_bye (state, NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR);
 
diff --git a/src/process.h b/src/process.h
index 42cc66ec560..6bc22146a72 100644
--- a/src/process.h
+++ b/src/process.h
@@ -194,7 +194,8 @@ struct Lisp_Process
     gnutls_session_t gnutls_state;
     gnutls_certificate_client_credentials gnutls_x509_cred;
     gnutls_anon_client_credentials_t gnutls_anon_cred;
-    gnutls_x509_crt_t gnutls_certificate;
+    gnutls_x509_crt_t *gnutls_certificates;
+    int gnutls_certificates_length;
     unsigned int gnutls_peer_verification;
     unsigned int gnutls_extra_peer_verification;
     int gnutls_log_level;