Function: gnutls-peer-status

gnutls-peer-status is a function defined in gnutls.c.

Signature

(gnutls-peer-status PROC)

Documentation

Describe a GnuTLS PROC peer certificate and any warnings about it.

The return value is a property list with top-level keys :warnings and
:certificates.

The :warnings entry is a list of symbols you can get a description of with gnutls-peer-status-warning-describe, and :certificates is the certificate chain for the connection, with the host certificate first, and intermediary certificates (if any) following it.

In addition, for backwards compatibility, the host certificate is also returned as the :certificate entry.

Probably introduced at or before Emacs version 25.1.

Source Code

// Defined in /usr/src/emacs/src/gnutls.c
{
  Lisp_Object warnings = Qnil, result = Qnil;
  unsigned int verification;
  gnutls_session_t state;

  CHECK_PROCESS (proc);

  if (GNUTLS_INITSTAGE (proc) != GNUTLS_STAGE_READY)
    return Qnil;

  /* Then collect any warnings already computed by the handshake. */
  verification = XPROCESS (proc)->gnutls_peer_verification;

  if (verification & GNUTLS_CERT_INVALID)
    warnings = Fcons (QCinvalid, warnings);

  if (verification & GNUTLS_CERT_REVOKED)
    warnings = Fcons (QCrevoked, warnings);

  if (verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
    warnings = Fcons (QCunknown_ca, warnings);

  if (verification & GNUTLS_CERT_SIGNER_NOT_CA)
    warnings = Fcons (QCnot_ca, warnings);

  if (verification & GNUTLS_CERT_INSECURE_ALGORITHM)
    warnings = Fcons (QCinsecure, warnings);

  if (verification & GNUTLS_CERT_NOT_ACTIVATED)
    warnings = Fcons (QCnot_activated, warnings);

  if (verification & GNUTLS_CERT_EXPIRED)
    warnings = Fcons (QCexpired, warnings);

# if GNUTLS_VERSION_NUMBER >= 0x030100
  if (verification & GNUTLS_CERT_SIGNATURE_FAILURE)
    warnings = Fcons (QCsignature_failure, warnings);

#  if GNUTLS_VERSION_NUMBER >= 0x030114
  if (verification & GNUTLS_CERT_REVOCATION_DATA_SUPERSEDED)
    warnings = Fcons (QCrevocation_data_superseded, warnings);

  if (verification & GNUTLS_CERT_REVOCATION_DATA_ISSUED_IN_FUTURE)
    warnings = Fcons (QCrevocation_data_issued_in_future, warnings);

  if (verification & GNUTLS_CERT_SIGNER_CONSTRAINTS_FAILURE)
    warnings = Fcons (QCsigner_constraints_failure, warnings);

#   if GNUTLS_VERSION_NUMBER >= 0x030400
  if (verification & GNUTLS_CERT_PURPOSE_MISMATCH)
    warnings = Fcons (QCpurpose_mismatch, warnings);

#    if GNUTLS_VERSION_NUMBER >= 0x030501
  if (verification & GNUTLS_CERT_MISSING_OCSP_STATUS)
    warnings = Fcons (QCmissing_ocsp_status, warnings);

  if (verification & GNUTLS_CERT_INVALID_OCSP_STATUS)
    warnings = Fcons (QCinvalid_ocsp_status, warnings);
#    endif
#   endif
#  endif
# endif

  if (XPROCESS (proc)->gnutls_extra_peer_verification &
      CERTIFICATE_NOT_MATCHING)
    warnings = Fcons (QCno_host_match, warnings);

  /* This could get called in the INIT stage, when the certificate is
     not yet set. */
  if (XPROCESS (proc)->gnutls_certificates != NULL &&
      gnutls_x509_crt_check_issuer(XPROCESS (proc)->gnutls_certificates[0],
                                   XPROCESS (proc)->gnutls_certificates[0]))
    warnings = Fcons (QCself_signed, warnings);

  if (!NILP (warnings))
    result = list2 (QCwarnings, warnings);

  /* This could get called in the INIT stage, when the certificate is
     not yet set. */
  if (XPROCESS (proc)->gnutls_certificates != NULL)
    {
      Lisp_Object certs = Qnil;

      /* Return all the certificates in a list. */
      for (int i = 0; i < XPROCESS (proc)->gnutls_certificates_length; i++)
	certs = nconc2 (certs, list1 (emacs_gnutls_certificate_details
				      (XPROCESS (proc)->gnutls_certificates[i])));

      result = nconc2 (result, list2 (QCcertificates, certs));

      /* Return the host certificate in its own element for
	 compatibility reasons. */
      result = nconc2 (result, list2 (QCcertificate, Fcar (certs)));
    }

  state = XPROCESS (proc)->gnutls_state;

  /* Diffie-Hellman prime bits. */
  {
    int bits = gnutls_dh_get_prime_bits (state);
    check_memory_full (bits);
    if (bits > 0)
      result = nconc2 (result, list2 (QCdiffie_hellman_prime_bits,
				      make_fixnum (bits)));
  }

  /* Key exchange. */
  result = nconc2
    (result, list2 (QCkey_exchange,
		    build_string (gnutls_kx_get_name
				  (gnutls_kx_get (state)))));

  /* Protocol name. */
  gnutls_protocol_t proto = gnutls_protocol_get_version (state);
  result = nconc2
    (result, list2 (QCprotocol,
		    build_string (gnutls_protocol_get_name (proto))));

  /* Cipher name. */
  result = nconc2
    (result, list2 (QCcipher,
		    build_string (gnutls_cipher_get_name
				  (gnutls_cipher_get (state)))));

  /* MAC name. */
  result = nconc2
    (result, list2 (QCmac,
		    build_string (gnutls_mac_get_name
				  (gnutls_mac_get (state)))));

  /* Compression name. */
# ifdef HAVE_GNUTLS_COMPRESSION_GET
  result = nconc2
    (result, list2 (QCcompression,
		    build_string (gnutls_compression_get_name
				  (gnutls_compression_get (state)))));
# endif

  /* Encrypt-then-MAC. */
# ifdef HAVE_GNUTLS_ETM_STATUS
  result = nconc2
    (result, list2 (QCencrypt_then_mac,
		    gnutls_session_etm_status (state) ? Qt : Qnil));
# endif

  /* Renegotiation Indication */
  if (proto <= GNUTLS_TLS1_2)
    result = nconc2
      (result, list2 (QCsafe_renegotiation,
		      gnutls_safe_renegotiation_status (state) ? Qt : Qnil));

  return result;
}