summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog4
-rw-r--r--src/gnutls.c120
2 files changed, 69 insertions, 55 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 220c2bfd771..922b61a92e3 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,6 +1,10 @@
2014-11-25 Teodor Zlatanov <tzz@lifelogs.com>
* gnutls.c (Fgnutls_peer_status): Check GNUTLS_INITSTAGE, not gnutls_p.
+ (Fgnutls_peer_status_warning_describe): Add function to describe a
+ peer verification warning symbol.
+ (Fgnutls_peer_status): Use it.
+ (Fgnutls_boot): Use it.
2014-11-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
diff --git a/src/gnutls.c b/src/gnutls.c
index bfa6078eabd..604c595622d 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -968,9 +968,44 @@ gnutls_certificate_details (gnutls_x509_crt_t cert)
return res;
}
+DEFUN ("gnutls-peer-status-warning-describe", Fgnutls_peer_status_warning_describe, Sgnutls_peer_status_warning_describe, 1, 1, 0,
+ doc: /* Describe the warning of a GnuTLS peer status from `gnutls-peer-status'.*/)
+ (Lisp_Object status_symbol)
+{
+ CHECK_SYMBOL (status_symbol);
+
+ if ( EQ (status_symbol, intern (":invalid")))
+ return build_string ("certificate could not be verified");
+
+ if ( EQ (status_symbol, intern (":revoked")) )
+ return build_string ("certificate was revoked (CRL)");
+
+ if ( EQ (status_symbol, intern (":self-signed")) )
+ return build_string ("certificate signer was not found (self-signed)");
+
+ if ( EQ (status_symbol, intern (":not-ca")) )
+ return build_string ("certificate signer is not a CA");
+
+ if ( EQ (status_symbol, intern (":insecure")) )
+ return build_string ("certificate was signed with an insecure algorithm");
+
+ if ( EQ (status_symbol, intern (":not-activated")) )
+ return build_string ("certificate is not yet activated");
+
+ if ( EQ (status_symbol, intern (":expired")) )
+ return build_string ("certificate has expired");
+
+ if ( EQ (status_symbol, intern (":no-host-match")) )
+ return build_string ("certificate host does not match hostname");
+
+ return Qnil;
+}
+
DEFUN ("gnutls-peer-status", Fgnutls_peer_status, Sgnutls_peer_status, 1, 1, 0,
- doc: /* Return the status of the gnutls PROC peer certificate.
-The return value is a property list. */)
+ doc: /* Describe a GnuTLS PROC peer certificate and any warnings about it.
+The return value is a property list with top-level keys :warnings and
+:certificate. The :warnings entry is a list of symbols you can describe with
+`gnutls-peer-status-warning-describe'. */)
(Lisp_Object proc)
{
Lisp_Object warnings = Qnil, result = Qnil;
@@ -985,52 +1020,39 @@ The return value is a property list. */)
verification = XPROCESS (proc)->gnutls_peer_verification;
if (verification & GNUTLS_CERT_INVALID)
- warnings = Fcons (list2 (intern (":invalid"),
- build_string("certificate could not be verified")),
- warnings);
+ warnings = Fcons (intern (":invalid"), warnings);
if (verification & GNUTLS_CERT_REVOKED)
- warnings = Fcons (list2 (intern (":revoked"),
- build_string("certificate was revoked (CRL)")),
- warnings);
+ warnings = Fcons (intern (":revoked"), warnings);
if (verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
- warnings = Fcons (list2 (intern (":self-signed"),
- build_string("certificate signer was not found (self-signed)")),
- warnings);
+ warnings = Fcons (intern (":self-signed"), warnings);
if (verification & GNUTLS_CERT_SIGNER_NOT_CA)
- warnings = Fcons (list2 (intern (":not-ca"),
- build_string("certificate signer is not a CA")),
- warnings);
+ warnings = Fcons (intern (":not-ca"), warnings);
if (verification & GNUTLS_CERT_INSECURE_ALGORITHM)
- warnings = Fcons (list2 (intern (":insecure"),
- build_string("certificate was signed with an insecure algorithm")),
- warnings);
+ warnings = Fcons (intern (":insecure"), warnings);
if (verification & GNUTLS_CERT_NOT_ACTIVATED)
- warnings = Fcons (list2 (intern (":not-activated"),
- build_string("certificate is not yet activated")),
- warnings);
+ warnings = Fcons (intern (":not-activated"), warnings);
if (verification & GNUTLS_CERT_EXPIRED)
- warnings = Fcons (list2 (intern (":expired"),
- build_string("certificate has expired")),
- warnings);
+ warnings = Fcons (intern (":expired"), warnings);
if (XPROCESS (proc)->gnutls_extra_peer_verification &
CERTIFICATE_NOT_MATCHING)
- warnings = Fcons (list2 (intern (":no-host-match"),
- build_string("certificate host does not match hostname")),
- warnings);
+ warnings = Fcons (intern (":no-host-match"), warnings);
if (!NILP (warnings))
result = list2 (intern (":warnings"), warnings);
- result = nconc2 (result, list2
- (intern (":certificate"),
- gnutls_certificate_details(XPROCESS (proc)->gnutls_certificate)));
+ /* 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)));
return result;
}
@@ -1148,6 +1170,8 @@ one trustfile (usually a CA bundle). */)
Lisp_Object hostname;
Lisp_Object verify_error;
Lisp_Object prime_bits;
+ Lisp_Object warnings;
+ Lisp_Object warning;
CHECK_PROCESS (proc);
CHECK_SYMBOL (type);
@@ -1392,33 +1416,19 @@ one trustfile (usually a CA bundle). */)
XPROCESS (proc)->gnutls_peer_verification = peer_verification;
- if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID)
- message ("%s certificate could not be verified.", c_hostname);
-
- if (peer_verification & GNUTLS_CERT_REVOKED)
- GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):",
- c_hostname);
-
- if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
- GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:",
- c_hostname);
-
- if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
- GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:",
- c_hostname);
-
- if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
- GNUTLS_LOG2 (1, max_log_level,
- "certificate was signed with an insecure algorithm:",
- c_hostname);
-
- if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
- GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:",
- c_hostname);
+ warnings = Fplist_get (Fgnutls_peer_status (proc), intern (":warnings"));
+ if ( !NILP (warnings) )
+ {
+ Lisp_Object tail;
- if (peer_verification & GNUTLS_CERT_EXPIRED)
- GNUTLS_LOG2 (1, max_log_level, "certificate has expired:",
- c_hostname);
+ for (tail = warnings; CONSP (tail); tail = XCDR (tail))
+ {
+ Lisp_Object warning = XCAR (tail);
+ Lisp_Object message = Fgnutls_peer_status_warning_describe (warning);
+ if ( !NILP (message) )
+ GNUTLS_LOG2 (1, max_log_level, "verification: %s", SDATA(message));
+ }
+ }
if (peer_verification != 0)
{