Function: gnutls-peer-status

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

Signature

(gnutls-peer-status PROC)

Documentation

Describe GnuTLS peer certificate of PROC 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 whose descriptions can be obtained with gnutls-peer-status-warning-describe.

The :certificates entry 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.

The list in :certificates entry can also include one or more of the properties of the TLS connection, when applicable, using the following keys:

  :cipher a string naming the cipher algorithm, or "NULL"

  :compression a string naming the compression algorithm, or "NULL"

  :diffie-hellman-prime-bits
the number if bits used in Diffie-Hellman key exchange,
an integer

  :encrypt-then-mac t if encrypt-then-mac negotiation was successful,
                         nil otherwise

  :key-exchange key exchange algorithm, a string

  :mac a string naming the MAC algorithm, or "NULL"

  :protocol TLS protocol version as a string

  :safe-renegotiation t if safe renegotiation is used, otherwise nil

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;
}