Function: gnutls-boot

gnutls-boot is a function defined in gnutls.c.

Signature

(gnutls-boot PROC TYPE PROPLIST)

Documentation

Initialize GnuTLS client for process PROC with TYPE+PROPLIST.

Currently only client mode is supported. Return a success/failure value you can check with gnutls-errorp.

TYPE is a symbol, either gnutls-anon or gnutls-x509pki. PROPLIST is a property list with the following keys:

:hostname is a string naming the remote host.

:priority is a GnuTLS priority string, defaults to "NORMAL".

:trustfiles is a list of PEM-encoded trust files for gnutls-x509pki.

:crlfiles is a list of PEM-encoded CRL lists for gnutls-x509pki.

:keylist is an alist of PEM-encoded key files and PEM-encoded
certificates for gnutls-x509pki.

:callbacks is an alist of callback functions, see below.

:loglevel is the debug level requested from GnuTLS, try 4.

:verify-flags is a bitset as per GnuTLS'
gnutls_certificate_set_verify_flags.

:verify-hostname-error is ignored. Pass :hostname in :verify-error
instead.

:verify-error is a list of symbols to express verification checks or
t to do all checks. Currently it can contain :trustfiles and
:hostname to verify the certificate or the hostname respectively.

:min-prime-bits is the minimum accepted number of bits the client will
accept in Diffie-Hellman key exchange.

:complete-negotiation, if non-nil, will make negotiation complete
before returning even on non-blocking sockets.

:pass, the password of the private key as per GnuTLS'
gnutls_certificate_set_x509_key_file2. Specify as nil to have a NULL password.

:flags, a list of symbols relating to :pass, each specifying a flag:
GNUTLS_PKCS_PLAIN, GNUTLS_PKCS_PKCS12_3DES, GNUTLS_PKCS_PKCS12_ARCFOUR, GNUTLS_PKCS_PKCS12_RC2_40, GNUTLS_PKCS_PBES2_3DES, GNUTLS_PKCS_PBES2_AES_128, GNUTLS_PKCS_PBES2_AES_192, GNUTLS_PKCS_PBES2_AES_256, GNUTLS_PKCS_NULL_PASSWORD, GNUTLS_PKCS_PBES2_DES, GNUTLS_PKCS_PBES2_DES_MD5, GNUTLS_PKCS_PBES2_GOST_TC26Z, GNUTLS_PKCS_PBES2_GOST_CPA, GNUTLS_PKCS_PBES2_GOST_CPB, GNUTLS_PKCS_PBES2_GOST_CPC, GNUTLS_PKCS_PBES2_GOST_CPD. If not specified, or if nil, the bitflag with value 0 is used. Note that some of these are only supported since GnuTLS 3.6.3.

The debug level will be set for this process AND globally for GnuTLS. So if you set it higher or lower at any point, it affects global debugging.

Note that the priority is set on the client. The server does not use the protocols's priority except for disabling protocols that were not specified.

Processes must be initialized with this function before other GnuTLS functions are used. This function allocates resources which can only be deallocated by calling gnutls-deinit or by calling it again.

The :pass and :flags keys are ignored with old versions of GnuTLS, and
:flags is ignored if :pass is not specified.

The callbacks alist can have a verify key, associated with a verification function (UNUSED).

Each authentication type may need additional information in order to work. For X.509 PKI (gnutls-x509pki), you probably need at least one trustfile (usually a CA bundle).

Probably introduced at or before Emacs version 26.1.

Source Code

// Defined in /usr/src/emacs/src/gnutls.c
// Skipping highlighting due to helpful-max-highlight.
{
  int ret = GNUTLS_E_SUCCESS;
  int max_log_level = 0;

  gnutls_session_t state;
  gnutls_certificate_credentials_t x509_cred = NULL;
  gnutls_anon_client_credentials_t anon_cred = NULL;
  Lisp_Object global_init;
  char const *priority_string_ptr = "NORMAL"; /* default priority string.  */
  char *c_hostname;
  const char *c_pass;

  /* Placeholders for the property list elements.  */
  Lisp_Object priority_string;
  Lisp_Object trustfiles;
  Lisp_Object crlfiles;
  Lisp_Object keylist;
  Lisp_Object pass;
  Lisp_Object flags;
  /* Lisp_Object callbacks; */
  Lisp_Object loglevel;
  Lisp_Object hostname;
  Lisp_Object prime_bits;
#ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2
  unsigned int aux_key_file;
#endif
  struct Lisp_Process *p = XPROCESS (proc);

  CHECK_PROCESS (proc);
  CHECK_SYMBOL (type);
  CHECK_LIST (proplist);

  if (NILP (Fgnutls_available_p ()))
    {
      boot_error (p, "GnuTLS not available");
      return Qnil;
    }

  if (!EQ (type, Qgnutls_x509pki) && !EQ (type, Qgnutls_anon))
    {
      boot_error (p, "Invalid GnuTLS credential type");
      return Qnil;
    }

  hostname              = plist_get (proplist, QChostname);
  priority_string       = plist_get (proplist, QCpriority);
  trustfiles            = plist_get (proplist, QCtrustfiles);
  keylist               = plist_get (proplist, QCkeylist);
  crlfiles              = plist_get (proplist, QCcrlfiles);
  loglevel              = plist_get (proplist, QCloglevel);
  prime_bits            = plist_get (proplist, QCmin_prime_bits);
  pass                  = plist_get (proplist, QCpass);
  flags                 = plist_get (proplist, QCflags);

  if (STRINGP (pass))
    c_pass = SSDATA (pass);
  else
    c_pass = NULL;

  if (!STRINGP (hostname))
    {
      boot_error (p, "gnutls-boot: invalid :hostname parameter (not a string)");
      return Qnil;
    }
  c_hostname = SSDATA (hostname);

  state = XPROCESS (proc)->gnutls_state;

  if (INTEGERP (loglevel))
    {
      gnutls_global_set_log_function (gnutls_log_function);
# ifdef HAVE_GNUTLS3
      gnutls_global_set_audit_log_function (gnutls_audit_log_function);
# endif
      int level = (FIXNUMP (loglevel)
		   ? clip_to_bounds (INT_MIN, XFIXNUM (loglevel), INT_MAX)
		   : NILP (Fnatnump (loglevel)) ? INT_MIN : INT_MAX);
      gnutls_global_set_log_level (level);
      max_log_level = level;
      XPROCESS (proc)->gnutls_log_level = max_log_level;
    }

  GNUTLS_LOG2 (1, max_log_level, "connecting to host:", c_hostname);

  /* Always initialize globals.  */
  global_init = emacs_gnutls_global_init ();
  if (! NILP (Fgnutls_errorp (global_init)))
    return global_init;

  /* Before allocating new credentials, deallocate any credentials
     that PROC might already have.  */
  emacs_gnutls_deinit (proc);

  /* Mark PROC as a GnuTLS process.  */
  XPROCESS (proc)->gnutls_state = NULL;
  XPROCESS (proc)->gnutls_x509_cred = NULL;
  XPROCESS (proc)->gnutls_anon_cred = NULL;
  pset_gnutls_cred_type (XPROCESS (proc), type);
  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;

  GNUTLS_LOG (1, max_log_level, "allocating credentials");
  if (EQ (type, Qgnutls_x509pki))
    {
      Lisp_Object verify_flags;
      unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;

      GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
      check_memory_full (gnutls_certificate_allocate_credentials (&x509_cred));
      XPROCESS (proc)->gnutls_x509_cred = x509_cred;

      verify_flags = plist_get (proplist, QCverify_flags);
      if (TYPE_RANGED_FIXNUMP (unsigned int, verify_flags))
	{
	  gnutls_verify_flags = XFIXNAT (verify_flags);
	  GNUTLS_LOG (2, max_log_level, "setting verification flags");
	}
      else if (NILP (verify_flags))
	GNUTLS_LOG (2, max_log_level, "using default verification flags");
      else
	GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");

      gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
    }
  else /* Qgnutls_anon: */
    {
      GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
      check_memory_full (gnutls_anon_allocate_client_credentials (&anon_cred));
      XPROCESS (proc)->gnutls_anon_cred = anon_cred;
    }

  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC;

  if (EQ (type, Qgnutls_x509pki))
    {
      /* TODO: GNUTLS_X509_FMT_DER is also an option.  */
      int file_format = GNUTLS_X509_FMT_PEM;
      Lisp_Object tail;

# ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
      ret = gnutls_certificate_set_x509_system_trust (x509_cred);
      if (ret < GNUTLS_E_SUCCESS)
	{
	  check_memory_full (ret);
	  GNUTLS_LOG2i (4, max_log_level,
			"setting system trust failed with code ", ret);
	}
# endif

      for (tail = trustfiles; CONSP (tail); tail = XCDR (tail))
	{
	  Lisp_Object trustfile = XCAR (tail);
	  if (STRINGP (trustfile))
	    {
	      GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
			   SSDATA (trustfile));
	      trustfile = ENCODE_FILE (trustfile);
# ifdef WINDOWSNT
	      /* Since GnuTLS doesn't support UTF-8 or UTF-16 encoded
		 file names on Windows, we need to re-encode the file
		 name using the current ANSI codepage.  */
	      trustfile = ansi_encode_filename (trustfile);
# endif
	      ret = gnutls_certificate_set_x509_trust_file
		(x509_cred,
		 SSDATA (trustfile),
		 file_format);

	      if (ret < GNUTLS_E_SUCCESS)
		return gnutls_make_error (ret);
	    }
	  else
	    {
	      emacs_gnutls_deinit (proc);
	      boot_error (p, "Invalid trustfile");
	      return Qnil;
	    }
	}

      for (tail = crlfiles; CONSP (tail); tail = XCDR (tail))
	{
	  Lisp_Object crlfile = XCAR (tail);
	  if (STRINGP (crlfile))
	    {
	      GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
			   SSDATA (crlfile));
	      crlfile = ENCODE_FILE (crlfile);
# ifdef WINDOWSNT
	      crlfile = ansi_encode_filename (crlfile);
# endif
	      ret = gnutls_certificate_set_x509_crl_file
		(x509_cred, SSDATA (crlfile), file_format);

	      if (ret < GNUTLS_E_SUCCESS)
		return gnutls_make_error (ret);
	    }
	  else
	    {
	      emacs_gnutls_deinit (proc);
	      boot_error (p, "Invalid CRL file");
	      return Qnil;
	    }
	}

      for (tail = keylist; CONSP (tail); tail = XCDR (tail))
	{
	  Lisp_Object keyfile = Fcar (XCAR (tail));
	  Lisp_Object certfile = Fcar (Fcdr (XCAR (tail)));
	  if (STRINGP (keyfile) && STRINGP (certfile))
	    {
	      GNUTLS_LOG2 (1, max_log_level, "setting the client key file: ",
			   SSDATA (keyfile));
	      GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
			   SSDATA (certfile));
	      keyfile = ENCODE_FILE (keyfile);
	      certfile = ENCODE_FILE (certfile);
# ifdef WINDOWSNT
	      keyfile = ansi_encode_filename (keyfile);
	      certfile = ansi_encode_filename (certfile);
# endif
# ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2
	      if (!NILP (plist_member (proplist, QCpass)))
		{
		  aux_key_file = key_file2_aux (flags);
		  ret
		    = gnutls_certificate_set_x509_key_file2 (x509_cred,
							     SSDATA (certfile),
							     SSDATA (keyfile),
							     file_format,
							     c_pass,
							     aux_key_file);
		}
	      else
# endif
	      ret = gnutls_certificate_set_x509_key_file
		(x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format);

	      if (ret < GNUTLS_E_SUCCESS)
		return gnutls_make_error (ret);
	    }
	  else
	    {
	      emacs_gnutls_deinit (proc);
	      boot_error (p, STRINGP (keyfile) ? "Invalid client cert file"
			  : "Invalid client key file");
	      return Qnil;
	    }
	}
    }

  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
  GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;

  /* Call gnutls_init here: */

  GNUTLS_LOG (1, max_log_level, "gnutls_init");
  int gnutls_flags = GNUTLS_CLIENT;
# ifdef GNUTLS_NONBLOCK
  if (XPROCESS (proc)->is_non_blocking_client)
    gnutls_flags |= GNUTLS_NONBLOCK;
# endif
  ret = gnutls_init (&state, gnutls_flags);
  XPROCESS (proc)->gnutls_state = state;
  if (ret < GNUTLS_E_SUCCESS)
    return gnutls_make_error (ret);
  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT;

  if (STRINGP (priority_string))
    {
      priority_string_ptr = SSDATA (priority_string);
      GNUTLS_LOG2 (1, max_log_level, "got non-default priority string:",
		   priority_string_ptr);
    }
  else
    {
      GNUTLS_LOG2 (1, max_log_level, "using default priority string:",
		   priority_string_ptr);
    }

  GNUTLS_LOG (1, max_log_level, "setting the priority string");
  ret = gnutls_priority_set_direct (state, priority_string_ptr, NULL);
  if (ret < GNUTLS_E_SUCCESS)
    return gnutls_make_error (ret);

  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY;

  if (FIXNUMP (prime_bits))
    gnutls_dh_set_prime_bits (state, XUFIXNUM (prime_bits));

  ret = EQ (type, Qgnutls_x509pki)
    ? gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred)
    : gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
  if (ret < GNUTLS_E_SUCCESS)
    return gnutls_make_error (ret);

  if (!gnutls_ip_address_p (c_hostname))
    {
      ret = gnutls_server_name_set (state, GNUTLS_NAME_DNS, c_hostname,
				    strlen (c_hostname));
      if (ret < GNUTLS_E_SUCCESS)
	return gnutls_make_error (ret);
    }

  XPROCESS (proc)->gnutls_complete_negotiation_p =
    !NILP (plist_get (proplist, QCcomplete_negotiation));
  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
  ret = emacs_gnutls_handshake (XPROCESS (proc));
  if (ret < GNUTLS_E_SUCCESS)
    return gnutls_make_error (ret);

  return gnutls_verify_boot (proc, proplist);
}