remote pool_handle_t
[tlspool] / src / gnutls.c
1 /* tlspool/gnutls.c -- Setup and validation handler for TLS session */
2
3 /* This is an implementation of the general idea of STARTTLS.
4  * It happen to be done with GnuTLS, we embrace for a future
5  * where there could be alternative implementations too.
6  */
7
8 #include "whoami.h"
9
10 #include <stdlib.h>
11 #include <stdint.h>
12 #include <stdbool.h>
13 #include <stdio.h>
14 #include <memory.h>
15 #include <string.h>
16 #include <pthread.h>
17 #include <assert.h>
18
19 #include <ctype.h>
20
21 #include <unistd.h>
22 #include <syslog.h>
23
24 #include <errno.h>
25 #include <com_err.h>
26 #include <errortable.h>
27
28 #include <gnutls/gnutls.h>
29 #include <gnutls/pkcs11.h>
30 #include <gnutls/abstract.h>
31 #ifdef HAVE_GNUTLS_DANE
32 #include <gnutls/dane.h>
33 #endif
34
35 #include <p11-kit/pkcs11.h>
36
37 #include <tlspool/commands.h>
38 #include <tlspool/internal.h>
39
40 #include <libtasn1.h>
41
42
43 #ifdef HAVE_TLS_KDH
44 #include <krb5.h>
45 /* Plus, from k5-int.h: */
46 krb5_error_code KRB5_CALLCONV krb5_decrypt_tkt_part(krb5_context,
47                                                     const krb5_keyblock *,
48                                                     krb5_ticket * );
49 #endif
50
51
52 #include <quick-der/api.h>
53 #include <quick-der/rfc4120.h>
54 typedef DER_OVLY_rfc4120_Ticket ticket_t;
55 typedef DER_OVLY_rfc4120_Authenticator authenticator_t;
56 typedef DER_OVLY_rfc4120_EncryptedData encrypted_data_t;
57
58 #include <tlspool/internal.h>
59
60 #ifdef WINDOWS_PORT
61 #include <winsock2.h>
62 #include <ws2tcpip.h>
63 #else
64 #include <poll.h>
65 #include <sys/types.h>
66 #include <sys/socket.h>
67
68 #include <krb5.h>
69
70 #ifndef __MINGW64__
71 #include <arpa/inet.h>
72 #endif
73 #include <netinet/in.h>
74 #endif
75
76 #ifdef WINDOWS_PORT
77 #include <windows.h>
78 #define RECV_FLAGS 0
79 #define SHUT_RD SD_RECEIVE
80 #define SHUT_WR SD_SEND
81 #else /* WINDOWS_PORT */
82 #define RECV_FLAGS MSG_DONTWAIT | MSG_NOSIGNAL
83 #endif /* WINDOWS_PORT */
84
85 #include "manage.h"
86 #include "donai.h"
87 #include "trust.h"
88
89
90 #if EXPECTED_LID_TYPE_COUNT != LID_TYPE_CNT
91 #error "Set EXPECTED_LID_TYPE_COUNT in <tlspool/internal.h> to match LID_TYPE_CNT"
92 #endif
93
94
95 /* This module hosts TLS handlers which treat an individual connection.
96  *
97  * Initially, the TLS setup is processed, which means validating the
98  * connection.  If and when this succeeds, a continued process is needed
99  * to encrypt and decrypt traffic while it is in transit.
100  *
101  * Every TLS connection (including the attempt to set it up) is hosted in
102  * its own thread.  This means that it can abide time to wait for PINENTRY,
103  * LOCALID or LIDENTRY responses.  It also means a very clear flow when the
104  * time comes to destroy a connection.
105  *
106  * While encrypting and decrypting traffic passing through, the thread
107  * will use its own poll() call, and thus offload the potentially large
108  * one of the main thread, which is supposed to be a low-traffic task.
109  * The set of file descriptors used by the session-handler threads are
110  * in contrast very small and can easily be started for every single
111  * packet passing through.
112  *
113  * Might the user terminate a process while this one is waiting for a
114  * callback command request, then the main TLS pool thread will take
115  * care of taking down this thread.  To that end, it sets the followup
116  * pointer that normally holds a callback response to NULL, and then
117  * permits this thread to run again.  This will lead to a shutdown of
118  * this process, and proper closing of all connections.  The remote peer
119  * will therefore see the result of a local kill as a connection reset.
120  *
121  * In case one of the end points of the connection is terminated, a
122  * similar thing will happen; the thread will terminate itself after
123  * a cleanup of any outstanding resources.  This, once again, leads
124  * to passing on the reset of a connection between the encrypted and
125  * side of the connection.
126  */
127
128
129
130 /*
131  * GnuTLS infrastructure setup.
132  * Session-shared DH-keys, credentials structures, and so on.
133  */
134 static gnutls_dh_params_t dh_params;
135
136 struct credinfo {
137         gnutls_credentials_type_t credtp;
138         void *cred;
139 };
140
141 #ifdef EXPERIMENTAL_SRP
142 #  define EXPECTED_SRV_CREDCOUNT 3
143 #  define EXPECTED_CLI_CREDCOUNT 3
144 #else
145 #  define EXPECTED_SRV_CREDCOUNT 2
146 #  define EXPECTED_CLI_CREDCOUNT 2
147 #endif
148 static struct credinfo srv_creds [EXPECTED_SRV_CREDCOUNT];
149 static struct credinfo cli_creds [EXPECTED_CLI_CREDCOUNT];
150 static int srv_credcount = 0;
151 static int cli_credcount = 0;
152 static const char onthefly_p11uri[] = "pkcs11:manufacturer=ARPA2.net;token=TLS+Pool+internal;object=on-the-fly+signer;type=private;serial=1";
153 static unsigned long long onthefly_serial;  //TODO: Fill with now * 1000
154 static gnutls_x509_crt_t onthefly_issuercrt = NULL;
155 static gnutls_privkey_t onthefly_issuerkey = NULL;
156 static gnutls_x509_privkey_t onthefly_subjectkey = NULL;
157 static pthread_mutex_t onthefly_signer_lock = PTHREAD_MUTEX_INITIALIZER;
158
159 #ifdef HAVE_TLS_KDH
160 static krb5_context krbctx_cli, krbctx_srv;
161 static krb5_keytab  krb_kt_cli, krb_kt_srv;
162 static bool         got_cc_cli, got_cc_srv;
163 static int have_key_tgt_cc (
164                                 struct command *cmd, // in, session context
165                                 krb5_context ctx,    // in, kerberos context
166                                 bool use_cc,         // in, whether to use cc
167                                 krb5_kvno kvno,      // in, kvno (0 for highest)
168                                 krb5_enctype enctype,// in, enctype (0 for any)
169                                 char *p11uri,        // in/opt, PKCS #11 pwd URI
170                                 krb5_keytab kt,      // in/opt, keytab
171                                 krb5_keyblock *key,  // opt/opt session key
172                                 krb5_creds **tgt,    // out/opt, tkt granting tkt
173                                 krb5_ccache *cc);    // out/opt, cred cache
174 static int have_service_ticket (
175                                 struct command *cmd, // in, session context
176                                 krb5_context ctx,    // in, kerberos context
177                                 krb5_ccache cc_opt,  // in/opt, credcache
178                                 krb5_principal cli,  // in, client principal
179                                 krb5_creds **ticket);// out/opt, tkt granting tkt
180 #endif
181
182
183 /* The local variation on the ctlkeynode structure, with TLS-specific fields
184  */
185 struct ctlkeynode_tls {
186         struct ctlkeynode regent;       // Structure for ctlkey_register()
187         gnutls_session_t session;       // Additional data specifically for TLS
188         pthread_t owner;                // For interruption of copycat()
189         int plainfd;                    // Plain-side connection
190         int cryptfd;                    // Crypt-side connection
191 };
192
193 /* A local structure used for iterating over PKCS #11 entries.  This is used
194  * to iterate over password attempts, no more than MAX_P11ITER_ATTEMPTS though.
195  *
196  * When a password is requested but none is available, the password request
197  * will be passed to the user using the PIN callback mechanism.  When this
198  * is done, a warning may be given that the TLS Pool overtakes control over
199  * the account (when thusly configured).  In support of that option, the
200  * $attempt is counted and the respective $p11pwd is CK_INVALID_HANDLE.
201  * TODO: Perhaps interact for saving, such as entering an certain string?
202  *
203  * When a number of attempts needs to be made before success, then any
204  * objects that precede a succeeded $attempt can be removed.  The same may
205  * be true for any objects after it.
206  *
207  * This mechanism is useful during password changes.  When a new password is
208  * desired by the KDC, then a random object is created and returned twice.
209  * To support repeated delivery, the password is stored in $newpwd;
210  * In this case, the safest choice is still to leave the last $p11pwd.
211  *
212  * The caller may decide to invoke the password changing procedure, namely
213  * after manual entry as evidenced by the condition
214  *      (attempts >= 0) &&
215  *      (attempts < MAX_P11_ITER_ATTEMPTS) &&
216  *      (p11pwd [attempt] == CK_INVALID_HANDLE)
217  *
218  * TODO: This is a designed data structure, but not yet installed.
219  *
220  * TODO: It is more useful to abolish passwords, and truly use PKCS #11.
221  */
222 #define MAX_P11ITER_ATTEMPTS 3
223 struct pkcs11iter {
224         struct command *cmd;            // The session command structure
225         CK_SESSION_HANDLE p11ses;       // The PKCS #11 session in motion
226         int attempt;                    // Starts at -1, incremented by pwd entry
227         CK_OBJECT_HANDLE p11pwd [MAX_P11ITER_ATTEMPTS];
228                                         // Sequence of $attempt objects returned
229         CK_OBJECT_HANDLE newpwd;        // Set when a new password was offered
230 };
231
232 /* The list of accepted Exporter Label Prefixes for starttls_prng()
233  */
234 char *tlsprng_label_prefixes [] = {
235         // Forbidden by RFC 5705: "client finished",
236         // Forbidden by RFC 5705: "server finished",
237         // Forbidden by RFC 5705: "master secret",
238         // Forbidden by RFC 5705: "key expansion",
239         "client EAP encryption",                // not suited for DTLS
240         "ttls keying material",                 // not suited for DTLS
241         "ttls challenge",                       // not suited for DTLS
242         "EXTRACTOR-dtls_srtp",
243         "EXPORTER_DTLS_OVER_SCTP",
244         "EXPORTER-ETSI-TC-M2M-Bootstrap",
245         "EXPORTER-ETSI-TC-M2M-Connection",
246         "TLS_MK_Extr",
247         "EXPORTER_GBA_Digest",
248         "EXPORTER: teap session key seed",      // not suited for DTLS
249         "EXPORTER-oneM2M-Bootstrap",
250         "EXPORTER-oneM2M-Connection",
251         NULL
252 };
253
254 /* The registry with the service names that are deemed safe for an
255  * anonymous precursor phase; that is, the service names that may offer
256  * ANON-DH initially, and immediately renegotiate an authenticated
257  * connection.  See doc/anonymising-precursor.* for more information.
258  *
259  * The registry is ordered by case-independent service name, so it can
260  * be searched in 2log time.  Service names are as defined by IANA in the
261  * "Service Name and Transport Protocol Port Number Registry".
262  *
263  * The entries in the registry depend on the role played; either as a
264  * client or as a server.  This refers to the local node, and depends on
265  * uncertainty of the remote party's TLS implementation and whether or
266  * not the protocol could lead to the remote sending information that
267  * requires authentication before the secure renogiation into an
268  * authenticated connection has been completed by this side.  This is
269  * a protocol-dependent matter and the registry provided here serves to
270  * encapsulate this knowledge inside the TLS Pool instead of bothering
271  * application designers with it.  Entries that are not found in the
272  * registry are interpreted as not allowing an anonymising precursor.
273  *
274  * Note that ANONPRE_EXTEND_MASTER_SECRET cannot be verified before
275  * GnuTLS version 3.4.0; see "imap" below for the resulting impact.  This
276  * also impacts dynamic linking, because 3.4.0 introduces the new function
277  * gnutls_ext_get_data() that is used for this requirement.
278  */
279 #define ANONPRE_FORBID 0x00
280 #define ANONPRE_CLIENT 0x01
281 #define ANONPRE_SERVER 0x02
282 #define ANONPRE_EITHER (ANONPRE_CLIENT | ANONPRE_SERVER)
283 #define ANONPRE_EXTEND_MASTER_SECRET 0x10
284 struct anonpre_regentry {
285         char *service;
286         uint8_t flags;
287 };
288 struct anonpre_regentry anonpre_registry [] = {
289 /* This registry is commented out for now, although the code to use it seems
290  * to work fine.  GnuTLS however, does not seem to support making the switch
291  * from ANON-ECDH to an authenticated handshake.  Details:
292  * http://lists.gnutls.org/pipermail/gnutls-help/2015-November/003998.html
293  *
294         { "generic_anonpre", ANONPRE_EITHER },  // Name invalid as per RFC 6335
295         { "http", ANONPRE_CLIENT },     // Server also if it ignores client ID
296 #if GNUTLS_VERSION_NUMBER < 0x030400
297         { "imap", ANONPRE_SERVER },
298 #else
299         { "imap", ANONPRE_EITHER | ANONPRE_EXTEND_MASTER_SECRET },
300 #endif
301         { "pop3", ANONPRE_EITHER },
302         { "smtp", ANONPRE_EITHER },
303  *
304  * End of commenting out the registry
305  */
306 };
307 const int anonpre_registry_size = sizeof (anonpre_registry) / sizeof (struct anonpre_regentry);
308
309
310 /* The registry of Key Usage and Extended Key Usage for any given service name.
311  */
312 static const char *http_noncrit [] = { GNUTLS_KP_TLS_WWW_SERVER, GNUTLS_KP_TLS_WWW_CLIENT, NULL };
313 struct svcusage_regentry {
314         char *service;
315         unsigned int usage;
316         const char **oids_non_critical;
317         const char **oids_critical;
318 };
319 struct svcusage_regentry svcusage_registry [] = {
320         { "generic_anonpre",
321                 GNUTLS_KEY_KEY_ENCIPHERMENT |
322                 GNUTLS_KEY_KEY_AGREEMENT,
323                 NULL,
324                 NULL
325         },
326         { "http",
327                 GNUTLS_KEY_DIGITAL_SIGNATURE |
328                 GNUTLS_KEY_KEY_ENCIPHERMENT |
329                 GNUTLS_KEY_KEY_AGREEMENT,
330                 http_noncrit,
331                 NULL
332         },
333 };
334 const int svcusage_registry_size = sizeof (svcusage_registry) / sizeof (struct svcusage_regentry);
335
336
337 /* The maximum number of bytes that can be passed over a TLS connection before
338  * the authentication is complete in case of a anonymous precursor within a
339  * protocol that ensures that this cannot be a problem.
340  */
341 int maxpreauth;
342
343 /* The priorities cache for "NORMAL" -- used to preconfigure the server,
344  * actually to overcome its unwillingness to perform the handshake, and
345  * leave it to srv_clienthello() to setup the priority string.
346  */
347 gnutls_priority_t priority_normal;
348
349
350 /* Map a GnuTLS call (usually a function call) to a POSIX errno,
351  * optionally reporting an errstr to avoid loosing information.
352  * Retain errno if it already exists.
353  * Continue if errno differs from 0, GnuTLS may "damage" it even when OK. */
354 #define E_g2e(errstr,gtlscall) { \
355         if (gtls_errno == GNUTLS_E_SUCCESS) { \
356                 gtls_errno = (gtlscall); \
357                 if (gtls_errno != GNUTLS_E_SUCCESS) { \
358                         error_gnutls2posix (gtls_errno, errstr); \
359                 } \
360         } \
361 }
362
363 /* Cleanup when GnuTLS leaves errno damaged but returns no gtls_errno */
364 #define E_gnutls_clear_errno() { \
365         if (gtls_errno == GNUTLS_E_SUCCESS) { \
366                 errno = 0; \
367         } \
368 }
369
370 /* Error number translation, including error string setup.  See E_g2e(). */
371 void error_gnutls2posix (int gtls_errno, char *new_errstr) {
372         char *errstr;
373         register int newerrno;
374         //
375         // Sanity checks
376         if (gtls_errno == GNUTLS_E_SUCCESS) {
377                 return;
378         }
379         errstr =  error_getstring ();
380         if (errstr != NULL) {
381                 return;
382         }
383         //
384         // Report the textual error
385         if (new_errstr == NULL) {
386                 new_errstr = "GnuTLS error";
387         }
388         tlog (TLOG_TLS, LOG_ERR, "%s: %s",
389                 new_errstr,
390                 gnutls_strerror (gtls_errno));
391         error_setstring (new_errstr);
392         //
393         // Translate error to a POSIX errno value
394         switch (gtls_errno) {
395         case GNUTLS_E_SUCCESS:
396                 return;
397         case GNUTLS_E_UNKNOWN_COMPRESSION_ALGORITHM:
398         case GNUTLS_E_UNKNOWN_CIPHER_TYPE:
399         case GNUTLS_E_UNSUPPORTED_VERSION_PACKET:
400         case GNUTLS_E_UNWANTED_ALGORITHM:
401         case GNUTLS_E_UNKNOWN_CIPHER_SUITE:
402         case GNUTLS_E_UNSUPPORTED_CERTIFICATE_TYPE:
403         case GNUTLS_E_X509_UNKNOWN_SAN:
404         case GNUTLS_E_DH_PRIME_UNACCEPTABLE:
405         case GNUTLS_E_UNKNOWN_PK_ALGORITHM:
406         case GNUTLS_E_NO_TEMPORARY_RSA_PARAMS:
407         case GNUTLS_E_NO_COMPRESSION_ALGORITHMS:
408         case GNUTLS_E_NO_CIPHER_SUITES:
409         case GNUTLS_E_OPENPGP_FINGERPRINT_UNSUPPORTED:
410         case GNUTLS_E_X509_UNSUPPORTED_ATTRIBUTE:
411         case GNUTLS_E_UNKNOWN_HASH_ALGORITHM:
412         case GNUTLS_E_UNKNOWN_PKCS_CONTENT_TYPE:
413         case GNUTLS_E_UNKNOWN_PKCS_BAG_TYPE:
414         case GNUTLS_E_NO_TEMPORARY_DH_PARAMS:
415         case GNUTLS_E_UNKNOWN_ALGORITHM:
416         case GNUTLS_E_UNSUPPORTED_SIGNATURE_ALGORITHM:
417         case GNUTLS_E_UNSAFE_RENEGOTIATION_DENIED:
418         case GNUTLS_E_X509_UNSUPPORTED_OID:
419         case GNUTLS_E_CHANNEL_BINDING_NOT_AVAILABLE:
420         case GNUTLS_E_INCOMPAT_DSA_KEY_WITH_TLS_PROTOCOL:
421         case GNUTLS_E_ECC_NO_SUPPORTED_CURVES:
422         case GNUTLS_E_ECC_UNSUPPORTED_CURVE:
423         case GNUTLS_E_X509_UNSUPPORTED_EXTENSION:
424         case GNUTLS_E_NO_CERTIFICATE_STATUS:
425         case GNUTLS_E_NO_APPLICATION_PROTOCOL:
426 #ifdef GNUTLS_E_NO_SELF_TEST
427         case GNUTLS_E_NO_SELF_TEST:
428 #endif
429                 newerrno = EOPNOTSUPP;
430                 break;
431         case GNUTLS_E_UNEXPECTED_PACKET_LENGTH:
432         case GNUTLS_E_INVALID_REQUEST:
433                 newerrno = EINVAL;
434                 break;
435         case GNUTLS_E_INVALID_SESSION:
436         case GNUTLS_E_REHANDSHAKE:
437         case GNUTLS_E_CERTIFICATE_KEY_MISMATCH:
438                 newerrno = ENOTCONN;
439                 break;
440         case GNUTLS_E_PUSH_ERROR:
441         case GNUTLS_E_PULL_ERROR:
442         case GNUTLS_E_PREMATURE_TERMINATION:
443         case GNUTLS_E_SESSION_EOF:
444                 newerrno = ECONNRESET;
445                 break;
446         case GNUTLS_E_UNEXPECTED_PACKET:
447         case GNUTLS_E_WARNING_ALERT_RECEIVED:
448         case GNUTLS_E_FATAL_ALERT_RECEIVED:
449         case GNUTLS_E_LARGE_PACKET:
450         case GNUTLS_E_ERROR_IN_FINISHED_PACKET:
451         case GNUTLS_E_UNEXPECTED_HANDSHAKE_PACKET:
452         case GNUTLS_E_MPI_SCAN_FAILED:
453         case GNUTLS_E_DECRYPTION_FAILED:
454         case GNUTLS_E_DECOMPRESSION_FAILED:
455         case GNUTLS_E_COMPRESSION_FAILED:
456         case GNUTLS_E_BASE64_DECODING_ERROR:
457         case GNUTLS_E_MPI_PRINT_FAILED:
458         case GNUTLS_E_GOT_APPLICATION_DATA:
459         case GNUTLS_E_RECORD_LIMIT_REACHED:
460         case GNUTLS_E_ENCRYPTION_FAILED:
461         case GNUTLS_E_PK_ENCRYPTION_FAILED:
462         case GNUTLS_E_PK_DECRYPTION_FAILED:
463         case GNUTLS_E_RECEIVED_ILLEGAL_PARAMETER:
464         case GNUTLS_E_REQUESTED_DATA_NOT_AVAILABLE:
465         case GNUTLS_E_PKCS1_WRONG_PAD:
466         case GNUTLS_E_RECEIVED_ILLEGAL_EXTENSION:
467         case GNUTLS_E_FILE_ERROR:
468         case GNUTLS_E_ASN1_ELEMENT_NOT_FOUND:
469         case GNUTLS_E_ASN1_IDENTIFIER_NOT_FOUND:
470         case GNUTLS_E_ASN1_DER_ERROR:
471         case GNUTLS_E_ASN1_VALUE_NOT_FOUND:
472         case GNUTLS_E_ASN1_GENERIC_ERROR:
473         case GNUTLS_E_ASN1_VALUE_NOT_VALID:
474         case GNUTLS_E_ASN1_TAG_ERROR:
475         case GNUTLS_E_ASN1_TAG_IMPLICIT:
476         case GNUTLS_E_ASN1_TYPE_ANY_ERROR:
477         case GNUTLS_E_ASN1_SYNTAX_ERROR:
478         case GNUTLS_E_ASN1_DER_OVERFLOW:
479         case GNUTLS_E_TOO_MANY_EMPTY_PACKETS:
480         case GNUTLS_E_TOO_MANY_HANDSHAKE_PACKETS:
481         case GNUTLS_E_SRP_PWD_PARSING_ERROR:
482         case GNUTLS_E_BASE64_ENCODING_ERROR:
483         case GNUTLS_E_OPENPGP_KEYRING_ERROR:
484         case GNUTLS_E_BASE64_UNEXPECTED_HEADER_ERROR:
485         case GNUTLS_E_OPENPGP_SUBKEY_ERROR:
486         case GNUTLS_E_CRYPTO_ALREADY_REGISTERED:
487         case GNUTLS_E_HANDSHAKE_TOO_LARGE:
488         case GNUTLS_E_BAD_COOKIE:
489         case GNUTLS_E_PARSING_ERROR:
490         case GNUTLS_E_CERTIFICATE_LIST_UNSORTED:
491         case GNUTLS_E_NO_PRIORITIES_WERE_SET:
492 #ifdef GNUTLS_E_PK_GENERATION_ERROR
493         case GNUTLS_E_PK_GENERATION_ERROR:
494 #endif
495 #ifdef GNUTLS_E_SELF_TEST_ERROR
496         case GNUTLS_E_SELF_TEST_ERROR:
497 #endif
498 #ifdef GNUTLS_E_SOCKETS_INIT_ERROR
499         case GNUTLS_E_SOCKETS_INIT_ERROR:
500 #endif
501                 newerrno = EIO;
502                 break;
503         case GNUTLS_E_MEMORY_ERROR:
504         case GNUTLS_E_SHORT_MEMORY_BUFFER:
505                 newerrno = ENOMEM;
506                 break;
507         case GNUTLS_E_AGAIN:
508                 newerrno = EAGAIN;
509                 break;
510         case GNUTLS_E_EXPIRED:
511         case GNUTLS_E_TIMEDOUT:
512                 newerrno = ETIMEDOUT;
513                 break;
514         case GNUTLS_E_DB_ERROR:
515 #ifdef ENODATA
516                 newerrno = ENODATA;
517 #else
518                 newerrno = ENOENT;
519 #endif
520                 break;
521         case GNUTLS_E_SRP_PWD_ERROR:
522         case GNUTLS_E_INSUFFICIENT_CREDENTIALS:
523         case GNUTLS_E_HASH_FAILED:
524         case GNUTLS_E_PK_SIGN_FAILED:
525         case GNUTLS_E_CERTIFICATE_ERROR:
526         case GNUTLS_E_X509_UNSUPPORTED_CRITICAL_EXTENSION:
527         case GNUTLS_E_KEY_USAGE_VIOLATION:
528         case GNUTLS_E_NO_CERTIFICATE_FOUND:
529         case GNUTLS_E_OPENPGP_UID_REVOKED:
530         case GNUTLS_E_OPENPGP_GETKEY_FAILED:
531         case GNUTLS_E_PK_SIG_VERIFY_FAILED:
532         case GNUTLS_E_ILLEGAL_SRP_USERNAME:
533         case GNUTLS_E_INVALID_PASSWORD:
534         case GNUTLS_E_MAC_VERIFY_FAILED:
535         case GNUTLS_E_IA_VERIFY_FAILED:
536         case GNUTLS_E_UNKNOWN_SRP_USERNAME:
537         case GNUTLS_E_OPENPGP_PREFERRED_KEY_ERROR:
538         case GNUTLS_E_USER_ERROR:
539         case GNUTLS_E_AUTH_ERROR:
540                 newerrno = EACCES;
541                 break;
542         case GNUTLS_E_INTERRUPTED:
543                 newerrno = EINTR;
544                 break;
545         case GNUTLS_E_INTERNAL_ERROR:
546         case GNUTLS_E_CONSTRAINT_ERROR:
547         case GNUTLS_E_ILLEGAL_PARAMETER:
548                 newerrno = EINVAL;
549                 break;
550         case GNUTLS_E_SAFE_RENEGOTIATION_FAILED:
551                 newerrno = ECONNREFUSED;
552                 break;
553         case GNUTLS_E_INCOMPATIBLE_GCRYPT_LIBRARY:
554         case GNUTLS_E_INCOMPATIBLE_LIBTASN1_LIBRARY:
555 #ifdef GNUTLS_E_LIB_IN_ERROR_STATE
556         case GNUTLS_E_LIB_IN_ERROR_STATE:
557 #endif
558                 newerrno = ENOEXEC;
559                 break;
560         case GNUTLS_E_RANDOM_FAILED:
561                 newerrno = EBADF;
562                 break;
563         case GNUTLS_E_CRYPTODEV_IOCTL_ERROR:
564         case GNUTLS_E_CRYPTODEV_DEVICE_ERROR:
565         case GNUTLS_E_HEARTBEAT_PONG_RECEIVED:
566         case GNUTLS_E_HEARTBEAT_PING_RECEIVED:
567         case GNUTLS_E_PKCS11_ERROR:
568         case GNUTLS_E_PKCS11_LOAD_ERROR:
569         case GNUTLS_E_PKCS11_PIN_ERROR:
570         case GNUTLS_E_PKCS11_SLOT_ERROR:
571         case GNUTLS_E_LOCKING_ERROR:
572         case GNUTLS_E_PKCS11_ATTRIBUTE_ERROR:
573         case GNUTLS_E_PKCS11_DEVICE_ERROR:
574         case GNUTLS_E_PKCS11_DATA_ERROR:
575         case GNUTLS_E_PKCS11_UNSUPPORTED_FEATURE_ERROR:
576         case GNUTLS_E_PKCS11_KEY_ERROR:
577         case GNUTLS_E_PKCS11_PIN_EXPIRED:
578         case GNUTLS_E_PKCS11_PIN_LOCKED:
579         case GNUTLS_E_PKCS11_SESSION_ERROR:
580         case GNUTLS_E_PKCS11_SIGNATURE_ERROR:
581         case GNUTLS_E_PKCS11_TOKEN_ERROR:
582         case GNUTLS_E_PKCS11_USER_ERROR:
583         case GNUTLS_E_CRYPTO_INIT_FAILED:
584         case GNUTLS_E_PKCS11_REQUESTED_OBJECT_NOT_AVAILBLE:
585         case GNUTLS_E_TPM_ERROR:
586         case GNUTLS_E_TPM_KEY_PASSWORD_ERROR:
587         case GNUTLS_E_TPM_SRK_PASSWORD_ERROR:
588         case GNUTLS_E_TPM_SESSION_ERROR:
589         case GNUTLS_E_TPM_KEY_NOT_FOUND:
590         case GNUTLS_E_TPM_UNINITIALIZED:
591         case GNUTLS_E_OCSP_RESPONSE_ERROR:
592         case GNUTLS_E_RANDOM_DEVICE_ERROR:
593 #ifdef EREMOTEIO
594                 newerrno = EREMOTEIO;
595 #else
596                 newerrno = EIO;
597 #endif
598                 break;
599         default:
600                 newerrno = EIO;
601                 break;
602         }
603         errno = newerrno;
604         return;
605 }
606
607 /* Generate Diffie-Hellman parameters - for use with DHE
608  * kx algorithms. TODO: These should be discarded and regenerated
609  * once a day, once a week or once a month. Depending on the
610  * security requirements.
611  */
612 static gtls_error generate_dh_params (void) {
613         unsigned int bits;
614         int gtls_errno = GNUTLS_E_SUCCESS;
615         bits = gnutls_sec_param_to_pk_bits (
616                 GNUTLS_PK_DH,
617                 GNUTLS_SEC_PARAM_LEGACY);
618         //TODO// Acquire DH-params lock
619         E_g2e ("Failed to initialise DH params",
620                 gnutls_dh_params_init (
621                         &dh_params));
622         E_g2e ("Failed to generate DH params",
623                 gnutls_dh_params_generate2 (
624                         dh_params,
625                         bits));
626         //TODO// Release DH-params lock
627         return gtls_errno;
628 }
629
630 /* Load Diffie-Hellman parameters from file - or generate them when load fails.
631  */
632 static gtls_error load_dh_params (void) {
633         gnutls_dh_params_t dhp;
634         gnutls_datum_t pkcs3;
635         char *filename = cfg_tls_dhparamfile ();
636         int gtls_errno = GNUTLS_E_SUCCESS;
637         memset (&pkcs3, 0, sizeof (pkcs3));
638         if (filename) {
639                 E_g2e ("No PKCS #3 PEM file with DH params",
640                         gnutls_load_file (
641                                 filename,
642                                 &pkcs3));
643                 E_gnutls_clear_errno ();
644                 E_g2e ("Failed to initialise DH params",
645                         gnutls_dh_params_init (
646                                 &dhp));
647                 E_g2e ("Failed to import DH params from PKCS #3 PEM",
648                         gnutls_dh_params_import_pkcs3 (
649                                 dhp,
650                                 &pkcs3,
651                                 GNUTLS_X509_FMT_PEM));
652                 E_gnutls_clear_errno ();
653         }
654         if (pkcs3.data != NULL) {
655                 free (pkcs3.data);
656         }
657         if (gtls_errno != GNUTLS_E_SUCCESS) {
658                 //
659                 // File failed to load, so try to generate fresh DH params
660                 int gtls_errno_stack0;
661                 gtls_errno = GNUTLS_E_SUCCESS;
662                 tlog (TLOG_CRYPTO, LOG_DEBUG, "Failed to load DH params from %s; generating fresh parameters", filename);
663                 E_g2e ("Failed to generate DH params",
664                         generate_dh_params ());
665                 gtls_errno_stack0 = gtls_errno;
666                 //TODO// Acquire DH-params lock
667                 E_g2e ("Failed to format DH params as PKCS #3 PEM",
668                         gnutls_dh_params_export2_pkcs3 (
669                                 dh_params,
670                                 GNUTLS_X509_FMT_PEM,
671                                 &pkcs3));
672                 //TODO// Release DH-params lock
673                 if ((gtls_errno == GNUTLS_E_SUCCESS) && (filename != NULL)) {
674                         FILE *pemf;
675                         //
676                         // Best effor file save -- readback will parse
677                         pemf = fopen (filename, "w");
678                         if (pemf != NULL) {
679                                 fwrite (pkcs3.data, 1, pkcs3.size, pemf);
680                                 fclose (pemf);
681                                 tlog (TLOG_FILES, LOG_DEBUG, "Saved DH params to %s (best-effort)", filename);
682                         }
683                         E_gnutls_clear_errno ();
684                 }
685                 gtls_errno = gtls_errno_stack0;
686         } else {
687                 gnutls_dh_params_t old_dh;
688                 //TODO// Acquire DH-params lock
689                 old_dh = dh_params;
690                 dh_params = dhp;
691                 //TODO// Release DH-params lock
692                 if (old_dh) {
693                         gnutls_dh_params_deinit (old_dh);
694                 }
695         }
696         return gtls_errno;
697 }
698
699 /* Remove DH parameters, to be used during program cleanup. */
700 static void remove_dh_params (void) {
701         if (dh_params) {
702                 gnutls_dh_params_deinit (dh_params);
703                 dh_params = NULL;
704         }
705 }
706
707
708 /* A log printing function
709  */
710 void log_gnutls (int level, const char *msg) {
711         tlog (TLOG_TLS, level, "GnuTLS: %s", msg);
712 }
713
714
715 /* Implement the GnuTLS function for token insertion callback.  This function
716  * refers back to the generic callback for token insertion.
717  */
718 int gnutls_token_callback (void *const userdata,
719                                 const char *const label,
720                                 unsigned retry) {
721         if (token_callback (label, retry)) {
722                 return GNUTLS_E_SUCCESS;
723         } else {
724                 return GNUTLS_E_PKCS11_TOKEN_ERROR;
725         }
726 }
727
728
729 /*
730  * Implement the GnuTLS function for PIN callback.  This function calls
731  * the generic PIN callback operation.
732  */
733 int gnutls_pin_callback (void *userdata,
734                                 int attempt,
735                                 const char *token_url,
736                                 const char *token_label,
737                                 unsigned int flags,
738                                 char *pin,
739                                 size_t pin_max) {
740         if (flags & GNUTLS_PIN_SO) {
741                 return GNUTLS_E_USER_ERROR;
742         }
743         if (pin_callback (attempt, token_url, NULL, pin, pin_max)) {
744                 return 0;
745         } else {
746                 return GNUTLS_E_PKCS11_PIN_ERROR;
747         }
748 }
749
750
751 /* Register a PKCS #11 provider with the GnuTLS environment. */
752 void starttls_pkcs11_provider (char *p11path) {
753         unsigned int token_seq = 0;
754         char *p11uri;
755         if (gnutls_pkcs11_add_provider (p11path, NULL) != 0) {
756                 fprintf (stderr, "Failed to register PKCS #11 library %s with GnuTLS\n", p11path);
757                 exit (1);
758         }
759         while (gnutls_pkcs11_token_get_url (token_seq, 0, &p11uri) == 0) {
760 #ifdef DEBUG
761                 fprintf (stderr, "DEBUG: Found token URI %s\n", p11uri);
762 #endif
763                 //TODO// if (gnutls_pkcs11_token_get_info (p11uri, GNUTLS_PKCS11_TOKEN_LABEL-of-SERIAL-of-MANUFACTURER-of-MODEL, output, utput_size) == 0) { ... }
764                 gnutls_free (p11uri);
765                 token_seq++;
766         }
767         //TODO// Select token by name (value)
768         //TODO// if PIN available then set it up
769         //TODO:WHY?// free_p11pin ();
770 }
771
772 static void cleanup_starttls_credentials (void);/* Defined below */
773 static void cleanup_starttls_validation (void); /* Defined below */
774 #ifdef HAVE_TLS_KDH
775 static void cleanup_starttls_kerberos (void);   /* Defined below */
776 static int setup_starttls_kerberos (void);      /* Defined below */
777 #endif
778 static int setup_starttls_credentials (void);   /* Defined below */
779
780 /* The global and static setup function for the starttls functions.
781  */
782 void setup_starttls (void) {
783         const char *curver;
784         int gtls_errno = GNUTLS_E_SUCCESS;
785         char *otfsigcrt, *otfsigkey;
786         //
787         // Setup configuration variables
788         maxpreauth = cfg_tls_maxpreauth ();
789         //
790         // Basic library actions
791         tlog (TLOG_TLS, LOG_DEBUG, "Compiled against GnuTLS version %s", GNUTLS_VERSION);
792         curver = gnutls_check_version (GNUTLS_VERSION);
793         tlog (TLOG_TLS, LOG_DEBUG, "Running against %s GnuTLS version %s", curver? "acceptable": "OLDER", curver? curver: gnutls_check_version (NULL));
794         E_g2e ("GnuTLS global initialisation failed",
795                 gnutls_global_init ());
796         E_gnutls_clear_errno ();
797         E_g2e ("GnuTLS PKCS #11 initialisation failed",
798                 gnutls_pkcs11_init (
799                         GNUTLS_PKCS11_FLAG_MANUAL, NULL));
800         //
801         // Setup logging / debugging
802         if (cfg_log_level () == LOG_DEBUG) {
803                 gnutls_global_set_log_function (log_gnutls);
804                 gnutls_global_set_log_level (9);
805         }
806         //
807         // Setup Kerberos
808 #ifdef HAVE_TLS_KDH
809         E_g2e ("Kerberos initialisation failed",
810                 setup_starttls_kerberos ());
811 #endif
812         //
813         // Setup callbacks for user communication
814         gnutls_pkcs11_set_token_function (gnutls_token_callback, NULL);
815         gnutls_pkcs11_set_pin_function (gnutls_pin_callback, NULL);
816         //
817         // Setup DH parameters
818         E_g2e ("Loading DH params failed",
819                 load_dh_params ());
820         //
821         // Setup shared credentials for all client server processes
822         E_g2e ("Failed to setup GnuTLS callback credentials",
823                 setup_starttls_credentials ());
824         //
825         // Parse the default priority string
826 #ifdef HAVE_TLS_KDH
827         E_g2e ("Failed to setup NORMAL priority cache",
828                 gnutls_priority_init (&priority_normal,
829                         "NONE:"
830                         "%ASYM_CERT_TYPES:"
831                         "+VERS-TLS-ALL:+VERS-DTLS-ALL:"
832                         "+COMP-NULL:"
833                         "+CIPHER-ALL:+CURVE-ALL:+SIGN-ALL:+MAC-ALL:"
834                         "+ANON-ECDH:"
835                         "+ECDHE-KRB:" // +ECDHE-KRB-RSA:+ECDHE-KRB-ECDSA:"
836                         "+ECDHE-RSA:+DHE-RSA:+ECDHE-ECDSA:+DHE-DSS:+RSA:"
837                         "+CTYPE-SRV-KRB:+CTYPE-SRV-X.509:+CTYPE-SRV-OPENPGP:"
838                         "+CTYPE-CLI-KRB:+CTYPE-CLI-X.509:+CTYPE-CLI-OPENPGP"
839 #ifdef EXPERIMENTAL_SRP
840                         ":+SRP:+SRP-RSA:+SRP-DSS"
841 #endif
842                         ,NULL));
843 #else
844         E_g2e ("Failed to setup NORMAL priority cache",
845                 gnutls_priority_init (&priority_normal,
846                         "NONE:"
847                         "+VERS-TLS-ALL:+VERS-DTLS-ALL:"
848                         "+COMP-NULL:+CIPHER-ALL:+CURVE-ALL:+SIGN-ALL:+MAC-ALL:"
849                         "+ANON-ECDH:"
850                         "+ECDHE-RSA:+DHE-RSA:+ECDHE-ECDSA:+DHE-DSS:+RSA:"
851                         "+CTYPE-X.509:+CTYPE-OPENPGP"
852 #ifdef EXPERIMENTAL_SRP
853                         ":+SRP:+SRP-RSA:+SRP-DSS"
854 #endif
855                         ,NULL));
856 #endif
857         //
858         // Try to setup on-the-fly signing key / certificate and gen a certkey
859         otfsigcrt = cfg_tls_onthefly_signcert ();
860         otfsigkey = cfg_tls_onthefly_signkey ();
861 fprintf (stderr, "DEBUG: gtls_errno = %d, otfsigcrt == %s, otfsigkey == %s\n", gtls_errno, otfsigcrt? otfsigcrt: "NULL", otfsigkey? otfsigkey: "NULL");
862         if ((gtls_errno == GNUTLS_E_SUCCESS) && (otfsigcrt != NULL)) {
863                 FILE *crtfile = NULL;
864 fprintf (stderr, "DEBUG: gtls_errno==%d when initialising onthefly_issuercrt\n", gtls_errno);
865                 E_g2e ("Failed to initialise on-the-fly issuer certificate structure",
866                         gnutls_x509_crt_init (&onthefly_issuercrt));
867                 if (strncmp (otfsigcrt, "file:", 5) == 0) {
868                         // Provisionary support for the "file:" prefix
869                         otfsigcrt += 5;
870                 }
871                 crtfile = fopen (otfsigcrt, "r");
872                 if (crtfile == NULL) {
873                         E_g2e ("Failed to open on-the-fly issuer certificate file",
874                                 GNUTLS_E_FILE_ERROR);
875 fprintf (stderr, "DEBUG: gtls_errno==%d after failing to open file for onthefly_issuercrt\n", gtls_errno);
876                 } else {
877                         char crt [5001];
878                         size_t len = fread (crt, 1, sizeof (crt), crtfile);
879                         if (ferror (crtfile)) {
880                                 E_g2e ("Failed to read on-the-fly issuer certificate from file",
881                                         GNUTLS_E_FILE_ERROR);
882                         } else if ((len >= sizeof (crt)) || !feof (crtfile)) {
883                                 E_g2e ("Unexpectedly long on-the-fly issuer certificate file",
884                                         GNUTLS_E_FILE_ERROR);
885                         } else {
886                                 gnutls_datum_t cd = {
887                                         .data = (unsigned char *)(&crt[0]),
888                                         .size = len
889                                 };
890 fprintf (stderr, "DEBUG: gtls_errno==%d before importing onthefly_issuercrt\n", gtls_errno);
891                                 E_g2e ("Failed to import on-the-fly certificate from file",
892                                         gnutls_x509_crt_import (onthefly_issuercrt, &cd, GNUTLS_X509_FMT_DER));
893 fprintf (stderr, "DEBUG: gtls_errno==%d after  importing onthefly_issuercrt\n", gtls_errno);
894                         }
895                         fclose (crtfile);
896                 }
897         }
898         if ((gtls_errno == GNUTLS_E_SUCCESS) && (otfsigkey != NULL)) {
899                 E_g2e ("Failed to initialise on-the-fly issuer private key structure",
900                         gnutls_privkey_init (&onthefly_issuerkey));
901 fprintf (stderr, "DEBUG: before onthefly p11 import, gtls_errno = %d\n", gtls_errno);
902                 E_g2e ("Failed to import pkcs11: URI into on-the-fly issuer private key",
903                         gnutls_privkey_import_pkcs11_url (onthefly_issuerkey, otfsigkey));
904 fprintf (stderr, "DEBUG: after  onthefly p11 import, gtls_errno = %d\n", gtls_errno);
905         }
906 fprintf (stderr, "DEBUG: When it matters, gtls_errno = %d, onthefly_issuercrt %s NULL, onthefly_issuerkey %s NULL\n", gtls_errno, onthefly_issuercrt?"!=":"==", onthefly_issuerkey?"!=":"==");
907         if ((gtls_errno == GNUTLS_E_SUCCESS) && (onthefly_issuercrt != NULL) && (onthefly_issuerkey != NULL)) {
908                 E_g2e ("Failed to initialise on-the-fly certificate session key",
909                         gnutls_x509_privkey_init (&onthefly_subjectkey));
910                 E_g2e ("Failed to generate on-the-fly certificate session key",
911                         gnutls_x509_privkey_generate (onthefly_subjectkey, GNUTLS_PK_RSA, 2048 /*TODO:FIXED*/, 0));
912                 if (gtls_errno == GNUTLS_E_SUCCESS) {
913                         tlog (TLOG_TLS, LOG_INFO, "Setup for on-the-fly signing with the TLS Pool");
914                 } else {
915                         tlog (TLOG_TLS, LOG_ERR, "Failed to setup on-the-fly signing (shall continue without it)");
916                         gnutls_x509_privkey_deinit (onthefly_subjectkey);
917                         onthefly_subjectkey = NULL;
918                 }
919         } else {
920                 gtls_errno = GNUTLS_E_SUCCESS;
921                 E_gnutls_clear_errno ();
922         }
923         if (onthefly_subjectkey == NULL) {
924                 if (onthefly_issuercrt != NULL) {
925                         gnutls_x509_crt_deinit (onthefly_issuercrt);
926                         onthefly_issuercrt = NULL;
927                 }
928                 if (onthefly_issuerkey != NULL) {
929                         gnutls_privkey_deinit (onthefly_issuerkey);
930                         onthefly_issuerkey = NULL;
931                 }
932         }
933         //
934         // Finally, check whether there was any error setting up GnuTLS
935         if (gtls_errno != GNUTLS_E_SUCCESS) {
936                 tlog (TLOG_TLS, LOG_CRIT, "FATAL: GnuTLS setup failed: %s", gnutls_strerror (gtls_errno));
937                 exit (1);
938         }
939         //MOVED// //
940         //MOVED// // Setup the management databases
941         //MOVED// tlog (TLOG_DB, LOG_DEBUG, "Setting up management databases");
942         //MOVED// E_e2e ("Failed to setup management databases",
943         //MOVED//       setup_management ());
944         //MOVED// if (errno != 0) {
945         //MOVED//       tlog (TLOG_DB, LOG_CRIT, "FATAL: Management databases setup failed: %s", strerror (errno));
946         //MOVED//       exit (1);
947         //MOVED// }
948 }
949
950 /* Cleanup the structures and resources that were setup for handling TLS.
951  */
952 void cleanup_starttls (void) {
953         //MOVED// cleanup_management ();
954         if (onthefly_subjectkey != NULL) {
955                 gnutls_x509_privkey_deinit (onthefly_subjectkey);
956                 onthefly_subjectkey = NULL;
957         }
958         if (onthefly_issuercrt != NULL) {
959                 gnutls_x509_crt_deinit (onthefly_issuercrt);
960                 onthefly_issuercrt = NULL;
961         }
962         if (onthefly_issuerkey != NULL) {
963                 gnutls_privkey_deinit (onthefly_issuerkey);
964                 onthefly_issuerkey = NULL;
965         }
966
967         cleanup_starttls_credentials ();
968 #ifdef HAVE_TLS_KDH
969         cleanup_starttls_kerberos ();
970 #endif
971         remove_dh_params ();
972         gnutls_pkcs11_set_pin_function (NULL, NULL);
973         gnutls_pkcs11_set_token_function (NULL, NULL);
974         gnutls_pkcs11_deinit ();
975         gnutls_priority_deinit (priority_normal);
976         gnutls_global_deinit ();
977 }
978
979
980 /*
981  * The copycat function is a bidirectional transport between the given
982  * remote and local sockets, but it will encrypt traffic from local to
983  * remote, and decrypt traffic from remote to local.  It will do this
984  * until one of the end points is shut down, at which time it will
985  * return and assume the context will close down both pre-existing
986  * sockets.
987  *
988  * This copycat actually has a few sharp claws to watch for -- shutdown
989  * of sockets may drop the last bit of information sent.  First, the
990  * signal POLLHUP is best ignored because it travels asynchronously.
991  * Second, reading 0 is a good indicator of end-of-file and may be
992  * followed by an shutdown of reading from that stream.  But, more
993  * importantly, the other side must have this information forwarded
994  * so it can shutdown.  This means that a shutdown for writing to that
995  * stream is to be sent.  Even when *both* sides have agreed to not send
996  * anything, they may still not have received all they were offered for
997  * reading, so we should SO_LINGER on the sockets so they can acknowledge,
998  * and after a timeout we can establish that shutdown failed and log and
999  * return an error for it.
1000  * Will you believe that I had looked up if close() would suffice?  The man
1001  * page clearly stated yes.  However, these articles offer much more detail:
1002  * http://blog.netherlabs.nl/articles/2009/01/18/the-ultimate-so_linger-page-or-why-is-my-tcp-not-reliable
1003  * http://www.greenend.org.uk/rjk/tech/poll.html
1004  *
1005  * This function blocks during its call to poll(), in a state that can easily
1006  * be restarted.  This is when thread cancellation is temporarily enabled.
1007  * Other threads may use this to cancel the thread and have it joined with that
1008  * thread which will subsume its tasks and restart the handshake.  We might
1009  * later make this more advanced, by using a cancel stack push/pull mechanisms
1010  * to ensure that recv() always results in send() in spite of cancellation.
1011  *
1012  * The return value of copycat is a GNUTLS_E_ code, usually GNUTLS_E_SUCCESS.
1013  * For the moment, only one special value is of concern, namely
1014  * GNUTLS_E_REHANDSHAKE which client or server side may receive when an
1015  * attempt is made to renegotiate the security of the connection.
1016  */
1017 static int copycat (int local, int remote, gnutls_session_t wrapped, int client) {
1018         char buf [1024];
1019         struct pollfd inout [3];
1020         ssize_t sz;
1021         struct linger linger = { 1, 10 };
1022         int have_client;
1023         int retval = GNUTLS_E_SUCCESS;
1024         bool local_shutdown_done = false;
1025         bool remote_shutdown_done = false;
1026         
1027         client = -1;
1028         inout [0].fd = local;
1029         inout [1].fd = remote;
1030 #ifdef WINDOWS_PORT
1031         have_client = 0;
1032 #else
1033         inout [2].fd = client;
1034         have_client = inout [2].fd >= 0;
1035 #endif
1036         if (!have_client) {
1037                 inout [2].revents = 0;  // Will not be written by poll
1038                 //FORK!=DETACH// inout [2].fd = ctlkey_signalling_fd;
1039         }
1040         inout [0].events = POLLIN;
1041         inout [1].events = POLLIN;
1042         inout [2].events = 0;   // error events only
1043         tlog (TLOG_COPYCAT, LOG_DEBUG, "Starting copycat cycle for local=%d, remote=%d, control=%d", local, remote, client);
1044         while (((inout [0].events | inout [1].events) & POLLIN) != 0) {
1045                 int polled;
1046                 assert (pthread_setcancelstate (PTHREAD_CANCEL_ENABLE,  NULL) == 0);
1047                 pthread_testcancel ();  // Efficiency & Certainty
1048                 polled = poll (inout, have_client? 3: 2, -1);
1049                 assert (pthread_setcancelstate (PTHREAD_CANCEL_DISABLE, NULL) == 0);
1050                 if (polled == -1) {
1051                         tlog (TLOG_COPYCAT, LOG_DEBUG, "Copycat polling returned an error");
1052                         break;  // Polling sees an error
1053                 }
1054                 tlog (TLOG_COPYCAT, LOG_DEBUG, "inout [0].revents 0x%04x", inout [0].revents);
1055                 tlog (TLOG_COPYCAT, LOG_DEBUG, "inout [1].revents 0x%04x", inout [1].revents);
1056                 if (inout [0].revents & (POLLIN | POLLHUP)) {
1057                         // Read local and encrypt to remote
1058                         sz = 0;
1059                         if ((inout [0].revents & POLLIN) || !local_shutdown_done) {
1060                                 sz = recv (local, buf, sizeof (buf), RECV_FLAGS);
1061                         }
1062                         tlog (TLOG_COPYCAT, LOG_DEBUG, "Copycat received %d local bytes (or error<0) from %d", (int) sz, local);
1063                         if (sz == -1) {
1064                                 tlog (TLOG_COPYCAT, LOG_ERR, "Error while receiving: %s", strerror (errno));
1065                                 break;  // stream error
1066                         } else if (sz == 0) {
1067                                 inout [0].events &= ~POLLIN;
1068                                 if (local_shutdown_done) {
1069                                         tlog (TLOG_COPYCAT, LOG_DEBUG, "already done local shutdown");
1070                                 } else {
1071                                         shutdown (local, SHUT_RD);
1072 #ifdef WINDOWS_PORT
1073                                         setsockopt (remote, SOL_SOCKET, SO_LINGER, (const char *) &linger, sizeof (linger));
1074 #else /* WINDOWS_PORT */
1075                                         setsockopt (remote, SOL_SOCKET, SO_LINGER, &linger, sizeof (linger));
1076 #endif /* WINDOWS_PORT */
1077                                         tlog (TLOG_COPYCAT, LOG_DEBUG, "Sending gnutls_bye");
1078                                         gnutls_bye (wrapped, GNUTLS_SHUT_WR);
1079                                         local_shutdown_done = true;
1080                                 }
1081                         } else if (gnutls_record_send (wrapped, buf, sz) != sz) {
1082                                 tlog (TLOG_COPYCAT, LOG_ERR, "gnutls_record_send() failed to pass on the requested bytes");
1083                                 break;  // communication error
1084                         } else {
1085                                 tlog (TLOG_COPYCAT, LOG_DEBUG, "Copycat sent %d bytes to remote %d", (int) sz, remote);
1086                         }
1087                 }
1088                 if (inout [1].revents & (POLLIN | POLLHUP)) {
1089                         // Read remote and decrypt to local
1090                         gnutls_packet_t packet;
1091                         sz = 0;
1092                         if ((inout [1].revents & POLLIN) || !remote_shutdown_done) {
1093                                 sz = gnutls_record_recv_packet (wrapped, &packet);
1094                         }
1095                         tlog (TLOG_COPYCAT, LOG_DEBUG, "Copycat received %d remote bytes from %d (or error if <0)", (int) sz, remote);
1096                         if (sz < 0) {
1097                                 //TODO// Process GNUTLS_E_REHANDSHAKE
1098                                 if (sz == GNUTLS_E_REHANDSHAKE) {
1099                                         tlog (TLOG_TLS, LOG_INFO, "Received renegotiation request over TLS handle %d", remote);
1100                                         retval = GNUTLS_E_REHANDSHAKE;
1101                                         break;
1102                                 } else if (gnutls_error_is_fatal (sz)) {
1103                                         tlog (TLOG_TLS, LOG_ERR, "GnuTLS fatal error: %s", gnutls_strerror (sz));
1104                                         break;  // stream error
1105                                 } else {
1106                                         tlog (TLOG_TLS, LOG_INFO, "GnuTLS recoverable error: %s", gnutls_strerror (sz));
1107                                 }
1108                         } else if (sz == 0) {
1109                                 inout [1].events &= ~POLLIN;
1110                                 if (remote_shutdown_done) {
1111                                         tlog (TLOG_COPYCAT, LOG_DEBUG, "already done remote shutdown");
1112                                 } else {
1113                                         shutdown (remote, SHUT_RD);
1114                                         setsockopt (local, SOL_SOCKET, SO_LINGER, (void *) &linger, sizeof (linger));
1115                                         shutdown (local, SHUT_WR);
1116                                         remote_shutdown_done = true;
1117                                 }
1118                         } else { /* sz > 0 */
1119                                 gnutls_datum_t data;
1120                                 gnutls_packet_get(packet, &data, NULL);
1121                                 sz = send (local, data.data, data.size, RECV_FLAGS);
1122                                 gnutls_packet_deinit(packet);
1123                                 if (sz != data.size) {
1124                                         break;  // communication error
1125                                 }
1126                                 tlog (TLOG_COPYCAT, LOG_DEBUG, "Copycat sent %d bytes to local %d", (int) sz, local);
1127                         }
1128                 }
1129                 inout [0].revents &= ~(POLLIN | POLLHUP); // Thy copying cat?
1130                 inout [1].revents &= ~(POLLIN | POLLHUP); // Retract thee claws!
1131                 if ((inout [0].revents | inout [1].revents) & ~POLLIN) {
1132                         tlog (TLOG_COPYCAT, LOG_DEBUG, "Copycat data connection polling returned a special condition");
1133                         break;  // Apparently, one of POLLERR, POLLHUP, POLLNVAL
1134                 }
1135 #ifndef WINDOWS_PORT
1136                 if (inout [2].revents & ~POLLIN) {
1137                         if (have_client) {
1138                                 // This case is currently not ever triggered
1139                                 tlog (TLOG_COPYCAT, LOG_DEBUG, "Copycat control connection polling returned a special condition");
1140                                 break;  // Apparently, one of POLLERR, POLLHUP, POLLNVAL
1141                         } else {
1142                                 inout [2].fd = client;
1143                                 have_client = inout [2].fd >= 0;
1144                                 if (have_client) {
1145                                         tlog (TLOG_COPYCAT, LOG_DEBUG, "Copycat signalling_fd polling raised a signal to set control fd to %d", inout [2].fd);
1146                                 } else {
1147                                         tlog (TLOG_COPYCAT, LOG_DEBUG, "Copycat signalling_fd polling raised a signal that could be ignored");
1148                                 }
1149                                 continue;
1150                         }
1151                 }
1152 #endif /* !WINDOWS_PORT */
1153         }
1154         tlog (TLOG_COPYCAT, LOG_DEBUG, "Ending copycat cycle for local=%d, remote=%d", local, remote);
1155         return retval;
1156 }
1157
1158
1159 /* The callback function that retrieves certification information from either
1160  * the client or the server in the course of the handshake procedure.
1161  */
1162 gtls_error clisrv_cert_retrieve (gnutls_session_t session,
1163                                 const gnutls_datum_t* req_ca_dn,
1164                                 int nreqs,
1165                                 const gnutls_pk_algorithm_t* pk_algos,
1166                                 int pk_algos_length,
1167                                 gnutls_pcert_st** pcert,
1168                                 unsigned int *pcert_length,
1169                                 gnutls_privkey_t *pkey) {
1170         gnutls_certificate_type_t certtp;
1171         gnutls_pcert_st *pc = NULL;
1172         struct command *cmd, **pcmd;
1173         char *lid, *rid;
1174         gnutls_datum_t privdatum = { NULL, 0 };
1175         gnutls_datum_t certdatum = { NULL, 0 };
1176         gnutls_openpgp_crt_t pgpcert = NULL;
1177         gnutls_openpgp_privkey_t pgppriv = NULL;
1178         int gtls_errno = GNUTLS_E_SUCCESS;
1179         int lidtype;
1180         int lidrole = 0;
1181         char *rolestr;
1182         char sni [sizeof (cmd->cmd.pio_data.pioc_starttls.localid)];
1183         size_t snilen = sizeof (sni);
1184         unsigned int snitype;
1185         int ok;
1186         uint32_t flags;
1187         char *p11priv;
1188         uint8_t *pubdata;
1189         int pubdatalen;
1190         gtls_error fetch_local_credentials (struct command *cmd);
1191         gnutls_pcert_st *load_certificate_chain (uint32_t flags, unsigned int *chainlen, gnutls_datum_t *certdatum);
1192
1193         //
1194         // Setup a number of common references and structures
1195         errno = 0;
1196         *pcert = NULL;
1197         pcmd = (struct command **) gnutls_session_get_ptr (session);
1198         if (pcmd == NULL) {
1199                 E_g2e ("No data pointer with session",
1200                         GNUTLS_E_INVALID_SESSION);
1201                 return gtls_errno;
1202         }
1203         cmd = *pcmd;
1204         tlog (LOG_DAEMON, LOG_DEBUG, "clisrv_cert_retrieve() retrieved session pointer %p\n", cmd);
1205         if (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALROLE_CLIENT) {
1206                 lidrole = LID_ROLE_CLIENT;
1207                 rolestr = "client";
1208         } else if (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALROLE_SERVER) {
1209                 lidrole = LID_ROLE_SERVER;
1210                 rolestr = "server";
1211         } else {
1212                 E_g2e ("TLS Pool command supports neither local client nor local server role",
1213                         GNUTLS_E_INVALID_SESSION);
1214                 return gtls_errno;
1215         }
1216         lid = cmd->cmd.pio_data.pioc_starttls.localid;
1217         rid = cmd->cmd.pio_data.pioc_starttls.remoteid;
1218
1219         //
1220         // On a server, lookup the server name and match it against lid.
1221         // TODO: For now assume a single server name in SNI (as that is normal).
1222         if (lidrole == LID_ROLE_SERVER) {
1223                 if (gnutls_server_name_get (session, sni, &snilen, &snitype, 0) || (snitype != GNUTLS_NAME_DNS)) {
1224                         E_g2e ("Requested SNI error or not a DNS name",
1225                                 GNUTLS_E_NO_CERTIFICATE_FOUND);
1226                         return gtls_errno;
1227                 }
1228                 if (*lid != '\0') {
1229                         char *lid_dom;
1230                         lid_dom = strrchr (lid, '@');
1231                         if (lid_dom == NULL) {
1232                                 lid_dom = lid;
1233                         } else {
1234                                 lid_dom++;
1235                         }
1236                         if (strcmp (sni, lid_dom) != 0) {
1237                                 tlog (TLOG_TLS, LOG_ERR, "SNI %s does not match preset local identity %s", sni, lid);
1238                                 E_g2e ("Requested SNI does not match local identity",
1239                                         GNUTLS_E_NO_CERTIFICATE_FOUND);
1240                                 return gtls_errno;
1241                         }
1242                 } else {
1243                         // TODO: Should ask for permission before accepting SNI
1244                         memcpy (lid, sni, sizeof (sni));
1245                         tlog (TLOG_TLS, LOG_INFO, "Copied SNI %s into local identity", sni);
1246                 }
1247         }
1248
1249         //
1250         // Setup the lidtype parameter for responding
1251 #ifdef HAVE_TLS_KDH
1252         certtp = gnutls_certificate_type_get_ours (session);
1253 #else
1254         certtp = gnutls_certificate_type_get (session);
1255 #endif
1256         if (certtp == GNUTLS_CRT_OPENPGP) {
1257                 tlog (TLOG_TLS, LOG_INFO, "Serving OpenPGP certificate request as a %s", rolestr);
1258                 lidtype = LID_TYPE_PGP;
1259         } else if (certtp == GNUTLS_CRT_X509) {
1260                 tlog (TLOG_TLS, LOG_INFO, "Serving X.509 certificate request as a %s", rolestr);
1261                 lidtype = LID_TYPE_X509;
1262 #ifdef HAVE_TLS_KDH
1263         } else if (certtp == GNUTLS_CRT_KRB) {
1264                 tlog (TLOG_TLS, LOG_INFO, "Serving Kerberos Ticket request as a %s", rolestr);
1265                 lidtype = LID_TYPE_KRB5;
1266 #endif
1267         } else {
1268                 // GNUTLS_CRT_RAW, GNUTLS_CRT_UNKNOWN, or other
1269                 tlog (TLOG_TLS, LOG_ERR, "Funny sort of certificate %d retrieval attempted as a %s", certtp, rolestr);
1270                 E_g2e ("Requested certtype is neither X.509 nor OpenPGP",
1271                         GNUTLS_E_CERTIFICATE_ERROR);
1272                 return gtls_errno;
1273         }
1274
1275         //
1276         // Find the prefetched local identity to use towards this remote
1277         // Send a callback to the user if none is available and accessible
1278         if (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALID_CHECK) {
1279                 //TODO// Up to the commit blamed for this line, we silently dropped cmd and had a resp instead
1280                 uint32_t oldcmd = cmd->cmd.pio_cmd;
1281                 assert (cmd->passfd < 0);       // There is no way this could already be used
1282                 cmd->cmd.pio_cmd = PIOC_STARTTLS_LOCALID_V2;
1283                 tlog (TLOG_UNIXSOCK, LOG_DEBUG, "Calling send_callback_and_await_response with PIOC_STARTTLS_LOCALID_V2 on %s", cmd->cmd.pio_data.pioc_starttls.localid);
1284                 cmd = *pcmd = send_callback_and_await_response (cmd, 0);
1285                 assert (cmd != NULL);   // No timeout requested, so the return should never be NULL
1286                 if (cmd->cmd.pio_cmd != PIOC_STARTTLS_LOCALID_V2) {
1287                         tlog (TLOG_UNIXSOCK, LOG_ERR, "Callback response has unexpected command code");
1288                         cmd->cmd.pio_cmd = oldcmd;
1289                         return GNUTLS_E_CERTIFICATE_ERROR;
1290                 }
1291                 cmd->cmd.pio_cmd = oldcmd;
1292                 //WHYWOULDWEASSUMETHIS// assert (resp == cmd);  // No ERROR, so should be the same
1293                 tlog (TLOG_UNIXSOCK, LOG_DEBUG, "Processing callback response that sets plainfd:=%d and lid:=\"%s\" for rid==\"%s\"", cmd->passfd, lid, rid);
1294                 // Accept passfd if it is >= 0
1295                 if (cmd->passfd >= 0) {
1296                         fprintf (stderr, "Received a file descriptor; passing it to the main starttls function\n");
1297                 }
1298                 //
1299                 // Check that new rid is a generalisation of original rid
1300                 // Note: This is only of interest for client operation
1301                 if (lidrole == LID_ROLE_CLIENT) {
1302                         selector_t newrid = donai_from_stable_string (rid, strlen (rid));
1303                         donai_t oldrid = donai_from_stable_string (cmd->orig_starttls->remoteid, strlen (cmd->orig_starttls->remoteid));
1304                         if (!donai_matches_selector (&oldrid, &newrid)) {
1305                                 return GNUTLS_E_NO_CERTIFICATE_FOUND;
1306                         }
1307                 }
1308                 //
1309                 // Now reiterate to lookup lid credentials in db_localid
1310                 E_g2e ("Missing local credentials",
1311                         fetch_local_credentials (cmd));
1312         }
1313         if (cmd->lids [lidtype - LID_TYPE_MIN].data == NULL) {
1314 fprintf (stderr, "DEBUG: Missing certificate for local ID %s and remote ID %s\n", lid, rid);
1315                 E_g2e ("Missing certificate for local ID",
1316                         GNUTLS_E_NO_CERTIFICATE_FOUND);
1317                 return gtls_errno;
1318         }
1319
1320         //
1321         // Split the credential into its various aspects
1322         ok = dbcred_interpret (
1323                 &cmd->lids [lidtype - LID_TYPE_MIN],
1324                 &flags,
1325                 &p11priv,
1326                 &certdatum.data,
1327                 &certdatum.size);
1328         tlog (TLOG_DB, LOG_DEBUG, "BDB entry has flags=0x%08x, p11priv=\"%s\", cert.size=%d", flags, p11priv, certdatum.size);
1329         //TODO// ok = ok && verify_cert_... (...); -- keyidlookup
1330         if (!ok) {
1331                 gtls_errno = GNUTLS_E_CERTIFICATE_ERROR;
1332         }
1333
1334         //
1335         // Allocate response structures
1336         *pcert_length = 0;
1337         *pcert = load_certificate_chain (flags, pcert_length, &certdatum);
1338         if (*pcert == NULL) {
1339                 E_g2e ("Failed to load certificate chain",
1340                         GNUTLS_E_CERTIFICATE_ERROR);
1341                 return gtls_errno;
1342         }
1343         cmd->session_certificate = (intptr_t) (void *) *pcert;  //TODO// Used for session cleanup
1344
1345         //
1346         // Setup private key
1347         E_g2e ("Failed to initialise private key",
1348                 gnutls_privkey_init (
1349                         pkey));
1350         if ((onthefly_subjectkey != NULL) && (strcmp (p11priv, onthefly_p11uri) == 0)) {
1351                 // Setup the on-the-fly certification key as private key
1352                 E_g2e ("Failed to import on-the-fly subject private key",
1353                         gnutls_privkey_import_x509 (
1354                                 *pkey,
1355                                 onthefly_subjectkey,
1356                                 GNUTLS_PRIVKEY_IMPORT_COPY));
1357 #ifdef HAVE_TLS_KDH
1358         } else if (lidtype == LID_TYPE_KRB5) {
1359                 // Fake a private key for Kerberos (we sign it out here, not GnuTLS)
1360                 E_g2e ("Failed to generate a private-key placeholder for Kerberos",
1361                         gnutls_privkey_generate_krb (
1362                                 *pkey,
1363                                 0));
1364 #endif
1365         } else {
1366                 // Import the PKCS #11 key as the private key for use by GnuTLS
1367                 if (gtls_errno == GNUTLS_E_SUCCESS) {
1368                         cmd->session_privatekey = (intptr_t) (void *) *pkey;    //TODO// Used for session cleanup
1369                 }
1370                 E_g2e ("Failed to import PKCS #11 private key URI",
1371                         gnutls_privkey_import_pkcs11_url (
1372                                 *pkey,
1373                                 p11priv));
1374         }
1375         E_gnutls_clear_errno ();
1376
1377 //TODO// Moved out (start)
1378
1379         //
1380         // Setup public key certificate
1381         switch (lidtype) {
1382         case LID_TYPE_X509:
1383                 E_g2e ("MOVED: Failed to import X.509 certificate into chain",
1384                         gnutls_pcert_import_x509_raw (
1385                                 *pcert,
1386                                 &certdatum,
1387                                 GNUTLS_X509_FMT_DER,
1388                                 0));
1389                 break;
1390         case LID_TYPE_PGP:
1391                 E_g2e ("MOVED: Failed to import OpenPGP public key",
1392                         gnutls_pcert_import_openpgp_raw (
1393                                 *pcert,
1394                                 &certdatum,
1395                                 GNUTLS_OPENPGP_FMT_RAW,
1396                                 NULL,   /* use master key */
1397                                 0));
1398                 break;
1399 #ifdef HAVE_TLS_KDH
1400         case LID_TYPE_KRB5:
1401                 if (lidrole == LID_ROLE_CLIENT) {
1402                         //
1403                         // KDH-Only or KDH-Enhanced; fetch ticket for localid
1404                         // and a TGT based on it for service/remoteid@REALM
1405                         //
1406                         // First, try to obtain a TGT and key, in various ways
1407                         krb5_keyblock key;
1408                         krb5_creds *tgt = NULL;
1409                         krb5_creds *ticket = NULL;
1410                         krb5_ccache cc = NULL;
1411                         int status = 0;
1412                         memset (&key,    0, sizeof (key   ));
1413                         status = have_key_tgt_cc (
1414                                 cmd, krbctx_cli,
1415                                 1, 0, 0,
1416                                 p11priv,
1417                                 krb_kt_cli,
1418                                 &key, &tgt, &cc);
1419                         if (status >= 1) {
1420                                 // We never use this key ourselves
1421                                 krb5_free_keyblock_contents (krbctx_cli, &key);
1422                         }
1423                         if (status < 2) {
1424                                 // Stop processing when no tgt was found
1425                                 gtls_errno = GNUTLS_E_NO_CERTIFICATE_FOUND;
1426                                 break;
1427                         }
1428                         //
1429                         // Store client identity in session object
1430                         if (0 != krb5_copy_principal (
1431                                         krbctx_cli,
1432                                         tgt->client,
1433                                         &cmd->krbid_cli)) {
1434                                 krb5_free_creds (krbctx_cli, tgt);
1435                                 tgt = NULL;
1436                                 if (cc != NULL) {
1437                                         krb5_cc_close (krbctx_cli, cc);
1438                                         cc = NULL;
1439                                 }
1440                                 gtls_errno = GNUTLS_E_NO_CERTIFICATE_FOUND;
1441                                 break;
1442                         }
1443                         //
1444                         // Now find a service ticket to talk to, and its key
1445                         //TODO// Pass credcache instead?
1446                         status = have_service_ticket (
1447                                 cmd, krbctx_cli,
1448                                 cc,
1449                                 cmd->krbid_cli,
1450                                 &ticket);
1451                         if (cc != NULL) {
1452                                 // We don't need cc anymore below
1453                                 krb5_cc_close (krbctx_cli, cc);
1454                         }
1455                         if (status < 1) {
1456                                 // Stop processing when no ticket was found
1457                                 krb5_free_creds (krbctx_cli, tgt);
1458                                 tgt = NULL;
1459                                 gtls_errno = GNUTLS_E_NO_CERTIFICATE_FOUND;
1460                                 break;
1461                         }
1462                         //
1463                         // Only for KDH-Only mode can the client rely on a
1464                         // server principal taken from the ticket;
1465                         // So only store krbid_srv for KDH-Only mode.
1466                         if ((gnutls_certificate_type_get_peers (cmd->session)
1467                                                 == GNUTLS_CRT_KRB) &&
1468                                         (0 != krb5_copy_principal (
1469                                                 krbctx_cli,
1470                                                 tgt->server,
1471                                                 &cmd->krbid_srv))) {
1472                                 krb5_free_creds (krbctx_cli, ticket);
1473                                 gtls_errno = GNUTLS_E_NO_CERTIFICATE_FOUND;
1474                                 break;
1475                         }
1476                         krb5_free_creds (krbctx_cli, tgt);
1477                         tgt = NULL;
1478                         if (0 != krb5_copy_keyblock_contents (
1479                                         krbctx_cli,
1480                                         &ticket->keyblock,
1481                                         &cmd->krb_key)) {
1482                                 gtls_errno = GNUTLS_E_NO_CERTIFICATE_FOUND;
1483                                 // continue, with E_g2e() skipping import
1484                         }
1485                         certdatum.data = ticket->ticket.data;
1486                         certdatum.size = ticket->ticket.length;
1487                         E_g2e ("MOVED: Failed to import Kerberos ticket",
1488                                 gnutls_pcert_import_krb_raw (
1489                                         *pcert,
1490                                         &certdatum,
1491                                         0));
1492                         krb5_free_creds (krbctx_cli, ticket);
1493                 } else {
1494                         //
1495                         // For KDH-Only, the server supplies one of:
1496                         //  - a TGT for user-to-user mode (for p2p exchanges)
1497                         //  - an DER NULL to waive u2u mode
1498                         //TODO// E_g2e ("MOVED: Failed to import Kerberos ticket",
1499                         //TODO//        gnutls_pcert_import_krb_raw (
1500                         //TODO//                *pcert,
1501                         //TODO//                &certdatum,     //TODO:WHATSFOUND//
1502                         //TODO//                0));
1503                         int u2u = 0;
1504                         int status = 0;
1505                         krb5_creds *tgt = NULL;
1506                         //
1507                         // Determine whether we want to run in user-to-user mode
1508                         // for which we should supply a TGT to the TLS client
1509                         u2u = u2u || ((PIOF_STARTTLS_BOTHROLES_PEER & ~cmd->cmd.pio_data.pioc_starttls.flags) == 0);
1510                         u2u = u2u || (strchr (rid, '@') != NULL);
1511                         // u2u = u2u || "shaken hands on TLS symmetry extension"
1512                         u2u = u2u && got_cc_srv;  // We may simply not be able!
1513                         //
1514                         // When not in user-to-user mode, deliver DER NULL
1515                         if (!u2u) {
1516                                 static unsigned char der_null_data[] = "\x05\x00";
1517                                 certdatum.data = der_null_data;
1518                                 certdatum.size = 2;
1519                                 E_g2e ("Failed to withhold Kerberos server ticket",
1520                                         gnutls_pcert_import_krb_raw (
1521                                                 *pcert,
1522                                                 &certdatum,
1523                                                 0));
1524                                 break;
1525                         }
1526                         //
1527                         // Continue specifically for user-to-user mode.
1528                         //TODO// Setup server principal identity
1529                         //
1530                         // Fetch the service's key
1531                         status = have_key_tgt_cc (
1532                                 cmd, krbctx_srv,
1533                                 1, 0, 0,        // Hmm... later we know kvno/etype
1534                                 p11priv,
1535                                 krb_kt_srv,
1536                                 &cmd->krb_key, &tgt, NULL);
1537                         if (status == 1) {
1538                                 // There's no use in having just the key
1539                                 krb5_free_keyblock_contents (krbctx_srv, &cmd->krb_key);
1540                                 memset (&cmd->krb_key, 0, sizeof (cmd->krb_key));
1541                         }
1542                         if (status < 2) {
1543                                 gtls_errno = GNUTLS_E_NO_CERTIFICATE_FOUND;
1544                         } else if (0 != krb5_copy_principal (
1545                                                 krbctx_srv,
1546                                                 tgt->server,
1547                                                 &cmd->krbid_srv)) {
1548                                 gtls_errno = GNUTLS_E_NO_CERTIFICATE_FOUND;
1549                         }
1550                         certdatum.data = tgt->ticket.data;
1551                         certdatum.size = tgt->ticket.length;
1552                         E_g2e ("Failed to withhold Kerberos server ticket",
1553                                 gnutls_pcert_import_krb_raw (
1554                                         *pcert,
1555                                         &certdatum,
1556                                         0));
1557                         krb5_free_creds (krbctx_cli, tgt);
1558                         tgt = NULL;
1559                 }
1560                 break;
1561 #endif
1562         default:
1563                 /* Should not happen */
1564                 break;
1565         }
1566
1567 //TODO// Moved out (end)
1568
1569 #ifdef ANCIENT_CODE_WHEN_DBERRNO_RAN_IN_PARALLEL
1570         //
1571         // Lap up any overseen POSIX error codes in errno
1572         if (errno) {
1573                 tlog (TLOG_TLS, LOG_DEBUG, "Failing TLS on errno=%d / %s", errno, strerror (errno));
1574                 cmd->session_errno = errno;
1575                 gtls_errno = GNUTLS_E_NO_CIPHER_SUITES; /* Vaguely matching */
1576         }
1577 #endif
1578
1579         //
1580         // Return the overral error code, hopefully GNUTLS_E_SUCCESS
1581         tlog (TLOG_TLS, LOG_DEBUG, "Returning %d / %s from clisrv_cert_retrieve()", gtls_errno, gnutls_strerror (gtls_errno));
1582 fprintf (stderr, "DEBUG: clisrv_cert_retrieve() sets *pcert to 0x%lx (length %d)... {pubkey = 0x%lx, cert= {data = 0x%lx, size=%ld}, type=%ld}\n", (long) *pcert, *pcert_length, (long) (*pcert)->pubkey, (long) (*pcert)->cert.data, (long) (*pcert)->cert.size, (long) (*pcert)->type);
1583         return gtls_errno;
1584 }
1585
1586 /* Load a single certificate in the given gnutls_pcert_st from the given
1587  * gnutls_datum_t.  Use the lidtype to determine how to do this.
1588  */
1589 gtls_error load_certificate (int lidtype, gnutls_pcert_st *pcert, gnutls_datum_t *certdatum) {
1590         int gtls_errno = GNUTLS_E_SUCCESS;
1591         //
1592         // Setup public key certificate
1593         switch (lidtype) {
1594         case LID_TYPE_X509:
1595 fprintf (stderr, "DEBUG: About to import %d bytes worth of X.509 certificate into chain: %02x %02x %02x %02x...\n", certdatum->size, certdatum->data[0], certdatum->data[1], certdatum->data[2], certdatum->data[3]);
1596                 E_g2e ("Failed to import X.509 certificate into chain",
1597                         gnutls_pcert_import_x509_raw (
1598                                 pcert,
1599                                 certdatum,
1600                                 GNUTLS_X509_FMT_DER,
1601                                 0));
1602                 break;
1603         case LID_TYPE_PGP:
1604                 E_g2e ("Failed to import OpenPGP certificate",
1605                         gnutls_pcert_import_openpgp_raw (
1606                                 pcert,
1607                                 certdatum,
1608                                 GNUTLS_OPENPGP_FMT_RAW,
1609                                 NULL,   /* use master key */
1610                                 0));
1611                 break;
1612         case LID_TYPE_KRB5:
1613                 /* Binary information is currently moot, so do not load it */
1614                 break;
1615         default:
1616                 /* Should not happen */
1617                 break;
1618         }
1619         return gtls_errno;
1620 }
1621
1622
1623 /* Load a certificate chain.  This returns a value for a retrieval function's
1624  * pcert, and also modifies the chainlen.  The latter starts at 0, and is
1625  * incremented in a nested procedure that unrolls until all certificates are
1626  * loaded.
1627  */
1628 gnutls_pcert_st *load_certificate_chain (uint32_t flags, unsigned int *chainlen, gnutls_datum_t *certdatum) {
1629         gnutls_pcert_st *chain;
1630         unsigned int mypos = *chainlen;
1631         int gtls_errno = GNUTLS_E_SUCCESS;
1632
1633         //
1634         // Quick and easy: No chaining required, just add the literal data.
1635         // Note however, this may be the end of a chain, so allocate all
1636         // structures and load the single one at the end.
1637         if ((flags & (LID_CHAINED | LID_NEEDS_CHAIN)) == 0) {
1638                 (*chainlen)++;
1639                 chain = (gnutls_pcert_st *) calloc (*chainlen, sizeof (gnutls_pcert_st));
1640                 if (chain != NULL) {
1641                         memset (chain,
1642                                 0,
1643                                 (*chainlen) * sizeof (gnutls_pcert_st));
1644                 } else {
1645                         gtls_errno = GNUTLS_E_MEMORY_ERROR;
1646                 }
1647                 E_g2e ("Failed to load certificate into chain",
1648                         load_certificate (
1649                                 flags & LID_TYPE_MASK,
1650                                 &chain [mypos],
1651                                 certdatum));
1652                 if (gtls_errno != GNUTLS_E_SUCCESS) {
1653                         if (chain) {
1654                                 free (chain);
1655                         }
1656                         *chainlen = 0;
1657                         chain = NULL;
1658                 }
1659                 return chain;
1660         }
1661
1662         //
1663         // First extended case.  Chain certs in response to LID_CHAINED.
1664         // Recursive calls are depth-first, so we only add our first cert
1665         // after a recursive call succeeds.  Any LID_NEEDS_CHAIN work is
1666         // added after LID_CHAINED, so is higher up in the hierarchy, but
1667         // it is loaded as part of the recursion.  To support that, a
1668         // recursive call with certdatum.size==0 is possible when the
1669         // LID_NEEDS_CHAIN flag is set, and this section then skips.
1670         // Note that this code is also used to load the certificate chain
1671         // provided by LID_NEEDS_CHAIN, but by then the flag in a recursive
1672         // call is replaced with LID_CHAINED and no more LID_NEEDS_CHAIN.
1673         if (((flags & LID_CHAINED) != 0) && (certdatum->size > 0)) {
1674                 long certlen;
1675                 int lenlen;
1676                 gnutls_datum_t nextdatum;
1677                 long nextlen;
1678                 // Note: Accept BER because the outside SEQUENCE is not signed
1679                 certlen = asn1_get_length_ber (
1680                         (certdatum->data) + 1,
1681                         certdatum->size,
1682                         &lenlen);
1683                 certlen += 1 + lenlen;
1684                 tlog (TLOG_CERT, LOG_DEBUG, "Found LID_CHAINED certificate size %d", certlen);
1685                 if (certlen > certdatum->size) {
1686                         tlog (TLOG_CERT, LOG_ERR, "Refusing LID_CHAINED certificate beyond data size %d", certdatum->size);
1687                         *chainlen = 0;
1688                         return NULL;
1689                 } else if (certlen <= 0) {
1690                         tlog (TLOG_CERT, LOG_ERR, "Refusing LID_CHAINED certificate of too-modest data size %d", certlen);
1691                         *chainlen = 0;
1692                         return NULL;
1693                 }
1694                 nextdatum.data = (certdatum->data) + certlen;
1695                 nextdatum.size =  certdatum->size  - certlen;
1696                 certdatum->size = certlen;
1697                 nextlen = asn1_get_length_ber (
1698                         nextdatum.data + 1,
1699                         nextdatum.size,
1700                         &lenlen);
1701                 nextlen += 1 + lenlen;
1702                 if (nextlen == nextdatum.size) {
1703                         // The last cert is loaded thinking it is not CHAINED,
1704                         // but NEEDS_CHAIN can still be present for expansion.
1705                         flags &= ~LID_CHAINED;
1706                 }
1707                 (*chainlen)++;
1708                 chain = load_certificate_chain (flags, chainlen, &nextdatum);
1709                 if (chain != NULL) {
1710                         E_g2e ("Failed to add chained certificate",
1711                                 load_certificate (
1712                                         flags & LID_TYPE_MASK,
1713                                         &chain [mypos],
1714                                         certdatum));
1715                         if (gtls_errno != GNUTLS_E_SUCCESS) {
1716                                 free (chain);
1717                                 chain = NULL;
1718                                 *chainlen = 0;
1719                         }
1720                 }
1721                 return chain;
1722         }
1723
1724         //
1725         // Second extended case.  Chain certs in response to LID_NEEDS_CHAIN.
1726         // These are the highest-up in the hierarchy, above any LID_CHAINED
1727         // certificates.  The procedure for adding them is looking them up
1728         // in a central database by their authority key identifier.  What is
1729         // found is assumed to be a chain, and will be unrolled by replacing
1730         // the LID_NEEDS_CHAIN flag with LID_CHAINED and calling recursively.
1731         if (((flags & LID_NEEDS_CHAIN) != 0) && (certdatum->size == 0)) {
1732                 //TODO//CODE// lookup new certdatum
1733                 flags &= ~LID_NEEDS_CHAIN;
1734                 flags |=  LID_CHAINED;
1735                 //TODO//CODE// recursive call
1736                 //TODO//CODE// no structures to fill here
1737                 //TODO//CODE// cleanup new certdatum
1738         }
1739
1740         //
1741         // Final judgement.  Nothing worked.  Return failure.
1742         *chainlen = 0;
1743         return NULL;
1744 }
1745
1746
1747
1748 /********** KERBEROS SUPPORT FUNCTIONS FOR TLS-KDH **********/
1749
1750
1751
1752 /* Prepare the Kerberos resources for use by clients and/or servers.
1753  */
1754 #ifdef HAVE_TLS_KDH
1755 static int setup_starttls_kerberos (void) {
1756         int k5err = 0;
1757         char *cfg;
1758         int retval = GNUTLS_E_SUCCESS;
1759         krb5_ccache krb_cc_tmp;
1760         const char *cctype_cli = NULL;
1761         const char *cctype_srv = NULL;
1762         //
1763         // Initialise
1764         krbctx_cli = krbctx_srv = NULL;
1765         krb_kt_cli = krb_kt_srv = NULL;
1766         got_cc_cli = got_cc_srv = 0;
1767         //
1768         // Construct credentials caching for Kerberos
1769         if (k5err == 0) {
1770                 k5err = krb5_init_context (&krbctx_cli);
1771         }
1772         if (k5err == 0) {
1773                 k5err = krb5_init_context (&krbctx_srv);
1774         }
1775         //
1776         // Load the various configuration variables
1777         cfg = cfg_krb_client_keytab ();
1778         if ((k5err == 0) && (cfg != NULL)) {
1779                 k5err = krb5_kt_resolve (krbctx_cli, cfg, &krb_kt_cli);
1780         }
1781         cfg = cfg_krb_server_keytab ();
1782         if ((k5err == 0) && (cfg != NULL)) {
1783                 k5err = krb5_kt_resolve (krbctx_srv, cfg, &krb_kt_srv);
1784         }
1785         cfg = cfg_krb_client_credcache ();
1786 #if 0  /* Temporary bypass of cctype checks */
1787         if ((k5err == 0) && (cfg != NULL)) {
1788                 k5err = krb5_cc_set_default_name (krbctx_cli, cfg);
1789                 if (k5err == 0) {
1790                         k5err = krb5_cc_default (krbctx_cli, &krb_cc_tmp);
1791                 }
1792                 if (k5err == 0) {
1793                         got_cc_cli = 1;
1794                         cctype_cli = krb5_cc_get_type (krbctx_cli, krb_cc_tmp);
1795                         krb5_cc_close (krbctx_cli, krb_cc_tmp);
1796                 }
1797         }
1798 #endif
1799         cfg = cfg_krb_server_credcache ();
1800 #if 0  /* Temporary bypass of cctype checks */
1801         if ((k5err == 0) && (cfg != NULL)) {
1802                 k5err = krb5_cc_set_default_name (krbctx_srv, cfg);
1803                 if (k5err == 0) {
1804                         k5err = krb5_cc_default (krbctx_srv, &krb_cc_tmp);
1805                 }
1806                 if (k5err == 0) {
1807                         got_cc_srv = 1;
1808                         cctype_srv = krb5_cc_get_type (krbctx_cli, krb_cc_tmp);
1809                         krb5_cc_close (krbctx_srv, krb_cc_tmp);
1810                 }
1811         }
1812 #endif
1813         //
1814         // Check for consistency and log helpful messages for the sysop
1815         if (k5err != 0) {
1816                 tlog (TLOG_DAEMON | TLOG_KERBEROS, LOG_ERR, "Error during STARTTLS setup: %s (acting on %s)",
1817                                 krb5_get_error_message (krbctx_cli, k5err),
1818                                 cfg);
1819                 retval = GNUTLS_E_UNWANTED_ALGORITHM;
1820         }
1821         if (krb_kt_cli != NULL) {
1822                 tlog (TLOG_DAEMON | TLOG_KERBEROS, LOG_WARNING, "Ignoring the configured kerberos_client_keytab -- it is not implemented yet");
1823         }
1824         if (krb_kt_srv == NULL) {
1825                 tlog (TLOG_DAEMON | TLOG_KERBEROS, LOG_ERR, "No kerberos_server_keytab configured, so Kerberos cannot work at all");
1826                 retval = GNUTLS_E_UNWANTED_ALGORITHM;
1827 /* TODO: Only for MIT krb5 1.11 and up
1828         } else if (0 == krb5_kt_have_content (krb_ctx, krb_kt_srv)) {
1829                 tlog (TLOG_DAEMON | TLOG_KERBEROS, LOG_ERR, "Keytab in kerberos_server_keytab is absent or empty");
1830                 retval = GNUTLS_E_UNWANTED_ALGORITHM;
1831  */
1832         }
1833         if (krbctx_cli == NULL) {
1834                 tlog (TLOG_DAEMON | TLOG_KERBEROS, LOG_ERR, "No kerberos_client_credcache configured, so Kerberos cannot work at all");
1835                 retval = GNUTLS_E_UNWANTED_ALGORITHM;
1836 #if 0  /* Temporary bypass of cctype checks */
1837         } else if (!krb5_cc_support_switch (
1838                         krbctx_cli, cctype_cli)) {
1839                 tlog (TLOG_DAEMON | TLOG_KERBEROS, LOG_ERR, "Your kerberos_client_credcache does not support multilpe identities");
1840                 retval = GNUTLS_E_UNWANTED_ALGORITHM;
1841 #endif
1842         }
1843         if (krbctx_srv == NULL) {
1844                 tlog (TLOG_DAEMON | TLOG_KERBEROS, LOG_WARNING, "No kerberos_server_credcache configured, so user-to-user Kerberos will not work");
1845 #if 0  /* Temporary bypass of cctype checks */
1846         } else if (!krb5_cc_support_switch (
1847                         krbctx_srv, cctype_srv)) {
1848                 tlog (TLOG_DAEMON | TLOG_KERBEROS, LOG_ERR, "Your kerberos_server_credcache does not support multilpe identities");
1849                 retval = GNUTLS_E_UNWANTED_ALGORITHM;
1850 #endif
1851         }
1852         if (retval != GNUTLS_E_SUCCESS) {
1853                 cleanup_starttls_kerberos ();
1854         }
1855         return retval;
1856 }
1857 #endif
1858
1859
1860 /* Cleanup Kerberos resources.  This must be an idempotent function, because
1861  * it is called when Kerberos panics as well as when
1862  */
1863 #ifdef HAVE_TLS_KDH
1864 static void cleanup_starttls_kerberos (void) {
1865         if (krb_kt_srv != NULL) {
1866                 krb5_kt_close (krbctx_srv, krb_kt_srv);
1867                 krb_kt_srv = NULL;
1868         }
1869         if (krb_kt_cli != NULL) {
1870                 krb5_kt_close (krbctx_cli, krb_kt_cli);
1871                 krb_kt_cli = NULL;
1872         }
1873         if (krbctx_srv != NULL) {
1874                 krb5_free_context (krbctx_srv);
1875                 krbctx_srv = NULL;
1876         }
1877         if (krbctx_cli != NULL) {
1878                 krb5_free_context (krbctx_cli);
1879                 krbctx_cli = NULL;
1880         }
1881 }
1882 #endif
1883
1884
1885 /* Prompter callback function for PKCS #11.
1886  *
1887  * TODO: Use "struct pkcs11iter" as data, possibly interact with the user,
1888  * and keep a score on where we stand with password entry and changes.
1889  * Create clisrv_p11krb_setup() and clisrv_p11krb_cleanup() functions.
1890  *
1891  * In the current release for Kerberos, we have a very minimal mode for
1892  * doing this.  We may embellish it later or, preferrably, turn to a more
1893  * PKCS #11 styled approach, perhaps PKINIT or FAST.
1894  */
1895 #ifdef HAVE_TLS_KDH
1896 static krb5_error_code clisrv_p11krb_callback (krb5_context ctx,
1897                                         void *vcmd,
1898                                         const char *name,
1899                                         const char *banner,
1900                                         int num_prompts,
1901                                         krb5_prompt prompts []) {
1902         struct command *cmd = (struct command *) vcmd;
1903         int i;
1904         krb5_prompt_type *codes = krb5_get_prompt_types (ctx);
1905         int attempt = 0;
1906         static const char *token_url = "pkcs11:manufacturer=Kerberos+infrastructure;model=TLS+Pool;serial=%28none%29";
1907         static const char *token_label = "Kerberos infrastructure";
1908         for (i=0; i<num_prompts; i++) {
1909                 //
1910                 // Visit each prompt in turn, setting responses or return failure
1911                 switch (codes [i]) {
1912                 case KRB5_PROMPT_TYPE_PASSWORD:
1913                         //TODO// Read a password from PKCS #11
1914                         //TODO// Do we need to cycle passwords to cover retry?
1915                         //TODO// Delete any failed passwords?
1916                         //TODO:FIXED//
1917                         if (attempt >= MAX_P11ITER_ATTEMPTS) {
1918                                 return KRB5_LIBOS_CANTREADPWD;
1919                         }
1920                         // Nothing in PKCS #11 --> so fallback on manual entry
1921                         if (!pin_callback (attempt,
1922                                         token_url, "Enter Kerberos password:",
1923                                         prompts [i].reply->data,
1924                                         prompts [i].reply->length)) {
1925                                 memset (prompts [i].reply->data, 0, prompts [i].reply->length);
1926                                 return KRB5_LIBOS_CANTREADPWD;
1927                         }
1928                         //TODO// Manage data structure
1929                         prompts [i].reply->length = strlen (prompts [i].reply->data);
1930                         return 0;
1931                 case KRB5_PROMPT_TYPE_NEW_PASSWORD:
1932                 case KRB5_PROMPT_TYPE_NEW_PASSWORD_AGAIN:
1933                         //TODO// Setup new password in PKCS #11
1934                 case KRB5_PROMPT_TYPE_PREAUTH:
1935                         //TODO// Use FAST, PKINIT, and so on...
1936                 default:
1937                         // Unrecognised and unimplemented prompt types end here
1938                         return KRB5_LIBOS_CANTREADPWD;
1939                 }
1940         }
1941         return 0;
1942 }
1943 #endif
1944
1945
1946 /* Find a Kerberos keyblock and ticket to use for the localid.  Do not look
1947  * into services yet in this function.  This function implements a simple
1948  * procedure, based on optional arguments p11uri, keytab, credcache.  It
1949  * produces <key,tgt> or <key,NULL> or (for errors) <NULL,NULL>.
1950  *
1951  * The procedure followed, fully written out, is outlined below:
1952  *
1953  *      IF      have(credcache) AND acceptable (renewable) time
1954  *      THEN    RETURN <key,tgt>
1955  *      ELSE    IF have (keytab) AND found a suitable key
1956  *              THEN    IF have(credcache) and it works
1957  *                      THEN    fetch cred tgt and key (auth with key in keytab)
1958  *                              create credcache
1959  *                              RETURN <key,tgt>
1960  *                      ELSE    RETURN <key,NULL>
1961  *              ELSE    IF have(p11uri) AND it works
1962  *                      THEN    fetch cred tgt and key (auth with pwd in p11uri)
1963  *                              create credcache
1964  *                              RETURN <key,tgt>
1965  *                      ELSE    RETURN <NULL,NULL>
1966  *
1967  * The function returns a status value counting the number of values returned,
1968  * so 0 means error, 1 means key only and 2 means key and tgt.
1969  */
1970 #ifdef HAVE_TLS_KDH
1971 static int have_key_tgt_cc (struct command *cmd,             // in, session context
1972                                 krb5_context ctx,    // in, kerberos context
1973                                 bool use_cc,         // in, whether to use cc
1974                                 krb5_kvno kvno,      // in, kvno (0 for highest)
1975                                 krb5_enctype enctype,// in, enctype (0 for any)
1976                                 char *p11uri,        // in/opt, PKCS #11 pwd URI
1977                                 krb5_keytab kt,      // in/opt, keytab
1978                                 krb5_keyblock *key,  // opt/opt session key
1979                                 krb5_creds **tgt,    // out/opt, tkt granting tkt
1980                                 krb5_ccache *cc) {   // out/opt, cred cache
1981         int k5err = 0;
1982         krb5_ccache newcc = NULL;
1983         krb5_principal sought  = NULL;
1984         krb5_principal sought1 = NULL;
1985         krb5_principal tgtname = NULL;
1986         krb5_keytab_entry ktentry;
1987         const char *svc = cmd->cmd.pio_data.pioc_starttls.service;
1988         const char *lid = cmd->cmd.pio_data.pioc_starttls.localid;
1989         const char *liddom;
1990         int lid1len;
1991         char **realms;
1992         char realm [128];
1993         uint32_t nametype, nametype_alt;
1994         time_t now = 0;
1995         //
1996         // Assertions, and initialise variables
1997         assert ( cmd != NULL);
1998         assert ( ctx != NULL);
1999         assert ( key != NULL);
2000         assert (*tgt == NULL);
2001         krb5_free_keyblock_contents (ctx, key);
2002         if (cc != NULL) {
2003                 *cc = NULL;
2004         }
2005         //
2006         // Construct the realm name
2007         liddom = strrchr (lid, '@');
2008         if (liddom != NULL) {
2009                 lid1len = ((intptr_t) liddom) - ((intptr_t) lid);
2010                 liddom++;  // Skip '@'
2011         } else {
2012                 liddom = lid;  // localid is a host
2013                 lid1len = strnlen (lid, 128);
2014         }
2015         k5err = krb5_get_host_realm (ctx, liddom, &realms);
2016         if ((k5err == 0) && (realms [0] != NULL) && (*realms [0] != '\0')) {
2017                 strncpy (realm, realms [0], sizeof (realm));
2018                 realm [sizeof (realm)-1] = '\0';
2019         } else {
2020                 int i = 0;
2021                 do {
2022                         realm [i] = toupper (liddom [i]);
2023                         i++;
2024                 } while (liddom [i-1] != '\0');
2025         }
2026         if (k5err == 0) {
2027                 krb5_free_host_realm (ctx, realms);
2028         } else {
2029                 k5err = 0;
2030         }
2031         //
2032         // Construct a sought principal name in a given naming style,
2033         // and try to locate it in the existing cache.
2034         // With @, try liduser@liddom@REALM or else liduser@REALM
2035         // Without @, try svc/liddom@REALM
2036         nametype = (lid == liddom) ? KRB5_NT_SRV_HST : KRB5_NT_ENTERPRISE_PRINCIPAL;
2037 retry:
2038         nametype_alt = nametype;
2039         switch (nametype) {
2040         case KRB5_NT_ENTERPRISE_PRINCIPAL:
2041                 nametype_alt = KRB5_NT_PRINCIPAL;
2042                 k5err = krb5_build_principal_ext (ctx, &sought,
2043                                         strlen (realm), realm,
2044                                         strnlen (lid, 128), lid,
2045                                         0);
2046                 break;
2047         case KRB5_NT_SRV_HST:
2048                 if (strcmp (svc, "http") == 0) {
2049                         svc = "HTTP";
2050                 }
2051                 k5err = krb5_build_principal_ext (ctx, &sought,
2052                                         strlen (realm), realm,
2053                                         strlen (svc), svc,
2054                                         lid1len, lid,
2055                                         0);
2056                 break;
2057         case KRB5_NT_PRINCIPAL:
2058                 k5err = krb5_build_principal_ext (ctx, &sought,
2059                                         strlen (realm), realm,
2060                                         lid1len, lid,
2061                                         0);
2062                 break;
2063         }
2064         if (k5err == 0) {
2065                 sought->type = nametype;
2066         } else {
2067                 sought = NULL;
2068         }
2069         k5err = krb5_cc_cache_match (ctx, sought, &newcc);
2070         if (k5err != 0) {
2071                 if ((nametype_alt != nametype) && (sought1 == NULL)) {
2072                         nametype = nametype_alt;
2073                         sought1  = sought;
2074                         sought   = NULL;
2075                         goto retry;
2076                 }
2077                 //
2078                 // We failed to find an *existing* credentials cache
2079                 // for the local identity.
2080                 //
2081                 // Our new hope is to create a fresh credential, and add
2082                 // it to the current credcache.  To that end, we now try
2083                 // to overrule k5err by getting hold of our default cc.
2084                 goto from_scratch;
2085         }
2086         //
2087         // Construct the TGT name
2088         k5err = krb5_build_principal_ext (ctx, &tgtname,
2089                                 strlen (realm), realm,
2090                                 6, "krbtgt",
2091                                 strlen (realm), realm,
2092                                 0);
2093         if (k5err != 0) {
2094                 tgtname = NULL;
2095                 k5err = 0;
2096         }
2097         tgtname->type = KRB5_NT_SRV_INST;
2098         //
2099         // Try to get the service ticket for the TGT name from the cache
2100         krb5_creds credreq;
2101         memset (&credreq, 0, sizeof (credreq));
2102         credreq.client = sought;
2103         credreq.server = tgtname;
2104         k5err = krb5_get_credentials (ctx,
2105                                 /* KRB5_GC_USER_USER ?|? */
2106                                         ( use_cc ? 0 : KRB5_GC_CACHED ),
2107                                 newcc,
2108                                 &credreq, tgt);
2109         time (&now);
2110         if ((k5err == 0)
2111                                 && (now + 300 > (*tgt)->times.endtime)
2112                                 && (now + 300 < (*tgt)->times.renew_till)) {
2113                 //TODO:NOTHERE// krb5_free_creds (ctx, *tgt);
2114                 //TODO:NOTHERE// *tgt = NULL;
2115                 // Try to renew the ticket
2116                 k5err = krb5_get_renewed_creds (ctx,
2117                                 *tgt,
2118                                 sought,
2119                                 newcc,
2120                                 NULL);   /* krbtgt/REALM@REALM */
2121         }
2122         if ((k5err == 0)
2123                                 && (now + 300 > (*tgt)->times.endtime)) {
2124                 // Thanks, but no thanks!
2125                 krb5_free_creds (ctx, *tgt);
2126                 *tgt = NULL;
2127                 k5err = 666;
2128         }
2129         if (k5err == 0) {
2130                 // First case worked -- return <key,tgt> from credout
2131                 k5err = krb5_copy_keyblock_contents (ctx,
2132                                 &(*tgt)->keyblock,
2133                                 key);
2134                 // On failure, key shows failure
2135                 if (cc != NULL) {
2136                         *cc = newcc;
2137                         newcc = NULL;
2138                 }
2139                 goto cleanup;
2140         }
2141 from_scratch:
2142         //
2143         // Prior attempts failed.  Instead, look for keytab or p11uri presence.
2144         // This is skipped when the use_cc option below welcomes krb5_creds.
2145         if ((key->contents == NULL) && (p11uri == NULL) && (kt == NULL)) {
2146                 // We cannot obtain a new krbtgt
2147                 // We simply return what we've got (which may be nothing)
2148                 goto cleanup;
2149         }
2150         if ((kt == NULL) && (!use_cc)) {
2151                 // We have nowhere to store a new krbtgt if we got it
2152                 // We simply return what we've got (which is at least a key)
2153                 goto cleanup;
2154         }
2155         //
2156         // Either we have a keytab key, or we have a p11uri,
2157         // so we can attempt to create a new credcache with a new krbtgt
2158         if (use_cc) {
2159                 if (newcc == NULL) {
2160                         k5err = krb5_cc_default (ctx, &newcc);
2161                         if (k5err != 0) {
2162                                 // Utter failure to do even the simplest thing
2163                                 goto cleanup;
2164                         }
2165                 }
2166                 *tgt = malloc (sizeof (**tgt));
2167                 if (*tgt == NULL) {
2168                         // Memory error
2169                         goto cleanup;
2170                 }
2171                 memset (*tgt, 0, sizeof (**tgt));
2172                 if ((sought != NULL) && (sought1 == NULL)) {
2173                         // We only tried one name
2174                         sought1 = sought;
2175                         sought = NULL;
2176                 }
2177                 do {
2178                         if (sought1 == NULL) {
2179                                 break;
2180                         }
2181                         if (p11uri == NULL) {
2182                                 k5err = krb5_get_init_creds_keytab (
2183                                                 ctx,
2184                                                 *tgt,
2185                                                 sought1,
2186                                                 kt,
2187                                                 0,    /* start now please */
2188                                                 NULL, /* get a TGT please */
2189                                                 NULL);  //TODO// opts needed?
2190                         } else {
2191                                 //TODO// Prepare PKCS #11 access
2192                                 k5err = krb5_get_init_creds_password (
2193                                                 ctx,
2194                                                 *tgt,
2195                                                 sought1,
2196 #ifdef TOM_IS_WEG
2197                                                 NULL,   // Use callbacks for password
2198                                                 clisrv_p11krb_callback,
2199 #else
2200                                                 "1234",
2201                                                 NULL,
2202 #endif
2203                                                 cmd,  /* callback data pointer */
2204                                                 0,    /* start now please */
2205                                                 NULL, /* get a TGT please */
2206                                                 NULL);  //TODO// opts needed?
2207                                 //TODO// End PKCS #11 access
2208                         }
2209                         krb5_free_principal (ctx, sought1);
2210                         sought1 = sought;
2211                         sought = NULL;
2212                 } while (k5err != 0);
2213                 if (k5err != 0) {
2214                         // Failed to initiate new credentials
2215                         krb5_free_creds (ctx, *tgt);
2216                         *tgt = NULL;
2217                         goto cleanup;
2218                 }
2219                 // Try to store the credential, if it was found
2220                 if (sought1 != NULL) {
2221                         k5err = krb5_cc_initialize (ctx, newcc, sought1);
2222                         if (k5err == 0) {
2223                                 k5err = krb5_cc_store_cred (ctx, newcc, *tgt);
2224                         }
2225                 }
2226                 // Copy the keyblock; any failure will show up in key
2227                 krb5_copy_keyblock_contents (ctx,
2228                         &(*tgt)->keyblock, //TODO:UNINIT// &ktentry.key,
2229                         key);
2230                 //
2231                 // We succeeded in setting up a new Ticket Granting Ticket!
2232                 if (cc != NULL) {
2233                         *cc = newcc;
2234                         newcc = NULL;
2235                 }
2236                 goto cleanup;
2237         }
2238         //
2239         // As a last resort, dig up a key directly from the keytab;
2240         // this is the only place where kvno and enctype are used
2241         if (kt != NULL) {
2242                 //NOTE// Might be more direct as krb5_kt_read_service_key()
2243                 k5err = krb5_kt_get_entry (
2244                                         ctx, kt,
2245                                         sought,
2246                                         kvno, enctype,
2247                                         &ktentry);
2248                 if (k5err == 0) {
2249                         k5err = krb5_copy_keyblock_contents (ctx,
2250                                 &ktentry.key,
2251                                 key);
2252                         krb5_free_keytab_entry_contents (ctx, &ktentry);
2253                         // On failure, key shows failure.
2254                         if (cc != NULL) {
2255                                 *cc = newcc;
2256                                 newcc = NULL;
2257                         }
2258                         goto cleanup;
2259                 }
2260         }
2261         //
2262         // Nothing more to try, so we continue into cleanup
2263 cleanup:
2264         //
2265         // Cleanup and return the <key,tgt> values as they were delivered
2266         if (sought1 != NULL) {
2267                 krb5_free_principal (ctx, sought1);
2268                 sought1 = NULL;
2269         }
2270         if (sought != NULL) {
2271                 krb5_free_principal (ctx, sought);
2272                 sought = NULL;
2273         }
2274         if (tgtname != NULL) {
2275                 krb5_free_principal (ctx, tgtname);
2276                 tgtname = NULL;
2277         }
2278         if (newcc != NULL) {
2279                 krb5_cc_close (ctx, newcc);
2280                 newcc = NULL;
2281         }
2282         if (key->contents == NULL) {
2283                 if (k5err != 0) {
2284                         const char *errmsg = krb5_get_error_message (ctx, k5err);
2285                         tlog (TLOG_DAEMON, LOG_ERR, "Kerberos error in have_key_tgt_cc: %s", errmsg);
2286                         krb5_free_error_message (ctx, errmsg);
2287                 }
2288                 if (*tgt != NULL) {
2289                         krb5_free_creds (ctx, *tgt);
2290                         *tgt = NULL;
2291                 }
2292                 if ((cc != NULL) && (*cc != NULL)) {
2293                         krb5_cc_close (ctx, *cc);
2294                         *cc = NULL;
2295                 }
2296                 return 0;
2297         } else if (tgt == NULL) {
2298                 if ((cc != NULL) && (*cc != NULL)) {
2299                         krb5_cc_close (ctx, *cc);
2300                         *cc = NULL;
2301                 }
2302                 return 1;
2303         } else if ((cc == NULL) || (*cc == NULL)) {
2304                 return 2;
2305         } else {
2306                 return 3;
2307         }
2308 }
2309 #endif
2310
2311
2312 /* Have a ticket for the remote service.  Do this as a client.  The client
2313  * principal and realm are provided, and the ticket to be returned will
2314  * also provide the accompanying key.
2315  *
2316  * This function will incorporate the peer TGT, when it is provided.  This
2317  * is the case in KDH-Only exchanges with a non-empty Server Certificate.
2318  *
2319  * TODO: We are not currently serving backend tickets, but these could be
2320  * passed in as authorization data along with the credential request.
2321  * Note however, that authorization data is copied by default from the TGT,
2322  * but not necessarily from the request.  Not without KDC modifications.
2323  * But then again, the KDC should have responded with an error that it was
2324  * missing backend services; this is not something the client should decide
2325  * on, and certainly not after being requested by the service.  The error
2326  * and recovery could be implemented here (if we can get the error info out
2327  * of the libkrb5 API).  Alternatively, we might consider passing the
2328  * authorization data in the authenticator since we get to control it.
2329  * What will the specification say?
2330  *
2331  * The return value indicates how many of the requested output values have
2332  * been provided, counting from the first.  So, 0 means a total failure and
2333  * anything higher is a (partial) success.
2334  */
2335 #ifdef HAVE_TLS_KDH
2336 static int have_service_ticket (
2337                                 struct command *cmd,  // in, session context
2338                                 krb5_context ctx,     // in, kerberos context
2339                                 krb5_ccache cc_opt,   // in/opt, credcache
2340                                 krb5_principal cli,   // in, client principal
2341                                 krb5_creds **ticket) {// out, tkt granting tkt
2342         int k5err = 0;
2343         krb5_ccache cc = cc_opt;
2344         krb5_flags u2u = 0;
2345         krb5_principal srv = NULL;
2346         krb5_data tkt_srv;
2347         krb5_creds credreq;
2348         //
2349         // Sanity checks and initialisation
2350         memset (&tkt_srv, 0, sizeof (tkt_srv));
2351         memset (&credreq, 0, sizeof (credreq));
2352         *ticket = NULL;
2353         //
2354         // Determine the optional cc parameter if it was not provided
2355         //TODO// This can go if we always get it passed from have_key_tgt_cc()
2356         if (cc == NULL) {
2357                 k5err = krb5_cc_cache_match (ctx, cli, &cc);
2358                 if (k5err != 0) {
2359                         goto cleanup;
2360                 }
2361         }
2362         //
2363         // Build the server's principal name
2364         const char *svc = cmd->cmd.pio_data.pioc_starttls.service;
2365         const char *rid = cmd->cmd.pio_data.pioc_starttls.remoteid;
2366         const char *riddom;
2367         char **realms;
2368         char realm [128];
2369         riddom = strrchr (rid, '@');
2370         if (riddom != NULL) {
2371                 riddom++;  // Skip '@'
2372         } else {
2373                 riddom = rid;  // localid is a host
2374         }
2375         k5err = krb5_get_host_realm (ctx, riddom, &realms);
2376         if ((k5err == 0) && (realms [0] != NULL) && (*realms [0] != '\0')) {
2377                 strncpy (realm, realms [0], sizeof (realm));
2378                 realm [sizeof (realm)-1] = '\0';
2379         } else {
2380                 int i = 0;
2381                 do {
2382                         realm [i] = toupper (riddom [i]);
2383                         i++;
2384                 } while (riddom [i-1] != '\0');
2385         }
2386         if (k5err == 0) {
2387                 krb5_free_host_realm (ctx, realms);
2388         } else {
2389                 k5err = 0;
2390         }
2391         if (strcmp (svc, "http") == 0) {
2392                 svc = "HTTP";
2393         }
2394         k5err = krb5_build_principal_ext (ctx, &srv,
2395                                 strlen (realm), realm,
2396                                 strlen (svc), svc,
2397                                 strlen (rid), rid,
2398                                 0);
2399         if (k5err != 0) {
2400                 goto cleanup;
2401         }
2402         srv->type = KRB5_NT_SRV_HST;
2403         //
2404         // Construct credential request
2405         credreq.client = cli;
2406         credreq.server = srv;
2407         //TODO// credreq.authdata may be used for backend service tickets
2408         //
2409         // See if our peer provided us with a TGT
2410         //  - we are sure of GNUTLS_CRD_CERTIFICATE because we implement it now
2411         //  - we must ensure that this is KDH-Only (remote GNUTLS_CRT_KRB)
2412         //  - we must ensure that the remote provided a non-empty ticket
2413         if (gnutls_certificate_type_get_peers (cmd->session) == GNUTLS_CRT_KRB) {
2414                 // This is KDH-Only -- and the server may present a TGT
2415                 const gnutls_datum_t *opt_srv_tkt;
2416                 unsigned int srv_tkt_count;
2417                 opt_srv_tkt = gnutls_certificate_get_peers (cmd->session, &srv_tkt_count);
2418                 if ((opt_srv_tkt != NULL) && (srv_tkt_count >= 1) && (opt_srv_tkt [0].size > 5)) {
2419                         // Looks good, we'll use only the first (normally only) one
2420                         credreq.second_ticket.data   = opt_srv_tkt [0].data;
2421                         credreq.second_ticket.length = opt_srv_tkt [0].size;
2422                         u2u = KRB5_GC_USER_USER;
2423                 }
2424         }
2425         //
2426         // Fetch the ticket for the service
2427         k5err = krb5_get_credentials (ctx, u2u, cc, &credreq, ticket);
2428         //
2429         // Cleanup and return; the return value depends on k5err
2430 cleanup:
2431         if ((cc != NULL) && (cc_opt == NULL)) {
2432                 //TODO// This can go if we always get it passed from have_key_tgt_cc()
2433                 krb5_cc_close (ctx, cc);
2434                 cc = NULL;
2435         }
2436         if (srv != NULL) {
2437                 krb5_free_principal (ctx, srv);
2438         }
2439         return (k5err == 0) ? 1 : 0;
2440 }
2441 #endif
2442
2443
2444 /* DER utility: This should probably appear in Quick DER sometime soon.
2445  *
2446  * Pack an Int32 or UInt32 and return the number of bytes.  Do not pack a header
2447  * around it.  The function returns the number of bytes taken, even 0 is valid.
2448  */
2449 typedef uint8_t QDERBUF_INT32_T [4];
2450 dercursor qder2b_pack_int32 (uint8_t *target_4b, int32_t value) {
2451         dercursor retval;
2452         int shift = 24;
2453         retval.derptr = target_4b;
2454         retval.derlen = 0;
2455         while (shift >= 0) {
2456                 if ((retval.derlen == 0) && (shift > 0)) {
2457                         // Skip sign-extending initial bytes
2458                         uint32_t neutro = (value >> (shift - 1) ) & 0x000001ff;
2459                         if ((neutro == 0x000001ff) || (neutro == 0x00000000)) {
2460                                 shift -= 8;
2461                                 continue;
2462                         }
2463                 }
2464                 target_4b [retval.derlen] = (value >> shift) & 0xff;
2465                 retval.derlen++;
2466                 shift -= 8;
2467         }
2468         return retval;
2469 }
2470 typedef uint8_t QDERBUF_UINT32_T [5];
2471 dercursor qder2b_pack_uint32 (uint8_t *target_5b, uint32_t value) {
2472         dercursor retval;
2473         int ofs = 0;
2474         if (value & 0x80000000) {
2475                 *target_5b = 0x00;
2476                 ofs = 1;
2477         }
2478         retval = qder2b_pack_int32 (target_5b + ofs, (int32_t) value);
2479         retval.derptr -= ofs;
2480         retval.derlen += ofs;
2481         return retval;
2482 }
2483
2484
2485 /* DER utility: This should probably appear in Quick DER sometime soon.
2486  *
2487  * Unpack an Int32 or UInt32 from a given number of bytes.  Do not assume a header
2488  * around it.  The function returns the value found.
2489  *
2490  * Out of range values are returned as 0.  This value only indicates invalid
2491  * return when len > 1, so check for that.
2492  */
2493 int32_t qder2b_unpack_int32 (dercursor data4) {
2494         int32_t retval = 0;
2495         int idx;
2496         if (data4.derlen > 4) {
2497                 goto done;
2498         }
2499         if ((data4.derlen > 0) && (0x80 & *data4.derptr)) {
2500                 retval = -1;
2501         }
2502         for (idx=0; idx<data4.derlen; idx++) {
2503                 retval <<= 8;
2504                 retval += data4.derptr [idx];
2505         }
2506 done:
2507         return retval;
2508 }
2509 uint32_t qder2b_unpack_uint32 (dercursor data5) {
2510         uint32_t retval = 0;
2511         int ofs = 0;
2512         if (data5.derlen > 5) {
2513                 goto done;
2514         }
2515         if (data5.derlen == 5) {
2516                 if (*data5.derptr != 0x00) {
2517                         goto done;
2518                 }
2519                 // Modify the local copy on our stack
2520                 data5.derlen--;
2521                 data5.derptr++;
2522         }
2523         retval = (uint32_t) qder2b_unpack_int32 (data5);
2524 done:
2525         return retval;
2526 }
2527
2528
2529 #ifdef HAVE_TLS_KDH
2530 /* TODO: Debugging function for printing (descr,ptr,len) ranges */
2531 static inline void prange (char *descr, uint8_t *ptr, int len) {
2532         fprintf (stderr, "%s #%04d: %02x %02x %02x %02x %02x %02x %02x %02x...%02x %02x %02x %02x\n",
2533                         descr, len,
2534                         ptr [0], ptr [1], ptr [2], ptr [3],
2535                         ptr [4], ptr [5], ptr [6], ptr [7],
2536                         ptr [len-4], ptr [len-3], ptr [len-2], ptr [len-1]);
2537 }
2538 static inline void prangefull (char *descr, uint8_t *ptr, int len) {
2539         fprintf (stderr, "%s #%04d:", descr, len);
2540         while (len-- > 0) {
2541                 fprintf (stderr, " %02x", *ptr++);
2542         }
2543         fprintf (stderr, "\n");
2544 }
2545 #endif
2546
2547
2548 /* The callback function that retrieves a TLS-KDH "signature", which is kept
2549  * outside of GnuTLS.  The callback computes an authenticator encrypted to
2550  * the session's Kerberos key.
2551  */
2552 #ifdef HAVE_TLS_KDH
2553 static gtls_error cli_kdhsig_encode (gnutls_session_t session,
2554                         gnutls_datum_t *enc_authenticator,
2555                         gnutls_datum_t *dec_authenticator,
2556                         const gnutls_datum_t *hash,
2557                         int32_t checksum_type) {
2558         //
2559         // Variables, sanity checking, initialisation
2560         struct command *cmd;
2561         int k5err = 0;
2562         authenticator_t auth;
2563         QDERBUF_INT32_T derv5;
2564         QDERBUF_INT32_T dernametype;
2565         QDERBUF_INT32_T dercksumtype;
2566         krb5_keyblock subkey;
2567         gnutls_certificate_type_t peercert;
2568         QDERBUF_INT32_T dersubkey;
2569         krb5_timestamp now_s;
2570         char derctime [100];
2571         krb5_int32 now_us;
2572         QDERBUF_INT32_T dercusec;
2573         cmd = * (struct command **) gnutls_session_get_ptr (session);
2574         tlog (LOG_DAEMON, LOG_DEBUG, "cli_kdhsig_encode() retrieved session pointer %p\n", cmd);
2575         memset (&auth, 0, sizeof (auth));
2576         memset (&subkey, 0, sizeof (subkey));
2577         assert (cmd->krbid_cli != NULL);
2578         assert (cmd->krb_key.contents != NULL);
2579         static const uint8_t auth_packer [] = {
2580                         DER_PACK_rfc4120_Authenticator, DER_PACK_END };
2581         static const uint8_t encdata_packer [] = {
2582                         DER_PACK_rfc4120_EncryptedData, DER_PACK_END };
2583         //
2584         // Setup secure hash in authenticator (never optional for TLS-KDH)
2585         auth.cksum.cksumtype = qder2b_pack_int32 (dercksumtype, checksum_type);
2586         auth.cksum.checksum.derptr = hash->data;
2587         auth.cksum.checksum.derlen = hash->size;
2588         //
2589         // Optionally include a subkey (namely, for KDH-Only)
2590         peercert = gnutls_certificate_type_get_peers (session);
2591         if (peercert == GNUTLS_CRT_KRB) {
2592                 // This is KDH-Only, for which we MUST create a random subkey
2593                 k5err = krb5_c_make_random_key (
2594                                 krbctx_cli,
2595                                 ENCTYPE_AES256_CTS_HMAC_SHA1_96,
2596                                 &subkey);
2597                 if (k5err != 0) {
2598                         return GNUTLS_E_ENCRYPTION_FAILED;
2599                 }
2600                 auth.subkey.keytype = qder2b_pack_int32 (dersubkey, subkey.enctype);
2601                 auth.subkey.keyvalue.derptr = subkey.contents;
2602                 auth.subkey.keyvalue.derlen = subkey.length;
2603 prange ("cli_K", subkey.contents, subkey.length);
2604         }
2605         //
2606         // Setup the client realm and principal name
2607         auth.crealm.derptr = cmd->krbid_cli->realm.data;
2608         auth.crealm.derlen = cmd->krbid_cli->realm.length;
2609         auth.cname.name_type = qder2b_pack_int32 (dernametype, cmd->krbid_cli->type);
2610         // The SEQUENCE OF with just one component is trivial to prepack
2611         auth.cname.name_string.derptr = cmd->krbid_cli->data [0].data;
2612         auth.cname.name_string.derlen = cmd->krbid_cli->data [0].length;
2613         //
2614         // Setup the Kerberos version number (5)
2615         auth.authenticator_vno = qder2b_pack_int32 (derv5, 5);
2616         //
2617         // Setup the obliged microsecond timer values (ignore error returns)
2618         krb5_us_timeofday (krbctx_cli, &now_s, &now_us);
2619         krb5_timestamp_to_string (now_s, derctime, sizeof (derctime));
2620         derctime [sizeof (derctime)-1] = '\0';
2621         auth.ctime.derptr = derctime;
2622         auth.ctime.derlen = strlen (derctime);
2623         auth.cusec = qder2b_pack_int32 (dercusec, now_us);
2624         //
2625         // Pack the decoded result into dec_authenticator
2626         size_t declen = der_pack (      auth_packer,
2627                                         (const dercursor *) &auth,
2628                                         NULL    // Measure length, no output yet
2629                                         );
2630         uint8_t *decptr = gnutls_malloc (declen);
2631         if (decptr == NULL) {
2632                 return GNUTLS_E_MEMORY_ERROR;
2633         }
2634         der_pack (                      auth_packer,
2635                                         (const dercursor *) &auth,
2636                                         decptr + declen);
2637         krb5_free_keyblock_contents (krbctx_cli, &subkey);
2638 prangefull ("cli_A", decptr, declen);
2639         size_t rawlen;
2640         if (0 != krb5_c_encrypt_length (krbctx_cli,
2641                                         cmd->krb_key.enctype,
2642                                         declen,
2643                                         &rawlen)) {
2644                 gnutls_free (decptr);
2645                 return GNUTLS_E_ENCRYPTION_FAILED;
2646         }
2647         uint8_t *rawptr = gnutls_malloc (rawlen);
2648         if (rawptr == NULL) {
2649                 gnutls_free (decptr);
2650                 return GNUTLS_E_MEMORY_ERROR;
2651         }
2652         krb5_data decdata;
2653         krb5_enc_data rawdata;
2654         memset (&decdata, 0, sizeof (decdata));
2655         memset (&rawdata, 0, sizeof (rawdata));
2656         decdata.data   = decptr;
2657         decdata.length = declen;
2658         rawdata.ciphertext.data   = rawptr;
2659         rawdata.ciphertext.length = rawlen;
2660         if (0 != krb5_c_encrypt (       krbctx_cli,
2661                                         &cmd->krb_key,
2662                                         11 /* stealing key usage from AP-REQ */,
2663                                         NULL,
2664                                         &decdata,
2665                                         &rawdata)) {
2666                 gnutls_free (rawptr);
2667                 gnutls_free (decptr);
2668                 return GNUTLS_E_ENCRYPTION_FAILED;
2669         }
2670         //
2671         // Prepare the header information
2672         QDERBUF_INT32_T deretype;
2673         QDERBUF_UINT32_T derkvno;
2674         encrypted_data_t encdata;
2675         memset (&encdata, 0, sizeof (encdata));
2676         encdata.etype = qder2b_pack_int32 (deretype, cmd->krb_key.enctype);
2677         //NOT// encdata.kvno  = qder2b_pack_int32 (derkvno,  cmd->krb_key.kvno);
2678         encdata.cipher.derptr = rawdata.ciphertext.data;
2679         encdata.cipher.derlen = rawdata.ciphertext.length;
2680         //
2681         // Prepare for packing the header and rawdata as EncryptedData
2682         size_t enclen = der_pack (      encdata_packer,
2683                                         (const dercursor *) &encdata,
2684                                         NULL    // Measure length, no output yet
2685                                         );
2686         uint8_t *encptr = gnutls_malloc (enclen);
2687         if (encptr == NULL) {
2688                 gnutls_free (rawptr);
2689                 gnutls_free (decptr);
2690                 return GNUTLS_E_MEMORY_ERROR;
2691         }
2692         der_pack (                      encdata_packer,
2693                                         (const dercursor *) &encdata,
2694                                         encptr + enclen);
2695         gnutls_free (rawptr);
2696         //
2697         // Return our final verdict on the generation of the Authenticator
2698         dec_authenticator->data = decptr;
2699         dec_authenticator->size = declen;
2700         enc_authenticator->data = encptr;
2701         enc_authenticator->size = enclen;
2702 prange ("cli_D", decptr, declen);
2703 prange ("cli_E", encptr, enclen);
2704         return 0;
2705 }
2706 #endif
2707
2708
2709 /* The callback function that verifies a TLS-KDH "signature", which is kept
2710  * outside of GnuTLS.  The callback verifies the authenticator against the
2711  * provided session hash and returns the decrypted authenticator.
2712  */
2713 #ifdef HAVE_TLS_KDH
2714 static int srv_kdhsig_decode (gnutls_session_t session,
2715                         const gnutls_datum_t *enc_authenticator,
2716                         gnutls_datum_t *dec_authenticator,
2717                         gnutls_datum_t *hash,
2718                         int32_t *checksum_type) {
2719         //
2720         // Variables, sanity checks and initialisation
2721         int k5err = 0;
2722         struct command *cmd;
2723         static const uint8_t encdata_packer [] = {
2724                 DER_PACK_rfc4120_EncryptedData, DER_PACK_END };
2725         static const uint8_t auth_packer [] = {
2726                 DER_PACK_rfc4120_Authenticator, DER_PACK_END };
2727         encrypted_data_t encdata;
2728         cmd = * (struct command **) gnutls_session_get_ptr (session);
2729         tlog (LOG_DAEMON, LOG_DEBUG, "srv_kdhsig_decode() retrieved session pointer %p\n", cmd);
2730 prange ("srv_E", enc_authenticator->data, enc_authenticator->size);
2731         //
2732         // Retrieve the session key and store it in cmd->krb_key.
2733         //
2734         // Prior setting of cmd->krb_key would be due to user-to-user mode
2735         // having been setup with this as the server-supplied TGT key, in
2736         // which case cmd->krb_key would need to be overwritten by the
2737         // session key.
2738         //
2739         // When no prior cmd->krb_key is available, use the keytab to
2740         // decode the client's ticket.
2741         assert (gnutls_certificate_type_get_peers (session) == GNUTLS_CRT_KRB);
2742         const gnutls_datum_t *certs;
2743         unsigned int num_certs;
2744         certs = gnutls_certificate_get_peers (cmd->session, &num_certs);
2745         if (num_certs != 1) {
2746                 return GNUTLS_E_NO_CERTIFICATE_FOUND;
2747         }
2748         krb5_data krbcert;
2749         krb5_ticket *tkt;
2750         krbcert.data   = certs [0].data;
2751         krbcert.length = certs [0].size;
2752 prange ("srv_C", certs [0].data, certs [0].size);
2753         if (0 != krb5_decode_ticket (&krbcert, &tkt)) {
2754                 return GNUTLS_E_NO_CERTIFICATE_FOUND;
2755         }
2756         if (cmd->krb_key.contents != NULL) {
2757                 // user-to-user mode
2758                 k5err = krb5_decrypt_tkt_part (
2759                                         krbctx_srv,
2760                                         &cmd->krb_key,
2761                                         tkt);
2762                 krb5_free_keyblock_contents (
2763                                         krbctx_srv,
2764                                         &cmd->krb_key);
2765         } else {
2766                 // client-to-server mode
2767                 k5err = krb5_server_decrypt_ticket_keytab (
2768                                         krbctx_srv,
2769                                         krb_kt_srv,
2770                                         tkt);
2771         }
2772         if (k5err == 0) {
2773                 k5err = krb5_copy_keyblock_contents (
2774                                         krbctx_srv,
2775                                         tkt->enc_part2->session,
2776                                         &cmd->krb_key);
2777         }
2778         if (k5err == 0) {
2779                 k5err = krb5_copy_principal (
2780                                         krbctx_srv,
2781                                         tkt->enc_part2->client,
2782                                         &cmd->krbid_cli);
2783         }
2784         if (k5err == 0) {
2785                 if (cmd->krbid_srv != NULL) {
2786                         k5err = krb5_principal_compare (
2787                                                         krbctx_srv,
2788                                                         tkt->server,
2789                                                         cmd->krbid_srv);
2790                                 // Server name changed since u2u setup => k5err
2791                 } else {
2792                         k5err = krb5_copy_principal (
2793                                                         krbctx_srv,
2794                                                         tkt->server,
2795                                                         &cmd->krbid_srv);
2796                 }
2797         }
2798         krb5_free_ticket (krbctx_srv, tkt);
2799         if (k5err != 0) {
2800                 const char *errmsg = krb5_get_error_message (krbctx_srv, k5err);
2801                 tlog (TLOG_DAEMON, LOG_ERR, "Kerberos error in srv_kdhsig_decode: %s", errmsg);
2802                 krb5_free_error_message (krbctx_srv, errmsg);
2803                 return GNUTLS_E_NO_CERTIFICATE_FOUND;
2804         }
2805         //
2806         // Harvest the EncryptedData fields from the enc_authenticator
2807         dercursor enctransport;
2808         enctransport.derptr = enc_authenticator->data;
2809         enctransport.derlen = enc_authenticator->size;
2810 prangefull ("EncData2unpack", enctransport.derptr, enctransport.derlen);
2811         memset (&encdata, 0, sizeof (encdata));
2812         if (0 != der_unpack (           &enctransport,
2813                                         encdata_packer,
2814                                         (dercursor *) &encdata,
2815                                         1)) {
2816                 tlog (TLOG_DAEMON, LOG_ERR, "Failed to der_unpack(EncryptedData) in server: %s", strerror (errno));
2817                 return GNUTLS_E_DECRYPTION_FAILED;
2818         }
2819         if (encdata.kvno.derptr != NULL) {
2820                 //TODO//NOTYET//ANDWHY// return GNUTLS_E_DECRYPTION_FAILED;
2821         }
2822         int32_t etype = qder2b_unpack_int32 (encdata.etype);
2823         //
2824         // Decrypt the EncryptedData fields into the dec_authenticator
2825         krb5_enc_data rawdata;
2826         krb5_data decdata;
2827         memset (&rawdata, 0, sizeof (rawdata));
2828         memset (&decdata, 0, sizeof (decdata));
2829         rawdata.enctype = etype;
2830         rawdata.ciphertext.data   = encdata.cipher.derptr;
2831         rawdata.ciphertext.length = encdata.cipher.derlen;
2832 prange ("srv_R", encdata.cipher.derptr, encdata.cipher.derlen);
2833         decdata.data   = dec_authenticator->data;
2834         decdata.length = dec_authenticator->size;
2835         if (0 != krb5_c_decrypt (       krbctx_srv,
2836                                         &cmd->krb_key,
2837                                         11 /* stealing key usage from AP-REQ */,
2838                                         NULL,
2839                                         &rawdata,
2840                                         &decdata)) {
2841                 return GNUTLS_E_DECRYPTION_FAILED;
2842         }
2843         dec_authenticator->size = decdata.length;
2844 prange ("srv_D", decdata.data, decdata.length);
2845         //
2846         // Unpack the decrypted Authenticator
2847         dercursor decsyntax;
2848         decsyntax.derptr = decdata.data;
2849         decsyntax.derlen = decdata.length;
2850 prangefull ("srv_A", decdata.data, decdata.length);
2851         authenticator_t auth;
2852         memset (&auth, 0, sizeof (auth));
2853         if (0 != der_unpack (           &decsyntax,
2854                                         auth_packer,
2855                                         (dercursor *) &auth,
2856                                         1)) {
2857                 tlog (TLOG_DAEMON, LOG_ERR, "Failed to der_unpack(Authenticator) in server: %s", strerror (errno));
2858                 return GNUTLS_E_DECRYPTION_FAILED;
2859         }
2860         //
2861         // Validate the contents of the Authenticator
2862         if (qder2b_unpack_int32 (auth.authenticator_vno) != 5) {
2863                 return GNUTLS_E_DECRYPTION_FAILED;
2864         }
2865         if (auth.cksum.checksum.derptr == NULL) {
2866                 return GNUTLS_E_DECRYPTION_FAILED;
2867         }
2868         if (auth.cksum.checksum.derlen < 16) {
2869                 return GNUTLS_E_DECRYPTION_FAILED;
2870         }
2871         //TODO// Optionally, for KDH-Only, ensure presence and size of a subkey
2872         //
2873         // Produce the requested content from the Authenticator and return
2874         *checksum_type = qder2b_unpack_int32 (auth.cksum.cksumtype);
2875         hash->data = auth.cksum.checksum.derptr;
2876         hash->size = auth.cksum.checksum.derlen;
2877         return 0;
2878 }
2879 #endif
2880
2881
2882
2883 /********** VALIDATION EXPRESSION LINKUP TO GNUTLS **********/
2884
2885
2886
2887 /*
2888  * The following functions implement the various validation expression
2889  * components in terms of the GnuTLS sessions of this code file.
2890  * Some work is repeated in various expression variables, notably the
2891  * lookup of a session's peer credentials, and possibly importing them
2892  * into X.509 structures.  We may at some point decide to instead do
2893  * this ahead of time, ath the expense of some compleity and possibly
2894  * slow-down of the start of the computations.
2895  */
2896
2897
2898
2899 /* valexp_store_final -- store the valexp outcome in cmd->valexp_result.
2900  */
2901 static void valexp_store_final (void *vcmd, struct valexp *ve, bool result) {
2902         ((struct command *) vcmd)->valexp_result = result;
2903 }
2904
2905 /* valexp_valflag_set -- set a validation flag bit for an uppercase predicate.
2906  */
2907 static void valexp_valflag_set (struct command *cmd, char pred) {
2908         int len = strlen (cmd->valflags);
2909         cmd->valflags [len++] = pred;
2910         cmd->valflags [len  ] = '\0';
2911 }
2912
2913 /* valexp_valflag_start -- get a prior set bit with validation information.
2914  * Where cmd->valflags is a string of uppercase letters that were ensured.
2915  */
2916 static void valexp_valflag_start (void *vcmd, struct valexp *ve, char pred) {
2917         struct command *cmd = (struct command *) vcmd;
2918         pred &= 0xdf;   // lowercase->uppercase
2919         valexp_setpredicate (ve, pred, NULL != strchr (cmd->valflags, pred));
2920 }
2921
2922 /* valexp_0_start -- validation function for the GnuTLS backend.
2923  * This function immediately sends failure on something impossible.
2924  */
2925 static void valexp_0_start (void *vcmd, struct valexp *ve, char pred) {
2926         valexp_setpredicate (ve, pred, 0);
2927 }
2928
2929 /* valexp_1_start -- validation function for the GnuTLS backend.
2930  * This function immediately sends success on something trivial.
2931  */
2932 static void valexp_1_start (void *vcmd, struct valexp *ve, char pred) {
2933         valexp_setpredicate (ve, pred, 1);
2934 }
2935
2936 //TODO// valexp_L_start, valexp_l_start
2937
2938 /* valexp_I_start -- validation function for the GnuTLS backend.
2939  * This function ensures that the remote peer provides an identity.
2940  * TODO: We should compare the hostname as well, or compare if in remoteid
2941  * TODO: We may need to support more than just X509/PGP certificates
2942  */
2943 static void valexp_I_start (void *vcmd, struct valexp *ve, char pred) {
2944         struct command *cmd = (struct command *) vcmd;
2945         int ok = 1;
2946         ok = ok && (cmd->remote_auth_type == GNUTLS_CRD_CERTIFICATE);
2947         ok = ok && (cmd->remote_cert_count > 0);
2948         // Accept most certificates, but not for example GNUTLS_CRT_RAW
2949         ok = ok && (
2950 #ifdef GNUTLS_CRT_KRB
2951                 (cmd->remote_cert_type == GNUTLS_CRT_KRB) ||
2952 #endif
2953                 (cmd->remote_cert_type == GNUTLS_CRT_X509) ||
2954                 (cmd->remote_cert_type == GNUTLS_CRT_OPENPGP) );
2955         // peer-returned "certs" points into GnuTLS' internal data structures
2956         valexp_setpredicate (ve, pred, ok);
2957 }
2958
2959 /* valexp_i_start -- is opportunistic and will always succeed
2960  */
2961 #define valexp_i_start valexp_1_start
2962
2963 /* valexp_Ff_start -- validation function for the GnuTLS backend.
2964  * This functin ensures that forward secrecy is applied.
2965  * While _F_ only accepts DHE, _f_ will also accept DH.
2966  * Note: GnuTLS does not seem to show DH that is not also DHE.
2967  */
2968 static void valexp_Ff_start (void *vcmd, struct valexp *ve, char pred) {
2969         struct command *cmd = (struct command *) vcmd;
2970         gnutls_kx_algorithm_t kx = gnutls_kx_get (cmd->session);
2971         switch (kx) {
2972         case GNUTLS_KX_UNKNOWN:
2973         case GNUTLS_KX_RSA:
2974         case GNUTLS_KX_RSA_EXPORT:
2975         case GNUTLS_KX_PSK:
2976         default:
2977                 valexp_setpredicate (ve, pred, 0);
2978                 break;
2979         case GNUTLS_KX_DHE_DSS:
2980         case GNUTLS_KX_DHE_RSA:
2981         case GNUTLS_KX_SRP:
2982         case GNUTLS_KX_SRP_RSA:
2983         case GNUTLS_KX_SRP_DSS:
2984         case GNUTLS_KX_DHE_PSK:
2985         case GNUTLS_KX_ECDHE_RSA:
2986         case GNUTLS_KX_ECDHE_ECDSA:
2987         case GNUTLS_KX_ECDHE_PSK:
2988         case GNUTLS_KX_ANON_ECDH:       // Assume DHE is in fact implemented
2989         case GNUTLS_KX_ANON_DH:         // Assume DHE is in fact implemented
2990                 valexp_setpredicate (ve, pred, 1);
2991                 break;
2992         // case GNUTLS_KX_xxx_DH:
2993         //      valexp_setpredicate (ve, pred, pred != 'F');
2994         //      break;
2995         }
2996 }
2997
2998 /* valexp_A_start -- validation function for the GnuTLS backend.
2999  * This function ensures that an anonymising precursor is used.
3000  */
3001 #define valexp_A_start valexp_valflag_start
3002
3003 /* valexp_a_start -- is opportunistic and will always succeed */
3004 #define valexp_a_start valexp_1_start
3005
3006 /* valexp_Tt_start -- validation function for the GnuTLS backend.
3007  * This function ensures trust based on a trusted certificate/key list.
3008  * In the _t_ case, self-signed certificates are also accepted.
3009  */
3010 static void valexp_Tt_start (void *vcmd, struct valexp *ve, char pred) {
3011         struct command *cmd = (struct command *) vcmd;
3012         int flagval = 0;
3013         unsigned int vfyresult;
3014         int bad;
3015         int i;
3016         if (cmd->vfystatus != 0) {
3017                 goto setflagval;
3018         }
3019         if (cmd->remote_auth_type != GNUTLS_CRD_CERTIFICATE) {
3020                 goto setflagval;
3021         }
3022         //
3023         // Handle self-signed peer certificates in a special way
3024         if (cmd->remote_cert_count == 1) {
3025                 int bad = 0;
3026                 bad = bad || (pred == 'T');     // Reject self-signed
3027                 if (cmd->remote_cert_type == GNUTLS_CRT_X509) {
3028                         vfyresult = 0;
3029                         bad = bad || gnutls_x509_crt_verify (
3030                                 (gnutls_x509_crt_t   ) cmd->remote_cert [0],
3031                                 (gnutls_x509_crt_t *) &cmd->remote_cert [0], 1,
3032                                 GNUTLS_VERIFY_DISABLE_CA_SIGN,
3033                                 &vfyresult);
3034                         // Apply the most stringent test.  This includes all of
3035                         // GNUTLS_CERT_INVALID (always set, often with others)
3036                         // GNUTLS_CERT_NOT_ACTIVATED
3037                         // GNUTLS_CERT_EXPIRED
3038                         // GNUTLS_CERT_SIGNER_CONSTRAINTS_FAILURE
3039                         // GNUTLS_CERT_SIGNER_NOT_FOUND
3040                         // GNUTLS_CERT_SIGNER_NOT_CA => oops...
3041                         //      stopped with GNUTLS_VERIFY_DISABLE_CA_SIGN
3042                         // GNUTLS_CERT_SIGNATURE_FAILURE
3043                         // GNUTLS_CERT_INSECURE_ALGORITHM
3044                         bad = bad || (vfyresult != 0);
3045                         if (!bad) {
3046                                 flagval = 1;
3047                                 goto setflagval;
3048                         }
3049                 } else if (cmd->remote_cert_type == GNUTLS_CRT_OPENPGP) {
3050                         //TODO// Prefer to actually check PGP self-signature
3051                         //TODO// But only value is check private-key ownership
3052                         flagval = 0;
3053                         goto setflagval;
3054 #ifdef GNUTLS_CRT_KRB
3055                 } else if (cmd->remote_cert_type == GNUTLS_CRT_KRB) {
3056                         // Kerberos has authenticated the ticket for us
3057                         //TODO// Should we try reading from the ticket/auth?
3058                         flagval = 1;
3059                         goto setflagval;
3060 #endif
3061                 }
3062                 if (bad) {
3063                         goto setflagval;
3064                 }
3065         }
3066         if (cmd->remote_cert_type == GNUTLS_CRT_X509) {
3067                 // Now check the certificate chain, taking CA bits into account
3068                 for (i=1; i<cmd->remote_cert_count; i++) {
3069                         vfyresult = 0;
3070                         bad = bad || gnutls_x509_crt_verify (
3071                                 (gnutls_x509_crt_t  )  cmd->remote_cert [i-1],
3072                                 (gnutls_x509_crt_t *) &cmd->remote_cert [i], 1,
3073                                 0,
3074                                 &vfyresult);
3075                         // Apply the most stringent test.  This includes all of
3076                         // GNUTLS_CERT_INVALID (always set, often with others)
3077                         // GNUTLS_CERT_NOT_ACTIVATED
3078                         // GNUTLS_CERT_EXPIRED
3079                         // GNUTLS_CERT_SIGNER_CONSTRAINTS_FAILURE
3080                         // GNUTLS_CERT_SIGNER_NOT_FOUND
3081                         // GNUTLS_CERT_SIGNER_NOT_CA => oops...
3082                         //      stopped with GNUTLS_VERIFY_DISABLE_CA_SIGN
3083                         // GNUTLS_CERT_SIGNATURE_FAILURE
3084                         // GNUTLS_CERT_INSECURE_ALGORITHM
3085                         bad = bad || (vfyresult != 0);
3086                 }
3087         } else if (cmd->remote_cert_type == GNUTLS_CRT_OPENPGP) {
3088                 ; //TODO// Check PGP direct signature (and also use in self-sig)
3089 #ifdef GNUTLS_CRT_KRB
3090         } else if (cmd->remote_cert_type == GNUTLS_CRT_KRB) {
3091                 ; // Trust has already been validated through Kerberos
3092 #endif
3093         }
3094 setflagval:
3095         valexp_setpredicate (ve, pred, flagval);
3096 }
3097
3098 /* valexp_Dd_start -- validation function for the GnuTLS backend.
3099  * This function validates through DNSSEC.
3100  * While _D_ enforces DNSSEC, _d_ also accepts opted-out security.
3101  */
3102 static void valexp_Dd_start (void *vcmd, struct valexp *ve, char pred) {
3103         struct command *cmd = (struct command *) vcmd;
3104         int flagval = 0;
3105         unsigned int vfystat;
3106         char *host;
3107         char *proto;
3108         int sox;
3109         struct sockaddr peername;
3110         socklen_t peernamesz = sizeof (peername);
3111         uint16_t port;
3112         host = strchr (cmd->cmd.pio_data.pioc_starttls.remoteid, '@');
3113         if (host == NULL) {
3114                 host = cmd->cmd.pio_data.pioc_starttls.remoteid;
3115         }
3116         switch (cmd->cmd.pio_data.pioc_starttls.ipproto) {
3117         case IPPROTO_TCP:
3118                 proto = "tcp";
3119                 break;
3120         case IPPROTO_UDP:
3121                 proto = "udp";
3122                 break;
3123 #ifndef WINDOWS_PORT
3124         case IPPROTO_SCTP:
3125                 proto = "sctp";
3126                 break;
3127 #endif
3128         default:
3129                 goto setflagval;
3130         }
3131         sox = gnutls_transport_get_int (cmd->session);
3132         if (sox < 0) {
3133                 goto setflagval;
3134         }
3135         if (getpeername (sox, &peername, &peernamesz) != 0) {
3136                 goto setflagval;
3137         }
3138         if ((peername.sa_family == AF_INET) &&
3139                                 (peernamesz == sizeof (struct sockaddr_in))) {
3140                 port = ntohs (((struct sockaddr_in *) &peername)->sin_port);
3141         } else if ((peername.sa_family == AF_INET6) &&
3142                                 (peernamesz == sizeof (struct sockaddr_in6))) {
3143         } else {
3144                 port = ntohs (((struct sockaddr_in6 *) &peername)->sin6_port);
3145                 goto setflagval;
3146         }
3147 #ifdef HAVE_GNUTLS_DANE
3148         //TODO// We might use online.c code instead?
3149     dane_state_t stat;
3150         if (dane_state_init (&stat, /*TODO:*/ 0) != GNUTLS_E_SUCCESS) {
3151                 goto setflagval;
3152         }
3153         if (dane_verify_session_crt (stat,
3154                                 cmd->session,
3155                                 host,
3156                                 proto,
3157                                 port,
3158                                 0,
3159                                 DANE_VFLAG_FAIL_IF_NOT_CHECKED,
3160                                 &vfystat) == DANE_E_SUCCESS) {
3161                 if ((pred == 'D') && (vfystat & DANE_VERIFY_UNKNOWN_DANE_INFO)) {
3162                         dane_state_deinit (stat);
3163                         goto setflagval;
3164                 }
3165                 flagval = ((vfystat & ~DANE_VERIFY_UNKNOWN_DANE_INFO) == 0);
3166         }
3167         dane_state_deinit (stat);
3168 #endif
3169 setflagval:
3170         valexp_setpredicate (ve, pred, flagval);
3171 }
3172
3173 /* valexp_Rr_start -- validation function for the GnuTLS backend.
3174  * This function validates through a CRL.
3175  * While _R_ requires the CRL to be present, _r_ accepts confirmed absense.
3176  * TODO: This is not implemented yet.
3177  */
3178 static void valexp_Rr_start (void *vcmd, struct valexp *ve, char pred) {
3179         //TODO//;
3180         valexp_setpredicate (ve, pred, 0);
3181 }
3182
3183 /* valexp_Ee_start -- validation function for the GnuTLS backend.
3184  * This function validates certificate extensions for the named service.
3185  * While _E_ required OIDs to be marked critical, _e_ also accepts non-crit.
3186  */
3187 static void valexp_Ee_start (void *vcmd, struct valexp *ve, char pred) {
3188         //TODO//;
3189         valexp_setpredicate (ve, pred, 0);
3190 }
3191
3192 /* valexp_Oo_start -- validation function for the GnuTLS backend.
3193  * This function validates with online/live information.
3194  * While _O_ required positive confirmation, _o_ also accepts unknown.
3195  *  -> For X.509,    look in OCSP or CRL or Global Directory
3196  *  -> For OpenPGP,  redirect O->G, o->g
3197  *  -> For Kerberos, accept anything as sufficiently live / online
3198  */
3199 static void valexp_Oo_start (void *vcmd, struct valexp *ve, char pred) {
3200         struct command *cmd = (struct command *) vcmd;
3201         int valflag = 0;
3202         online2success_t o2vf;
3203         char *rid;
3204         gnutls_datum_t *raw;
3205         if (cmd->remote_auth_type != GNUTLS_CRD_CERTIFICATE) {
3206                 // No authentication types other than certificates yet
3207                 goto setvalflag;
3208         } else {
3209                 if ((pred >= 'a') && (pred <= 'z')) {
3210                         o2vf = online2success_optional;
3211                 } else {
3212                         o2vf = online2success_enforced;
3213                 }
3214                 rid = cmd->cmd.pio_data.pioc_starttls.remoteid;
3215                 raw = (gnutls_datum_t *) cmd->remote_cert_raw;
3216                 if (cmd->remote_cert_type == GNUTLS_CRT_OPENPGP) {
3217                         valflag = o2vf (online_globaldir_pgp (
3218                                         rid,
3219                                         raw->data, raw->size));
3220                 } else if (cmd->remote_cert_type == GNUTLS_CRT_X509) {
3221                         // OCSP inquiry or globaldir
3222                         valflag = o2vf (online_globaldir_x509 (
3223                                         rid,
3224                                         raw->data, raw->size));
3225 #ifdef HAVE_TLS_KDH
3226                 } else if (cmd->remote_cert_type == GNUTLS_CRT_KRB) {
3227                         // Kerberos is sufficiently "live" to be pass O
3228                         valflag = 1;
3229                         goto setvalflag;
3230 #endif
3231                 } else {
3232                         // GNUTLS_CRT_RAW, GNUTLS_CRT_UNKNOWN, or other
3233                         goto setvalflag;
3234                 }
3235         }
3236 setvalflag:
3237         valexp_setpredicate (ve, pred, valflag);
3238 }
3239
3240 /* valexp_Gg_start -- validation function for the GnuTLS backend.
3241  * This function validates through the LDAP global directory.
3242  * While _G_ requires information to be present, _g_ also accepts absense.
3243  *  -> For X.509,   lookup userCertificate
3244  *  -> For OpenPGP, lookup pgpKey
3245  *  -> For KDH,     lookup krbPrincipalName
3246  *  -> For SRP,     nothing is defined
3247  *  -> For OpenSSH, no TLS support
3248  */
3249 static void valexp_Gg_start (void *vcmd, struct valexp *ve, char pred) {
3250         struct command *cmd = (struct command *) vcmd;
3251         int valflag = 0;
3252         online2success_t o2vf;
3253         char *rid;
3254         gnutls_datum_t *raw;
3255         if (cmd->remote_auth_type != GNUTLS_CRD_CERTIFICATE) {
3256                 // No authentication types other than certificates yet
3257                 goto setvalflag;
3258         } else {
3259                 if ((pred >= 'a') && (pred <= 'z')) {
3260                         o2vf = online2success_optional;
3261                 } else {
3262                         o2vf = online2success_enforced;
3263                 }
3264                 rid = cmd->cmd.pio_data.pioc_starttls.remoteid;
3265                 raw = (gnutls_datum_t *) cmd->remote_cert_raw;
3266                 if (cmd->remote_cert_type == GNUTLS_CRT_OPENPGP) {
3267                         valflag = o2vf (online_globaldir_pgp (
3268                                         rid,
3269                                         raw->data, raw->size));
3270                 } else if (cmd->remote_cert_type == GNUTLS_CRT_X509) {
3271                         //TODO// OCSP inquiry or globaldir
3272                         valflag = o2vf (online_globaldir_x509 (
3273                                         rid,
3274                                         raw->data, raw->size));
3275 #ifdef GNUTLS_CRT_KRB
3276                 } else if (cmd->remote_cert_type == GNUTLS_CRT_KRB) {
3277                         valflag = 0;
3278                         //TODO// valflag = o2vf (online_globaldir_kerberos (
3279                         //TODO//                rid,
3280                         //TODO//                raw->data, raw->size));
3281 #endif
3282                 } else {
3283                         // GNUTLS_CRT_RAW, GNUTLS_CRT_UNKNOWN, or other
3284                         goto setvalflag;
3285                 }
3286         }
3287 setvalflag:
3288         valexp_setpredicate (ve, pred, valflag);
3289 }
3290
3291 /* valexp_Pp_start -- validation function for the GnuTLS backend.
3292  * This function validates through pinning information.
3293  * While _P_ requires pinning to be present, _p_ will Trust On First Use.
3294  */
3295 static void valexp_Pp_start (void *vcmd, struct valexp *ve, char pred) {
3296         //TODO//;
3297         valexp_setpredicate (ve, pred, 0);
3298 }
3299
3300 /* valexp_U_start -- validation function for the GnuTLS backend.
3301  * This function validates a matching username.
3302  */
3303 static void valexp_U_start (void *vcmd, struct valexp *ve, char pred) {
3304         //TODO//;
3305         valexp_setpredicate (ve, pred, 0);
3306 }
3307
3308 /* valexp_Ss_start -- validation function for the GnuTLS backend.
3309  * This function ensures that the local end is a server.
3310  * While _S_ denies credentials also usable for clients, _s_ permits them.
3311  */
3312 static void valexp_Ss_start (void *vcmd, struct valexp *ve, char pred) {
3313         struct command *cmd = (struct command *) vcmd;
3314         int flagval;
3315         if ((pred == 'S') && (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALROLE_CLIENT)) {
3316                 flagval = 0;
3317         } else {
3318                 flagval = (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALROLE_SERVER) != 0;
3319         }
3320         valexp_setpredicate (ve, pred, flagval);
3321 }
3322
3323 /* valexp_Cc_start -- validation function for the GnuTLS backend.
3324  * This function ensures that the local end is a client.
3325  * While _C_ denies credentials also usable for servers, _c_ permits them.
3326  */
3327 static void valexp_Cc_start (void *vcmd, struct valexp *ve, char pred) {
3328         struct command *cmd = (struct command *) vcmd;
3329         int flagval;
3330         if ((pred == 'C') && (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALROLE_SERVER)) {
3331                 flagval = 0;
3332         } else {
3333                 flagval = (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALROLE_CLIENT) != 0;
3334         }
3335         valexp_setpredicate (ve, pred, flagval);
3336 }
3337
3338
3339 /* valexp_Qq_start -- validation function for the GnuTLS backend.
3340  * This function ensures a post-quantum cipher suite.
3341  * While _Q_ focusses on encryption, _q_ focusses on authentication.
3342  * There is currently no variable to protect the handshake, as that
3343  * may well prove impossible.
3344  */
3345 static void valexp_Qq_start (void *vcmd, struct valexp *ve, char pred) {
3346         /* Work to be done for TLS designers! */
3347         /* Once we get TLS-KDH going we should update the code below */
3348         valexp_setpredicate (ve, pred, 0);
3349 }
3350
3351
3352 static void valexp_error_start (void *handler_data, struct valexp *ve, char pred) {
3353         assert (0);
3354 }
3355 static void valexp_ignore_stop (void *handler_data, struct valexp *ve, char pred) {
3356         ; // Nothing to do
3357 }
3358 static void valexp_ignore_final (void *handler_data, struct valexp *ve, bool value) {
3359         ; // Nothing to do
3360 }
3361
3362
3363 /* Given a predicate, invoke its start routine.
3364  */
3365 static void valexp_switch_start (void *handler_data, struct valexp *ve, char pred) {
3366         switch (pred) {
3367         case 'I':
3368                 valexp_I_start (handler_data, ve, pred);
3369                 break;
3370         case 'i':
3371                 valexp_i_start (handler_data, ve, pred);
3372                 break;
3373         case 'F':
3374         case 'f':
3375                 valexp_Ff_start (handler_data, ve, pred);
3376                 break;
3377         case 'A':
3378                 valexp_A_start (handler_data, ve, pred);
3379                 break;
3380         case 'a':
3381                 valexp_a_start (handler_data, ve, pred);
3382                 break;
3383         case 'T':
3384         case 't':
3385                 valexp_Tt_start (handler_data, ve, pred);
3386                 break;
3387         case 'D':
3388         case 'd':
3389                 valexp_Dd_start (handler_data, ve, pred);
3390                 break;
3391         case 'R':
3392         case 'r':
3393                 valexp_Rr_start (handler_data, ve, pred);
3394                 break;
3395         case 'E':
3396         case 'e':
3397                 valexp_Ee_start (handler_data, ve, pred);
3398                 break;
3399         case 'O':
3400         case 'o':
3401                 valexp_Oo_start (handler_data, ve, pred);
3402                 break;
3403         case 'G':
3404         case 'g':
3405                 valexp_Gg_start (handler_data, ve, pred);
3406                 break;
3407         case 'P':
3408         case 'p':
3409                 valexp_Pp_start (handler_data, ve, pred);
3410                 break;
3411         case 'U':
3412                 valexp_U_start (handler_data, ve, pred);
3413                 break;
3414         case 'S':
3415         case 's':
3416                 valexp_Ss_start (handler_data, ve, pred);
3417                 break;
3418         case 'C':
3419         case 'c':
3420                 valexp_Cc_start (handler_data, ve, pred);
3421                 break;
3422         case 'Q':
3423         case 'q':
3424                 valexp_Qq_start (handler_data, ve, pred);
3425         default:
3426                 // Called on an unregistered symbol, that spells failure
3427                 valexp_setpredicate (ve, pred, 0);
3428                 break;
3429         }
3430 }
3431
3432 /* Return a shared constant structure for valexp_handling with GnuTLS.
3433  * This function does not fail; it always returns a non-NULL value.
3434  */
3435 static const struct valexp_handling *have_starttls_validation (void) {
3436         static const struct valexp_handling starttls_valexp_handling = {
3437                 .handler_start = valexp_switch_start,
3438                 .handler_stop  = valexp_ignore_stop,
3439                 .handler_final = valexp_store_final,
3440         };
3441         return &starttls_valexp_handling;
3442 }
3443
3444
3445
3446 /* If any remote credentials are noted, cleanup on them.  This removes
3447  * any remote_cert[...] entries, counting up to remote_cert_count which
3448  * is naturally set to 0 initially, as well as after this has run.
3449  */
3450 static void cleanup_any_remote_credentials (struct command *cmd) {
3451         while (cmd->remote_cert_count > 0) {
3452                 gnutls_x509_crt_deinit (
3453                         cmd->remote_cert [--cmd->remote_cert_count]);
3454         }
3455         memset (cmd->remote_cert, 0, sizeof (cmd->remote_cert));
3456 }
3457
3458 /* Fetch remote credentials.  This can be done after TLS handshaking has
3459  * completed, to find the certificates or other credentials provided by
3460  * the peer to establish its identity.  The validation expression routines
3461  * can then refer to this resource, and won't have to request the same
3462  * information over and over again.  To this end, the information is stored
3463  * in the session object.  The arrays in which this information is stored
3464  * are size-constrained, but that is also a good security precaution.
3465  *
3466  * The information ends up in the following variables:
3467  *  - remote_auth_type
3468  *  - remote_cert_type (if remote_auth_type == GNUTLS_CRD_CERTIFICATE)
3469  *  - remote_cert[...] (if remote_cert_type == GNUTLS_CRD_CERTIFICATE)
3470  *  - remote_cert_count is the number of entries in remote_cert (up to root)
3471  *
3472  * When certificates are used, the root certificate is looked up, for
3473  * X.509 and PGP.
3474  *
3475  * After running successfully, a call to cleanup_any_remote_credentials()
3476  * must be called to clean up any data in the cmd structure.  This may be
3477  * done on cmd at any time after initialisation, even multiple times and
3478  * even when this call fails.  This call actually cleans up anything it
3479  * setup in the past, before setting up the data anew.
3480  */
3481 static gtls_error fetch_remote_credentials (struct command *cmd) {
3482         gtls_error gtls_errno = GNUTLS_E_SUCCESS;
3483         const gnutls_datum_t *certs;
3484         unsigned int num_certs;
3485         gnutls_x509_crt_t x509peers [11]; // Peers + Root for GNUTLS_CRT_X509
3486         int i;
3487         bool got_chain = 0;
3488         int peer_tad = -1;
3489
3490         // Did we run this before?  Then cleanup.
3491         cleanup_any_remote_credentials (cmd);
3492         //INVOLVES// memset (cmd->remote_cert, 0, sizeof (cmd->remote_cert));
3493         //INVOLVES// cmd->remote_cert_count = 0;
3494         // Prepare as-yet-unset default return values
3495         cmd->remote_auth_type = -1;
3496         cmd->remote_cert_raw = NULL;
3497         //
3498         // Obtain the authentication type for the peer
3499         cmd->remote_auth_type = gnutls_auth_get_type (cmd->session);
3500         switch (cmd->remote_auth_type) {
3501         case GNUTLS_CRD_CERTIFICATE:
3502                 // Continue loading certificates in the GnuTLS format
3503                 break;
3504         case GNUTLS_CRD_ANON:
3505                 // No basis for any identity claim
3506                 cmd->cmd.pio_data.pioc_starttls.remoteid [0] = '\0';
3507                 return GNUTLS_E_SUCCESS;
3508         case GNUTLS_CRD_SRP:
3509                 return GNUTLS_E_SUCCESS;
3510         case GNUTLS_CRD_PSK:
3511                 return GNUTLS_E_SUCCESS;
3512         default:
3513                 return GNUTLS_E_AUTH_ERROR;
3514         }
3515         //
3516         // Continue loading the certificate information: X.509, PGP, ...
3517 #ifdef HAVE_TLS_KDH
3518         cmd->remote_cert_type = gnutls_certificate_type_get_peers (cmd->session);
3519         certs = gnutls_certificate_get_peers (cmd->session, &num_certs);
3520         // Note: server's certs _may_ be DER NULL due to mutual auth in Kerberos
3521 #else
3522         cmd->remote_cert_type = gnutls_certificate_type_get (cmd->session);
3523         certs = gnutls_certificate_get_peers (cmd->session, &num_certs);
3524 #endif
3525         if (certs == NULL) {
3526                 num_certs = 0;
3527         }
3528         // "certs" points into GnuTLS' internal data structures
3529         if ((num_certs < 1) || (num_certs > CERTS_MAX_DEPTH)) {
3530                 return GNUTLS_E_AUTH_ERROR;
3531         }
3532         cmd->remote_cert_raw = (void *) &certs [0];
3533         //
3534         // Turn certificate data into GnuTLS' data structures (to be cleaned)
3535         if (cmd->remote_cert_type == GNUTLS_CRT_X509) {
3536                 peer_tad = TAD_TYPE_X509;
3537                 for (i=0; i < num_certs; i++) {
3538                         E_g2e ("Failed to initialise peer X.509 certificate",
3539                                 gnutls_x509_crt_init (
3540                                         (gnutls_x509_crt_t *) &cmd->remote_cert [i]));
3541                         if (gtls_errno == GNUTLS_E_SUCCESS) {
3542                                 cmd->remote_cert_count++;
3543                         }
3544                         E_g2e ("Failed to import peer X.509 certificate",
3545                                 gnutls_x509_crt_import (
3546                                         cmd->remote_cert [i],
3547                                         &certs [i], GNUTLS_X509_FMT_DER));
3548                 }
3549                 if (gtls_errno != GNUTLS_E_SUCCESS) {
3550                         goto cleanup;
3551                 }
3552         } else if (cmd->remote_cert_type == GNUTLS_CRT_OPENPGP) {
3553                 peer_tad = TAD_TYPE_PGP;
3554                 E_g2e ("Failed to initialise peer PGP key",
3555                                 gnutls_x509_crt_init (
3556                                         (gnutls_x509_crt_t *) &cmd->remote_cert [0]));
3557                 if (gtls_errno == GNUTLS_E_SUCCESS) {
3558                         cmd->remote_cert_count = 1;
3559                 }
3560                 E_g2e ("Failed to import peer PGP key",
3561                                 gnutls_openpgp_crt_import (
3562                                         cmd->remote_cert [0],
3563                                         &certs [0], GNUTLS_OPENPGP_FMT_RAW));
3564                 if (gtls_errno != GNUTLS_E_SUCCESS) {
3565                         goto cleanup;
3566                 }
3567         }
3568
3569         //
3570         // Lookup the trusted party that the peers certificates is promoting.
3571         // Note that even if the peer ends in a CA cert (which it may not
3572         // always send along) then we can still add it ourselves again :-)
3573         // Only worry might be that CA certs require no AuthorityKeyIdentifier.
3574         if (cmd->remote_cert_type == GNUTLS_CRT_X509) {
3575                 // Retrieve the AuthorityKeyIdentifier from last (or semi-last)
3576                 uint8_t id [100];
3577                 size_t idsz;
3578                 DBT rootca;
3579                 DBT anchor;
3580                 DBC *crs_trust = NULL;
3581                 int db_errno;
3582                 gnutls_datum_t anchor_gnutls;
3583                 gnutls_x509_crt_t dbroot;
3584                 dbt_init_empty (&rootca);
3585                 dbt_init_empty (&anchor);
3586                 idsz = sizeof (id);
3587                 gtls_errno = gnutls_x509_crt_get_authority_key_id (
3588                         cmd->remote_cert [cmd->remote_cert_count-1],
3589                         id, &idsz,
3590                         NULL);
3591                 if (gtls_errno == GNUTLS_E_REQUESTED_DATA_NOT_AVAILABLE) {
3592                         // Only retry if the last is a signer, possibly CA
3593                         if (cmd->remote_cert_count == 1) {
3594                                 // Permit self-signed certificate evaluation
3595                                 gtls_errno = GNUTLS_E_SUCCESS;
3596                         } else if (cmd->remote_cert_count > 1) {
3597                                 // Assume the last is a root cert, as it lacks authid
3598                                 gnutls_x509_crt_deinit (
3599                                         cmd->remote_cert [--cmd->remote_cert_count]);
3600                                 cmd->remote_cert [cmd->remote_cert_count] = NULL;
3601                                 idsz = sizeof (id);
3602                                 gtls_errno = gnutls_x509_crt_get_authority_key_id (
3603                                         cmd->remote_cert [cmd->remote_cert_count-1],
3604                                         id, &idsz,
3605                                         NULL);
3606                         }
3607                 }
3608                 if (gtls_errno != GNUTLS_E_SUCCESS) {
3609                         goto cleanup;
3610                 }
3611                 // Get root cert from trustdb into remote_cert [_count++]
3612                 dbt_init_fixbuf (&rootca, id, idsz);
3613                 dbt_init_malloc (&anchor);
3614                 E_d2e ("Failed to create db_disclose cursor",
3615                         dbh_trust->cursor (
3616                                 dbh_trust,
3617                                 cmd->txn,
3618                                 &crs_trust,
3619                                 0));
3620                 E_d2e ("X.509 authority key identifier not found in trust database",
3621                         dba_trust_iterate (
3622                                 crs_trust, &rootca, &anchor));
3623                 while (db_errno == 0) {
3624                         // Process "anchor" entry (inasfar as meaningful)
3625                         uint32_t anchorflags;
3626                         uint8_t *trustdata;
3627                         int trustdatalen;
3628                         char *valexp;   //TODO// Initiate this before cleanup
3629                         int tstatus = trust_interpret (&anchor, &anchorflags, &valexp, &trustdata, &trustdatalen);
3630                         dbt_free (&anchor);
3631                         if (tstatus != TAD_STATUS_SUCCESS) {
3632                                 // Signal any DB error to bail out of this loop
3633                                 db_errno = DB_KEYEMPTY;
3634                         } else if ((anchorflags & TAD_TYPE_MASK) != peer_tad) {
3635                                 ;       // Skip unsought trust database entry
3636                         } else if ((anchorflags & TAD_TYPE_MASK) == TAD_TYPE_X509) {
3637                                 E_g2e ("Certificate chain too long",
3638                                         (cmd->remote_cert_count >= CERTS_MAX_DEPTH)
3639                                         ? GNUTLS_E_AUTH_ERROR
3640                                         : GNUTLS_E_SUCCESS);
3641                                 // Turn the anchor into an X.509 certificate
3642                                 E_g2e ("Failet to initialise X.509 peer trust anchor",
3643                                         gnutls_x509_crt_init ((gnutls_x509_crt_t *) &cmd->remote_cert [cmd->remote_cert_count]));
3644                                 if (gtls_errno == GNUTLS_E_SUCCESS) {
3645                                         cmd->remote_cert_count++;
3646                                         anchor_gnutls.data = anchor.data;
3647                                         anchor_gnutls.size = anchor.size;
3648                                         E_g2e ("Failed to import X.509 peer trust anchor",
3649                                                 gnutls_x509_crt_import (cmd->remote_cert [cmd->remote_cert_count-1], &anchor_gnutls, GNUTLS_X509_FMT_DER));
3650                                 }
3651                                 if (gtls_errno == GNUTLS_E_SUCCESS) {
3652                                         // Everything worked, we have a chain
3653                                         got_chain = 1;
3654                                         if (cmd->trust_valexp) {
3655                                                 free (cmd->trust_valexp);
3656                                         }
3657                                         cmd->trust_valexp = strdup (valexp);
3658                                 } else {
3659                                         // Signal arbitrary DB error
3660                                         db_errno = DB_KEYEMPTY;
3661                                 }
3662                         } else if ((anchorflags & TAD_TYPE_MASK) == TAD_TYPE_REVOKE_X509) {
3663                                 //TODO// Possibly verify end cert revocation
3664                         } else {
3665                                 /* Ignore entry, continue with the next */;
3666                         }
3667                         db_errno = dba_trust_iterate (crs_trust, &rootca, &anchor);
3668                 }
3669                 if (crs_trust != NULL) {
3670                         crs_trust->close (crs_trust);
3671                         crs_trust = NULL;
3672                 }
3673                 dbt_free (&anchor);
3674                 // No dbt_free (&rootca) because it is set to a fixed buffer
3675                 if (db_errno != DB_NOTFOUND) {
3676                         goto cleanup;
3677                 }
3678         } else if (cmd->remote_cert_type == GNUTLS_CRT_OPENPGP) {
3679                 ; //TODO// Attempt to load PGP direct signer(s)
3680                 ; //OPTION// May use the _count for alternative signers!
3681                 ; //OPTION// May setup/reload a keyring based on trust.db
3682 #ifdef GNUTLS_CRT_KRB
3683         } else if (cmd->remote_cert_type == GNUTLS_CRT_KRB) {
3684                 ; //TODO// Process as appropriate for Kerberos (store Ticket?)
3685 #endif
3686         }
3687         //
3688         // Cleanup (when returning an error code) and return
3689 cleanup:
3690         if (gtls_errno != GNUTLS_E_SUCCESS) {
3691                 cleanup_any_remote_credentials (cmd);
3692         }
3693         while ((!got_chain) && (cmd->remote_cert_count > 1)) {
3694                 --cmd->remote_cert_count;
3695                 gnutls_x509_crt_deinit (
3696                         cmd->remote_cert [cmd->remote_cert_count]);
3697                 cmd->remote_cert [cmd->remote_cert_count] = NULL;
3698         }
3699         return gtls_errno;
3700 }
3701
3702
3703 /* Fetch local credentials.  This can be done before TLS is started, to find
3704  * the possible authentication forms that can be offered.  The function
3705  * can additionally be used after interaction with the client to establish
3706  * a local identity that was not initially provided, or that was not
3707  * considered public at the time.
3708  */
3709 gtls_error fetch_local_credentials (struct command *cmd) {
3710         int lidrole;
3711         char *lid, *rid;
3712         DBC *crs_disclose = NULL;
3713         DBC *crs_localid = NULL;
3714         DBT discpatn;
3715         DBT keydata;
3716         DBT creddata;
3717         selector_t remote_selector;
3718         int gtls_errno = 0;
3719         int db_errno = 0;
3720         int found = 0;
3721         gtls_error certificate_onthefly (struct command *cmd);
3722
3723         //
3724         // When applicable, try to create an on-the-fly certificate
3725         if (((cmd->cmd.pio_cmd == PIOC_STARTTLS_V2) &&
3726                         (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALID_ONTHEFLY))
3727         || ((cmd->cmd.pio_cmd == PIOC_LIDENTRY_CALLBACK_V2) &&
3728                         (cmd->cmd.pio_data.pioc_lidentry.flags & PIOF_LIDENTRY_ONTHEFLY))) {
3729                 gtls_errno = certificate_onthefly (cmd);
3730                 if (gtls_errno != GNUTLS_E_AGAIN) {
3731                         // This includes GNUTLS_E_SUCCESS
3732 fprintf (stderr, "DEBUG: otfcert retrieval returned %d\n", gtls_errno);
3733                         return gtls_errno;
3734                 } else {
3735 fprintf (stderr, "DEBUG: otfcert retrieval returned GNUTLS_E_AGAIN, so skip it\n");
3736                         gtls_errno = GNUTLS_E_SUCCESS;  // Attempt failed, ignore
3737                 }
3738         }
3739
3740         //
3741         // Setup a number of common references and structures
3742         // Note: Current GnuTLS cannot support being a peer
3743         if (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALROLE_CLIENT) {
3744                 lidrole = LID_ROLE_CLIENT;
3745         } else if (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALROLE_SERVER) {
3746                 lidrole = LID_ROLE_SERVER;
3747         } else {
3748                 E_g2e ("TLS Pool command supports neither local client nor local server role",
3749                         GNUTLS_E_INVALID_SESSION);
3750                 return gtls_errno;
3751         }
3752         lid = cmd->cmd.pio_data.pioc_starttls.localid;
3753         rid = cmd->cmd.pio_data.pioc_starttls.remoteid;
3754
3755         //
3756         // Refuse to disclose client credentials when the server name is unset;
3757         // note that server-claimed identities are unproven during handshake.
3758         if ((lidrole == LID_ROLE_CLIENT) && (*rid == '\0')) {
3759                 tlog (TLOG_USER, LOG_ERR, "No remote identity (server name) set, so no client credential disclosure");
3760                 E_g2e ("Missing remote ID",
3761                         GNUTLS_E_NO_CERTIFICATE_FOUND);
3762                 return gtls_errno;
3763         }
3764         //
3765         // Setup database iterators to map identities to credentials
3766         if (lidrole == LID_ROLE_CLIENT) {
3767                 E_d2e ("Failed to create db_disclose cursor",
3768                         dbh_disclose->cursor (
3769                                 dbh_disclose,
3770                                 cmd->txn,
3771                                 &crs_disclose,
3772                                 0));
3773         }
3774         E_d2e ("Failed to create db_localid cursor",
3775                 dbh_localid->cursor (
3776                         dbh_localid,
3777                         cmd->txn,
3778                         &crs_localid,
3779                         0));
3780         //
3781         // Prepare for iteration over possible local identities / credentials
3782         char mid [128];
3783         char cid [128];
3784         if (gtls_errno != 0) {
3785                 ; // Skip setup
3786         } else if (lidrole == LID_ROLE_CLIENT) {
3787                 memcpy (cid, rid, sizeof (cid));
3788                 dbt_init_fixbuf (&discpatn, cid, strlen (cid));
3789                 dbt_init_fixbuf (&keydata,  mid, sizeof (mid)-1);
3790                 dbt_init_malloc (&creddata);
3791                 selector_t ridsel;
3792                 donai_t remote_donai = donai_from_stable_string (rid, strlen (rid));
3793                 if (!selector_iterate_init (&remote_selector, &remote_donai)) {
3794                         E_g2e ("Syntax of remote ID unsuitable for selector",
3795                                 GNUTLS_E_INVALID_REQUEST);
3796                 } else {
3797                         E_d2e ("Failed to start iterator on remote ID selector",
3798                                 dbcred_iterate_from_remoteid_selector (
3799                                         crs_disclose,
3800                                         crs_localid,
3801                                         &remote_selector,
3802                                         &discpatn,
3803                                         &keydata,
3804                                         &creddata));
3805                 }
3806         } else {
3807                 dbt_init_fixbuf (&discpatn, "", 0);     // Unused but good style
3808                 dbt_init_fixbuf (&keydata,  lid, strlen (lid));
3809                 dbt_init_malloc (&creddata);
3810                 E_d2e ("Failed to start iterator on local ID",
3811                         dbcred_iterate_from_localid (
3812                         crs_localid,
3813                         &keydata,
3814                         &creddata));
3815         }
3816         if (db_errno != 0) {
3817                 gtls_errno = GNUTLS_E_DB_ERROR;
3818         }
3819
3820         //
3821         // Now store the local identities inasfar as they are usable
3822         db_errno = 0;
3823         while ((gtls_errno == GNUTLS_E_SUCCESS) && (db_errno == 0)) {
3824                 int ok;
3825                 uint32_t flags;
3826                 int lidtype;
3827
3828                 tlog (TLOG_DB, LOG_DEBUG, "Found BDB entry %s disclosed to %s", creddata.data + 4, (lidrole == LID_ROLE_CLIENT)? rid: "all clients");
3829                 ok = dbcred_flags (
3830                         &creddata,
3831                         &flags);
3832                 lidtype = flags & LID_TYPE_MASK;
3833                 ok = ok && ((flags & lidrole) != 0);
3834                 ok = ok && ((flags & LID_NO_PKCS11) == 0);
3835                 ok = ok && (lidtype >= LID_TYPE_MIN);
3836                 ok = ok && (lidtype <= LID_TYPE_MAX);
3837 #ifdef HAVE_TLS_KDH
3838                 // For current/simple Kerberos, refuse data after PKCS #11 URI
3839                 ok = ok && ((lidtype != LID_TYPE_KRB5) || (NULL == memchr (creddata.data + 4, '\0', creddata.size - 4 - 1)));
3840 #endif
3841                 tlog (TLOG_DB, LOG_DEBUG, "BDB entry has flags=0x%08x, so we (%04x/%04x) %s it", flags, lidrole, LID_ROLE_MASK, ok? "store": "skip ");
3842                 if (ok) {
3843                         if (cmd->lids [lidtype - LID_TYPE_MIN].data != NULL) {
3844                                 free (cmd->lids [lidtype - LID_TYPE_MIN].data);
3845                         }
3846                         // Move the credential into the command structure
3847                         dbt_store (&creddata,
3848                                 &cmd->lids [lidtype - LID_TYPE_MIN]);
3849 fprintf (stderr, "DEBUG: Storing cmd->lids[%d].data %p\n", lidtype-LID_TYPE_MIN, cmd->lids [lidtype-LID_TYPE_MIN].data);
3850                         found = 1;
3851                 } else {
3852                         // Skip the credential by freeing its data structure
3853                         dbt_free (&creddata);
3854                 }
3855                 db_errno = dbcred_iterate_next (crs_disclose, crs_localid, &discpatn, &keydata, &creddata);
3856         }
3857
3858         if (db_errno == DB_NOTFOUND) {
3859                 if (!found) {
3860                         gtls_errno = GNUTLS_E_NO_CERTIFICATE_FOUND;
3861                 }
3862         }
3863         if (crs_localid != NULL) {
3864                 crs_localid->close (crs_localid);
3865                 crs_localid = NULL;
3866         }
3867         if (crs_disclose != NULL) {
3868                 crs_disclose->close (crs_disclose);
3869                 crs_disclose = NULL;
3870         }
3871         return gtls_errno;
3872 }
3873
3874
3875 /*
3876  * Check if a given cmd has the given LID_TYPE setup.
3877  * Return 1 for yes or 0 for no; this is used in priority strings.
3878  */
3879 static inline int lidtpsup (struct command *cmd, int lidtp) {
3880         return cmd->lids [lidtp - LID_TYPE_MIN].data != NULL;
3881 }
3882
3883 /* Configure the GnuTLS session with suitable credentials and priority string.
3884  * The anonpre_ok flag should be non-zero to permit Anonymous Precursor.
3885  *
3886  * The credential setup is optional; when creds is NULL, no changes will
3887  * be made.
3888  */
3889 static int configure_session (struct command *cmd,
3890                         gnutls_session_t session,
3891                         struct credinfo *creds,
3892                         int credcount,
3893                         int anonpre_ok) {
3894         int i;
3895         int gtls_errno = GNUTLS_E_SUCCESS;
3896 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
3897         //
3898         // Install the shared credentials for the client or server role
3899         if (creds != NULL) {
3900                 gnutls_credentials_clear (session);
3901                 for (i=0; i<credcount; i++) {
3902                         E_g2e ("Failed to install credentials into TLS session",
3903                                 gnutls_credentials_set (
3904                                         session,
3905                                         creds [i].credtp,
3906                                         creds [i].cred  ));
3907                 }
3908         }
3909 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
3910         //
3911         // Setup the priority string for this session; this avoids future
3912         // credential callbacks that ask for something impossible or
3913         // undesired.
3914         //
3915         // Variation factors:
3916         //  - starting configuration (can it be empty?)
3917         //  - Configured security parameters (database? variable?)
3918         //  - CTYPEs, SRP, ANON-or-not --> fill in as + or - characters
3919         if (gtls_errno == GNUTLS_E_SUCCESS) {
3920                 char priostr [512];
3921                 //
3922                 // Check for Post Quantum algorithm requests; except for
3923                 // TLS-KDH these are not available yet, so when any of them
3924                 // is set in this early stage, the handshake should fail.
3925                 bool pq_auth = cfg_postquantum_auth ();
3926                 bool pq_encr = cfg_postquantum_encrypt ();
3927                 bool pq_shak = cfg_postquantum_handshake ();
3928 #ifdef HAVE_TLS_KDH
3929                 //
3930                 // With TLS-KDH we can achieve Post Quantum authentication
3931                 // and encryption.  When using KXOVER though, mind the gap!
3932                 // The handshake cannot be protected; it may never be.
3933                 if (pq_shak) {
3934                         gtls_errno = GNUTLS_E_NO_CIPHER_SUITES;
3935                 }
3936                 snprintf (priostr, sizeof (priostr)-1,
3937                         // "NORMAL:-RSA:" -- also ECDH-RSA, ECDHE-RSA, ...DSA...
3938                         "NONE:"
3939                         "%%ASYM_CERT_TYPES:"
3940                         "+VERS-TLS-ALL:+VERS-DTLS-ALL:"
3941                         "+COMP-NULL:"
3942                         "+CIPHER-ALL:+CURVE-ALL:+SIGN-ALL:+MAC-ALL:"
3943                         "%cANON-ECDH:"
3944                         "+ECDHE-KRB:" // +ECDHE-KRB-RSA:+ECDHE-KRB-ECDHE:" // opt?
3945                         "+ECDHE-RSA:+DHE-RSA:+ECDHE-ECDSA:+DHE-DSS:+RSA:" //TODO//
3946                         "+CTYPE-SRV-KRB:+CTYPE-SRV-X.509:+CTYPE-SRV-OPENPGP:"
3947                         "%cCTYPE-CLI-KRB:"
3948                         "%cCTYPE-CLI-X.509:"
3949                         "%cCTYPE-CLI-OPENPGP"
3950 #ifdef EXPERIMENTAL_SRP
3951                         ":%cSRP:%cSRP-RSA:%cSRP-DSS"
3952 #endif
3953                         ,anonpre_ok                             ?'+':'-'
3954                         ,1 /* lidtpsup (cmd, LID_TYPE_KRB5)*/           ?'+':'-'
3955                         ,1 /*lidtpsup (cmd, LID_TYPE_X509)*/            ?'+':'-'
3956                         ,1 /*lidtpsup (cmd, LID_TYPE_PGP)*/             ?'+':'-'
3957                         //TODO// Temporarily patched out SRP
3958 #ifdef EXPERIMENTAL_SRP
3959                         ,lidtpsup (cmd, LID_TYPE_SRP)           ?'+':'-'
3960                         ,lidtpsup (cmd, LID_TYPE_SRP)           ?'+':'-'
3961                         ,lidtpsup (cmd, LID_TYPE_SRP)           ?'+':'-'
3962 #endif
3963                         );
3964 #else
3965                 //
3966                 // Beyond TLS-KDH, the hopes for Post Quantum security
3967                 // are basically none.  This will be remedied, and at
3968                 // that time we should update the generation of the
3969                 // priority string with the algorithm preferences.
3970                 if (pq_auth || pq_encr || pq_shak) {
3971                         gtls_errno = GNUTLS_E_NO_CIPHER_SUITES;
3972                 }
3973                 //
3974                 // It's not possible to make good decisions on certificate type
3975                 // for both sides based on knowledge of local authentication
3976                 // abilities.  So we permit all (but would like to be subtler).
3977                 snprintf (priostr, sizeof (priostr)-1,
3978                         // "NORMAL:-RSA:" -- also ECDH-RSA, ECDHE-RSA, ...DSA...
3979                         "NONE:"
3980                         "+VERS-TLS-ALL:+VERS-DTLS-ALL:"
3981                         "+COMP-NULL:"
3982                         "+CIPHER-ALL:+CURVE-ALL:+SIGN-ALL:+MAC-ALL:"
3983                         "%cANON-ECDH:"
3984                         "+ECDHE-RSA:+DHE-RSA:+ECDHE-ECDSA:+DHE-DSS:+RSA:" //TODO//
3985                         "%cCTYPE-X.509:"
3986                         "%cCTYPE-OPENPGP"
3987 #ifdef EXPERIMENTAL_SRP
3988                         ":%cSRP:%cSRP-RSA:%cSRP-DSS"
3989 #endif
3990                         ,anonpre_ok                             ?'+':'-'
3991                         ,1              ?'+':'-'
3992                         ,1              ?'+':'-'
3993 #ifdef EXPERIMENTAL_SRP
3994                         //TODO// Temporarily patched out SRP
3995                         ,1              ?'+':'-'
3996                         ,1              ?'+':'-'
3997                         ,1              ?'+':'-'
3998 #endif
3999                         );
4000 #endif
4001 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
4002                 tlog (TLOG_TLS, LOG_DEBUG, "Constructed priority string %s for local ID %s",
4003                         priostr, cmd->cmd.pio_data.pioc_starttls.localid);
4004 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
4005                 E_g2e ("Failed to set GnuTLS priority string",
4006                         gnutls_priority_set_direct (
4007                         session,
4008                         priostr,
4009                         NULL));
4010         }
4011         //
4012         // Return the application GNUTLS_E_ code including _SUCCESS
4013 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
4014         return gtls_errno;
4015 }
4016
4017 /* The callback functions retrieve various bits of information for the client
4018  * or server in the course of the handshake procedure.
4019  *
4020  * The logic here is based on client-sent information, such as:
4021  *  - TLS hints -- X.509 or alternatives like OpenPGP, SRP, PSK
4022  *  - TLS hints -- Server Name Indication
4023  *  - User hints -- local and remote identities provided
4024  */
4025 static int srv_clienthello (gnutls_session_t session, unsigned int htype, unsigned int post, unsigned int incoming, const gnutls_datum_t *msg) {
4026         struct command *cmd, **pcmd;
4027         int gtls_errno = GNUTLS_E_SUCCESS;
4028         char sni [sizeof (cmd->cmd.pio_data.pioc_starttls.remoteid)]; // static size
4029         size_t snilen = sizeof (sni);
4030         unsigned int snitype;
4031         char *lid;
4032
4033 tlog (LOG_DAEMON, LOG_INFO, "Invoked %sprocessor for Client Hello, htype=%d, incoming=%d\n",
4034                 post ? "post" : "pre",
4035                 htype,
4036                 incoming);
4037
4038 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
4039 errno = 0;
4040 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
4041
4042         //
4043         // Setup a number of common references
4044         pcmd = (struct command **) gnutls_session_get_ptr (session);
4045         if (pcmd == NULL) {
4046                 return GNUTLS_E_INVALID_SESSION;
4047         }
4048         cmd = *pcmd;
4049         tlog (LOG_DAEMON, LOG_DEBUG, "srv_clienthello() retrieved session pointer %p\n", cmd);
4050
4051 if (!post) {
4052
4053         //
4054         // Setup server-specific credentials and priority string
4055         //TODO// get anonpre value here
4056 fprintf (stderr, "DEBUG: Got gtls_errno = %d at %d\n", gtls_errno, __LINE__);
4057 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
4058         E_g2e ("Failed to reconfigure GnuTLS as a server",
4059                 configure_session (cmd,
4060                         session,
4061                         srv_creds, srv_credcount,
4062                         cmd->anonpre & ANONPRE_SERVER));
4063 fprintf (stderr, "DEBUG: Got gtls_errno = %d at %d\n", gtls_errno, __LINE__);
4064 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
4065
4066 } else {
4067
4068         //
4069         // Setup a number of common references
4070         lid = cmd->cmd.pio_data.pioc_starttls.localid;
4071
4072         //
4073         // Setup to ignore/request/require remote identity (from client)
4074 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
4075         if (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_IGNORE_REMOTEID) {
4076                 // Neither Request nor Require remoteid; ignore it
4077                 ;
4078         } else if (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_REQUEST_REMOTEID) {
4079                 // Use Request instead of Require for remoteid
4080                 ( //RETURNS_VOID// E_g2e ("Failed to request remote identity",
4081                         gnutls_certificate_server_set_request (
4082                                 session,
4083                                 GNUTLS_CERT_REQUEST));
4084 fprintf (stderr, "DEBUG: Got gtls_errno = %d at %d\n", gtls_errno, __LINE__);
4085         } else {
4086                 // Require a remoteid from the client (default)
4087                 ( //RETURNS_VOID// E_g2e ("Failed to require remote identity (the default)",
4088                         gnutls_certificate_server_set_request (
4089                                 session,
4090                                 GNUTLS_CERT_REQUIRE));
4091 fprintf (stderr, "DEBUG: Got gtls_errno = %d at %d\n", gtls_errno, __LINE__);
4092         }
4093
4094         //
4095         // Find the client-helloed ServerNameIndication, or the service name
4096 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
4097         sni [0] = '\0';
4098         if (gnutls_server_name_get (session, sni, &snilen, &snitype, 0) == 0) {
4099 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
4100                 switch (snitype) {
4101                 case GNUTLS_NAME_DNS:
4102                         break;
4103                 // Note: In theory, other name types could be sent, and it would
4104                 // be useful to access indexes beyond 0.  In practice, nobody
4105                 // uses other name types than exactly one GNUTLS_NAME_DNS.
4106                 default:
4107                         sni [0] = '\0';
4108                         tlog (TLOG_TLS, LOG_ERR, "Received an unexpected SNI type; that is possible but uncommon; skipping SNI");
4109 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
4110                         break;
4111                 }
4112         }
4113 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
4114         if (sni [0] != '\0') {
4115                 if (*lid != '\0') {
4116                         char *lid_dom;
4117                         lid_dom = strrchr (lid, '@');
4118                         if (lid_dom == NULL) {
4119                                 lid_dom = lid;
4120                         } else {
4121                                 lid_dom++;
4122                         }
4123                         if (strcmp (sni, lid_dom) != 0) {
4124                                 tlog (TLOG_USER | TLOG_TLS, LOG_ERR, "Mismatch between client-sent SNI %s and localid domain %s", sni, lid_dom);
4125                                 E_g2e ("Requested SNI does not match local identity",
4126                                         GNUTLS_E_NO_CERTIFICATE_FOUND);
4127                                 return GNUTLS_E_UNEXPECTED_HANDSHAKE_PACKET;
4128                         }
4129                 } else {
4130                         memcpy (lid, sni, sizeof (sni));
4131                         tlog (TLOG_TLS, LOG_INFO, "Copied SNI %s into local identity", sni);
4132 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
4133                 }
4134         } else {
4135                 memcpy (sni, lid, sizeof (sni)-1);
4136 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
4137                 sni [sizeof (sni) - 1] = '\0';
4138         }
4139 fprintf (stderr, "DEBUG: Got gtls_errno = %d at %d\n", gtls_errno, __LINE__);
4140 }
4141
4142         //
4143         // Lap up any unnoticed POSIX error messages
4144         if (errno != 0) {
4145                 cmd->session_errno = errno;
4146 fprintf (stderr, "DEBUG: Got errno = %d / %s at %d\n", errno, strerror (errno), __LINE__);
4147                 gtls_errno = GNUTLS_E_NO_CIPHER_SUITES; /* Vaguely matching */
4148 fprintf (stderr, "DEBUG: Got gtls_errno = %d at %d\n", gtls_errno, __LINE__);
4149         }
4150
4151         //
4152         // Round off with an overal judgement
4153 fprintf (stderr, "DEBUG: Returning gtls_errno = %d or \"%s\" from srv_clihello()\n", gtls_errno, gnutls_strerror (gtls_errno));
4154         return gtls_errno;
4155 }
4156
4157
4158 int cli_srpcreds_retrieve (gnutls_session_t session,
4159                                 char **username,
4160                                 char **password) {
4161         //TODO:FIXED//
4162         tlog (TLOG_CRYPTO, LOG_DEBUG, "Picking up SRP credentials");
4163         *username = strdup ("tester");
4164         *password = strdup ("test");
4165         return GNUTLS_E_SUCCESS;
4166 }
4167
4168
4169 /* Setup credentials to be shared by all clients and servers.
4170  * Credentials are generally implemented through callback functions.
4171  * This should be called after setting up DH parameters.
4172  */
4173 static int setup_starttls_credentials (void) {
4174         gnutls_anon_server_credentials_t srv_anoncred = NULL;
4175         gnutls_anon_client_credentials_t cli_anoncred = NULL;
4176         gnutls_certificate_credentials_t clisrv_certcred = NULL;
4177         //TODO:NOTHERE// int srpbits;
4178         gnutls_srp_server_credentials_t srv_srpcred = NULL;
4179         gnutls_srp_client_credentials_t cli_srpcred = NULL;
4180         //TODO// gnutls_kdh_server_credentials_t srv_kdhcred = NULL;
4181         //TODO// gnutls_kdh_server_credentials_t cli_kdhcred = NULL;
4182         int gtls_errno = GNUTLS_E_SUCCESS;
4183         int gtls_errno_stack0 = GNUTLS_E_SUCCESS;
4184
4185         //
4186         // Construct anonymous server credentials
4187         E_g2e ("Failed to allocate ANON-DH server credentials",
4188                 gnutls_anon_allocate_server_credentials (
4189                         &srv_anoncred));
4190         if (!have_error_codes ()) /* E_g2e (...) */ gnutls_anon_set_server_dh_params (
4191                 srv_anoncred,
4192                 dh_params);
4193         if (gtls_errno == GNUTLS_E_SUCCESS) {
4194                 tlog (TLOG_CRYPTO, LOG_INFO, "Setting server anonymous credentials");
4195                 srv_creds [srv_credcount].credtp = GNUTLS_CRD_ANON;
4196                 srv_creds [srv_credcount].cred   = (void *) srv_anoncred;
4197                 srv_credcount++;
4198         } else if (srv_anoncred != NULL) {
4199                 gnutls_anon_free_server_credentials (srv_anoncred);
4200                 srv_anoncred = NULL;
4201         }
4202
4203         //
4204         // Construct anonymous client credentials
4205         gtls_errno = gtls_errno_stack0; // Don't pop, just forget last failures
4206         E_g2e ("Failed to allocate ANON-DH client credentials",
4207                 gnutls_anon_allocate_client_credentials (
4208                         &cli_anoncred));
4209 #ifdef MIRROR_IMAGE_OF_SERVER_ANONYMOUS_CREDENTIALS
4210         // NOTE: This is not done under TLS; server always provides DH params
4211         if (!have_error_codes ()) gnutls_anon_set_client_dh_params (
4212                 cli_anoncred,
4213                 dh_params);
4214 #endif
4215         if (gtls_errno == GNUTLS_E_SUCCESS) {
4216                 tlog (TLOG_CRYPTO, LOG_INFO, "Setting client anonymous credentials");
4217                 cli_creds [cli_credcount].credtp = GNUTLS_CRD_ANON;
4218                 cli_creds [cli_credcount].cred   = (void *) cli_anoncred;
4219                 cli_credcount++;
4220         } else if (cli_anoncred != NULL) {
4221                 gnutls_anon_free_client_credentials (cli_anoncred);
4222                 cli_anoncred = NULL;
4223         }
4224
4225         //
4226         // Construct certificate credentials for X.509 and OpenPGP cli/srv
4227         gtls_errno = gtls_errno_stack0; // Don't pop, just forget last failures
4228         E_g2e ("Failed to allocate certificate credentials",
4229                 gnutls_certificate_allocate_credentials (
4230                         &clisrv_certcred));
4231         //TODO// What to do here when we add locking on DH params?
4232         gnutls_certificate_set_dh_params (
4233                 clisrv_certcred,
4234                 dh_params);
4235         gtls_errno_stack0 = gtls_errno;
4236         /* TODO: Bad code.  GnuTLS 3.2.1 ignores retrieve_function2 when
4237          * checking if it can handle the OpenPGP certificate type in
4238          * _gnutls_session_cert_type_supported (gnutls_status.c:175) but
4239          * it does see the "1" version field.  It does not callback the
4240          * "1" version if "2" is present though.
4241          */
4242         if (!have_error_codes ()) /* TODO:GnuTLSversions E_g2e (...) */ gnutls_certificate_set_retrieve_function (
4243                 clisrv_certcred,
4244                 (void *) exit);
4245         if (!have_error_codes ()) /* TODO:GnuTLSversions E_g2e (...) */ gnutls_certificate_set_retrieve_function2 (
4246                 clisrv_certcred,
4247                 clisrv_cert_retrieve);
4248 #ifdef HAVE_TLS_KDH
4249         E_g2e ("Failed to set encoding callback for Kerberos Authenticators",
4250                         gnutls_authenticator_set_encode_function (
4251                                         clisrv_certcred,
4252                                         cli_kdhsig_encode));
4253         E_g2e ("Failed to set decoding callback for Kerberos Authenticators",
4254                         gnutls_authenticator_set_decode_function (
4255                                         clisrv_certcred,
4256                                         srv_kdhsig_decode));
4257 #endif
4258         if (gtls_errno == GNUTLS_E_SUCCESS) {
4259                 // Setup for certificates
4260                 tlog (TLOG_CERT, LOG_INFO, "Setting client and server certificate credentials");
4261                 cli_creds [cli_credcount].credtp = GNUTLS_CRD_CERTIFICATE;
4262                 cli_creds [cli_credcount].cred   = (void *) clisrv_certcred;
4263                 cli_credcount++;
4264                 srv_creds [srv_credcount].credtp = GNUTLS_CRD_CERTIFICATE;
4265                 srv_creds [srv_credcount].cred   = (void *) clisrv_certcred;
4266                 srv_credcount++;
4267         } else if (clisrv_certcred != NULL) {
4268                 gnutls_certificate_free_credentials (clisrv_certcred);
4269                 clisrv_certcred = NULL;
4270         }
4271
4272         //
4273         // Construct server credentials for SRP authentication
4274         gtls_errno = gtls_errno_stack0; // Don't pop, just forget last failures
4275 #ifdef EXPERIMENTAL_SRP
4276         E_g2e ("Failed to allocate SRP server credentials",
4277                 gnutls_srp_allocate_server_credentials (
4278                         &srv_srpcred));
4279         E_g2e ("Failed to set SRP server credentials",
4280                 gnutls_srp_set_server_credentials_file (
4281                         srv_srpcred,
4282                         "../testdata/tlspool-test-srp.passwd",
4283                         "../testdata/tlspool-test-srp.conf"));
4284         if (gtls_errno == GNUTLS_E_SUCCESS) {
4285                 tlog (TLOG_CRYPTO, LOG_INFO, "Setting server SRP credentials");
4286                 srv_creds [srv_credcount].credtp = GNUTLS_CRD_SRP;
4287                 srv_creds [srv_credcount].cred   = (void *) srv_srpcred;
4288                 srv_credcount++;
4289         } else if (srv_srpcred != NULL) {
4290                 gnutls_srp_free_server_credentials (srv_srpcred);
4291                 srv_srpcred = NULL;
4292         }
4293 #endif
4294
4295         //
4296         // Construct client credentials for SRP authentication
4297         gtls_errno = gtls_errno_stack0; // Don't pop, just forget last failures
4298 #ifdef EXPERIMENTAL_SRP
4299         E_g2e ("Failed to allocate SRP client credentials",
4300                 gnutls_srp_allocate_client_credentials (
4301                         &cli_srpcred));
4302         if (!have_error_codes ()) gnutls_srp_set_client_credentials_function (
4303                 cli_srpcred,
4304                 cli_srpcreds_retrieve);
4305         if (gtls_errno == GNUTLS_E_SUCCESS) {
4306                 tlog (TLOG_CRYPTO, LOG_INFO, "Setting client SRP credentials");
4307                 cli_creds [cli_credcount].credtp = GNUTLS_CRD_SRP;
4308                 cli_creds [cli_credcount].cred   = (void *) cli_srpcred;
4309                 cli_credcount++;
4310         } else if (cli_srpcred != NULL) {
4311                 gnutls_srp_free_client_credentials (cli_srpcred);
4312                 cli_srpcred = NULL;
4313         }
4314 #endif
4315
4316         //
4317         // Construct server credentials for KDH authentication
4318         //TODO// gtls_errno = gtls_errno_stack0;        // Don't pop, just forget last failures
4319         //TODO// E_g2e ("Failed to allocate KDH server credentials",
4320         //TODO//        gnutls_kdh_allocate_server_credentials (
4321         //TODO//                &srv_kdhcred));
4322         //TODO// E_g2e ("Failed to set KDH server DH params",
4323         //TODO//        gnutls_kdh_set_server_dh_params (
4324         //TODO//                srv_kdhcred,
4325         //TODO//                dh_params));
4326         //TODO// if (gtls_errno == GNUTLS_E_SUCCESS) {
4327         //TODO//        tlog (TLOG_CRYPTO, LOG_INFO, "Setting server KDH credentials");
4328         //TODO//        srv_creds [srv_credcount].credtp = GNUTLS_CRD_KDH;
4329         //TODO//        srv_creds [srv_credcount].cred   = (void *) srv_kdhcred;
4330         //TODO//        srv_credcount++;
4331         //TODO// } else if (srv_kdhcred != NULL) {
4332         //TODO//        gnutls_kdh_free_server_credentials (srv_kdhcred);
4333         //TODO//        srv_kdhcred = NULL;
4334         //TODO// }
4335
4336         //
4337         // Construct client credentials for KDH
4338         //TODO// gtls_errno = gtls_errno_stack0;        // Don't pop, just forget last failures
4339         //TODO// E_g2e ("Failed to allocate KDH client credentials",
4340         //TODO//        gnutls_kdh_allocate_client_credentials (
4341         //TODO//                &cli_kdhcred));
4342         //TODO// E_g2e ("Failed to set KDH client credentials",
4343         //TODO//        gnutls_kdh_set_client_credentials_function (
4344         //TODO//                cli_kdhcred,
4345         //TODO//                cli_kdh_retrieve));
4346         //TODO// if (gtls_errno == GNUTLS_E_SUCCESS) {
4347         //TODO//        tlog (TLOG_CRYPTO, LOG_INFO, "Setting client KDH credentials");
4348         //TODO//        cli_creds [cli_credcount].credtp = GNUTLS_CRD_KDH;
4349         //TODO//        cli_creds [cli_credcount].cred   = (void *) cli_kdhcred;
4350         //TODO//        cli_credcount++;
4351         //TODO// } else if (cli_kdhcred != NULL) {
4352         //TODO//        gnutls_kdh_free_client_credentials (cli_kdhcred);
4353         //TODO//        cli_kdhcred = NULL;
4354         //TODO// }
4355
4356         //
4357         // Ensure that at least one credential has been set
4358         // TODO: Look at the counters; but at boot, we can require all okay
4359         if ((gtls_errno == GNUTLS_E_SUCCESS) &&
4360                         ( (cli_credcount != EXPECTED_CLI_CREDCOUNT) ||
4361                           (srv_credcount != EXPECTED_SRV_CREDCOUNT) ) ) {
4362                 tlog (TLOG_CRYPTO, LOG_ERR, "Not all credential types could be setup (cli %d/%d, srv %d/%d, gtls_errno %d)", cli_credcount, EXPECTED_CLI_CREDCOUNT, srv_credcount, EXPECTED_SRV_CREDCOUNT, gtls_errno);
4363                 E_g2e ("Not all credentials could be setup",
4364                         GNUTLS_E_INSUFFICIENT_CREDENTIALS);
4365         }
4366
4367         //
4368         // Report overall error or success
4369         return gtls_errno;
4370 }
4371
4372
4373 /* Cleanup all credentials created, just before exiting the daemon.
4374  */
4375 static void cleanup_starttls_credentials (void) {
4376         while (srv_credcount-- > 0) {
4377                 struct credinfo *crd = &srv_creds [srv_credcount];
4378                 switch (crd->credtp) {
4379                 case GNUTLS_CRD_CERTIFICATE:
4380                         // Shared with client; skipped in server and removed in client
4381                         // gnutls_certificate_free_credentials (crd->cred);
4382                         break;
4383                 case GNUTLS_CRD_ANON:
4384                         gnutls_anon_free_server_credentials (crd->cred);
4385                         break;
4386 #ifdef EXPERIMENTAL_SRP
4387                 case GNUTLS_CRD_SRP:
4388                         gnutls_srp_free_server_credentials (crd->cred);
4389                         break;
4390 #endif
4391                 case GNUTLS_CRD_PSK:
4392                 case GNUTLS_CRD_IA:
4393                         //TODO: not handled
4394                         break;
4395                 //TODO// case GNUTLS_CRD_KDH:
4396                 //TODO//        gnutls_kdh_free_server_credentials (crd->cred);
4397                 //TODO//        break;
4398                 }
4399         }
4400         while (cli_credcount-- > 0) {
4401                 struct credinfo *crd = &cli_creds [cli_credcount];
4402                 switch (crd->credtp) {
4403                 case GNUTLS_CRD_CERTIFICATE:
4404                         // Shared with client; skipped in server and removed in client
4405                         gnutls_certificate_free_credentials (crd->cred);
4406                         break;
4407                 case GNUTLS_CRD_ANON:
4408                         gnutls_anon_free_client_credentials (crd->cred);
4409                         break;
4410 #ifdef EXPERIMENTAL_SRP
4411                 case GNUTLS_CRD_SRP:
4412                         gnutls_srp_free_client_credentials (crd->cred);
4413                         break;
4414 #endif
4415                 case GNUTLS_CRD_PSK:
4416                 case GNUTLS_CRD_IA:
4417                         //TODO: not handled
4418                         break;
4419                 //TODO// case GNUTLS_CRD_KDH:
4420                 //TODO//        gnutls_kdh_free_client_credentials (crd->cred);
4421                 //TODO//        break;
4422                 }
4423         }
4424 }
4425
4426
4427 /*
4428  * The starttls_thread is a main program for the setup of a TLS connection,
4429  * either in client mode or server mode.  Note that the distinction between
4430  * client and server mode is only a TLS concern, but not of interest to the
4431  * application or the records exchanged.
4432  *
4433  * If the STARTTLS operation succeeds, this will be reported back to the
4434  * application, but the TLS pool will continue to be active in a copycat
4435  * procedure: encrypting outgoing traffic and decrypting incoming traffic.
4436  *
4437  * A new handshake may be initiated with a STARTTLS command with the special
4438  * flag PIOF_STARTTLS_RENEGOTIATE and the ctlkey set to a previously setup
4439  * TLS connection.  This command runs in a new thread, that cancels the old
4440  * one (which it can only do while it is waiting in copycat) and then join
4441  * that thread (and its data) with the current one.  This is based on the
4442  * ctlkey, which serves to lookup the old thread's data.  When the
4443  * connection ends for other reasons than a permitted cancel by another
4444  * thread, will the thread cleanup its own resources.  In these situations,
4445  * the new command determines the negotiation parameters, and returns identity
4446  * information.
4447  *
4448  * In addition, the remote side may initiate renegotiation.  This is accepted
4449  * without further ado (although future versions of the TLS Pool may add a
4450  * callback mechanism to get it approved).  The renegotiation now runs under
4451  * the originally supplied negotiation parameters.  In case it needs a new
4452  * local identity, it may also perform callbacks.  Possibly repeating what
4453  * happened before -- but most often, a server will start processing a
4454  * protocol and determine that it requires more for the requested level of
4455  * service, and then renegotiate.  This is common, for example, with HTTPS
4456  * connections that decide they need a client certificate for certain URLs.
4457  * The implementation of this facility is currently as unstructured as the
4458  * facility itself, namely through a goto.  We may come to the conclusion
4459  * that a loop is in fact a warranted alternative, but we're not yet
4460  * convinced that this would match with other "structures" in TLS.
4461  *
4462  * In conclusion, there are three possible ways of running this code:
4463  *  1. For a new connection.  Many variables are not known and build up
4464  *     in the course of running the function.
4465  *  2. After a command requesting renegotiation.  This overtakes the prior
4466  *     connection's thread, and copies its data from the ctlkeynode_tls.
4467  *     The resulting code has a number of variables filled in already at
4468  *     an earlier stage.
4469  *  3. After a remote request for renegotiation.  This loops back to an
4470  *     earlier phase, but after the thread takeover and ctlkeynode_tls copy
4471  *     of the explicit command for renegotation.  Its behaviour is subtly
4472  *     different in that it has no command to act on, and so it cannot
4473  *     send responses or error codes.  It will however log and shutdown
4474  *     as the command-driven options would.  It will not perform callbacks
4475  *     for PIOC_STARTTLS_LOCALID_V2 or PIOC_PLAINTEXT_CONNECT_V2.  It will
4476  *     however trigger the PIOC_LIDENTRY_CALLBACK_V2 through the separate
4477  *     callback command, if one is registered.
4478  * Yeah, it's great fun, coding TLS and keeping it both flexible and secure.
4479  */
4480 static void *starttls_thread (void *cmd_void) {
4481         struct command *cmd, *replycmd;
4482         struct command cmd_copy; // for relooping during renegotiation
4483         struct pioc_starttls orig_starttls;
4484         uint32_t orig_cmdcode;
4485         int plainfd = -1;
4486         int cryptfd = -1;
4487         gnutls_session_t session;
4488         int got_session = 0;
4489         int gtls_errno = GNUTLS_E_SUCCESS;
4490         int i;
4491         struct ctlkeynode_tls *ckn = NULL;
4492         uint32_t tout;
4493         int forked = 0;
4494         int want_remoteid = 1;
4495         int got_remoteid = 0;
4496         int renegotiating = 0;
4497         char *preauth = NULL;
4498         unsigned int preauthlen = 0;
4499         int taking_over = 0;
4500         int my_maxpreauth = 0;
4501         int anonpost = 0;
4502
4503         //
4504         // Block thread cancellation -- and re-enable it in copycat()
4505         assert (pthread_setcancelstate (PTHREAD_CANCEL_DISABLE, NULL) == 0);
4506
4507         //
4508         // General thread setup
4509         replycmd = cmd = (struct command *) cmd_void;
4510         if (cmd == NULL) {
4511                 send_error (replycmd, E_TLSPOOL_COMMAND_NEEDED,
4512                                 "TLS Pool needs a command but got none");
4513                 assert (pthread_detach (pthread_self ()) == 0);
4514                 return NULL;
4515         }
4516         *cmd->valflags = '\0';
4517         cmd->session_errno = 0;
4518         cmd->anonpre = 0;
4519         orig_cmdcode = cmd->cmd.pio_cmd;
4520         memcpy (&orig_starttls, &cmd->cmd.pio_data.pioc_starttls, sizeof (orig_starttls));
4521         cmd->orig_starttls = &orig_starttls;
4522         cryptfd = cmd->passfd;
4523         cmd->passfd = -1;
4524 //TODO:TEST Removed here because it is tested below
4525 /*
4526         if (cryptfd < 0) {
4527                 tlog (TLOG_UNIXSOCK, LOG_ERR, "No ciphertext file descriptor supplied to TLS Pool");
4528                 send_error (replycmd, E_TLSPOOL_CIPHER_SOCKET_NEEDED,
4529                                 "TLS Pool needs a ciphertext socket but got none");
4530                 assert (pthread_detach (pthread_self ()) == 0);
4531                 return NULL;
4532         }
4533 */
4534         cmd->session_certificate = (intptr_t) (void *) NULL;
4535         cmd->session_privatekey  = (intptr_t) (void *) NULL;
4536
4537         //
4538         // In case of renegotiation, lookup the previous ctlkeynode by its
4539         // ctlkey.  The fact that we have ckn != NULL indicates that we are
4540         // renegotiating in the code below; it will supply information as
4541         // we continue to run the TLS process.
4542         if (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_RENEGOTIATE) {
4543 fprintf (stderr, "DEBUG: Got a request to renegotiate existing TLS connection\n");
4544                 //
4545                 // Check that no FD was passed (and ended up in cryptfd)
4546                 if (cryptfd >= 0) {
4547                         tlog (TLOG_UNIXSOCK, LOG_ERR, "Renegotiation started with extraneous file descriptor");
4548                         send_error (replycmd, E_TLSPOOL_SUPERFLUOUS_SOCKET,
4549                                 "TLS Pool received a superfluous socket");
4550                         close (cryptfd);
4551                         assert (pthread_detach (pthread_self ()) == 0);
4552                         return NULL;
4553                 }
4554                 //
4555                 // First find the ctlkeynode_tls
4556                 ckn = (struct ctlkeynode_tls *) ctlkey_find (cmd->cmd.pio_data.pioc_starttls.ctlkey, security_tls, cmd->clientfd);
4557 fprintf (stderr, "DEBUG: Got ckn == %p\n", (void *) ckn);
4558                 if (ckn == NULL) {
4559                         tlog (TLOG_UNIXSOCK, LOG_ERR, "Failed to find TLS connection for renegotiation by its ctlkey");
4560                         send_error (replycmd, E_TLSPOOL_RENOGIATE_NOT_FOUND,
4561                                         "TLS Pool cannot find the connection to renegotiate");
4562                         assert (pthread_detach (pthread_self ()) == 0);
4563                         return NULL;
4564                 }
4565                 //
4566                 // Now cancel the pthread for this process
4567                 errno = pthread_cancel (ckn->owner);
4568 fprintf (stderr, "DEBUG: pthread_cancel returned %d\n", errno);
4569                 if (errno == 0) {
4570                         void *retval;
4571                         errno = pthread_join (ckn->owner, &retval);
4572 fprintf (stderr, "DEBUG: pthread_join returned %d\n", errno);
4573                 }
4574                 if (errno == 0) {
4575                         // We have now synchronised with the cancelled thread
4576                         // Cleanup any _remote data in ckn->session->cmd
4577                         cleanup_any_remote_credentials (
4578                                 * (struct command **) gnutls_session_get_ptr (
4579                                         ckn->session));
4580                 }
4581                 if (errno != 0) {
4582                         tlog (TLOG_UNIXSOCK, LOG_ERR, "Failed to interrupt TLS connection for renegotiation");
4583                         send_error (replycmd, E_TLSPOOL_RENOGIATE_NOT_INTERRUPTABLE,
4584                                         "TLS Pool cannot interrupt the connection to renegotiate");
4585                         ctlkey_unfind (&ckn->regent);
4586                         assert (pthread_detach (pthread_self ()) == 0);
4587                         // Do not free the ckn, as the other thread still runs
4588                         return NULL;
4589                 }
4590                 //
4591                 // We are in control!  Assimilate the TLS connection data.
4592                 renegotiating = 1;
4593                 plainfd = ckn->plainfd;
4594                 cryptfd = ckn->cryptfd;
4595                 session = ckn->session;
4596                 got_session = 1;
4597                 taking_over = 1;
4598                 ctlkey_unfind (&ckn->regent);
4599         }
4600
4601         // Then follows the unstructured entry point for the unstructured
4602         // request to a TLS connection to renegotiate its security parameters.
4603         // Doing this in any other way than with goto would add a lot of
4604         // make-belief structure that only existed to make this looping
4605         // possible.  We'd rather be honest and admit the lack of structure
4606         // that TLS has in this respect.  Maybe we'll capture it one giant loop
4607         // at some point, but for now that does not seem to add any relief.
4608         renegotiate:
4609 fprintf (stderr, "DEBUG: Renegotiating = %d, anonpost = %d, plainfd = %d, cryptfd = %d, flags = 0x%x, session = %p, got_session = %d, lid = \"%s\", rid = \"%s\"\n", renegotiating, anonpost, plainfd, cryptfd, cmd->cmd.pio_data.pioc_starttls.flags, session, got_session, cmd->cmd.pio_data.pioc_starttls.localid, cmd->cmd.pio_data.pioc_starttls.remoteid);
4610
4611         //
4612         // If this is server renegotiating, send a request to that end
4613         //TODO// Only invoke gnutls_rehandshake() on the server
4614         if (renegotiating && (taking_over || anonpost) && (gtls_errno == GNUTLS_E_SUCCESS)) {
4615 fprintf (stderr, "DEBUG: Invoking gnutls_rehandshake in renegotiation loop\n");
4616                 gtls_errno = gnutls_rehandshake (session);
4617                 if (gtls_errno == GNUTLS_E_INVALID_REQUEST) {
4618                         // Clients should not do this; be forgiving
4619                         gtls_errno = GNUTLS_E_SUCCESS;
4620 fprintf (stderr, "DEBUG: Client-side invocation flagged as wrong; compensated error\n");
4621                 }
4622         }
4623
4624         //
4625         // When renegotiating TLS security, ensure that it is done securely
4626         if (renegotiating && (gnutls_safe_renegotiation_status (session) == 0)) {
4627                 send_error (replycmd, E_TLSPOOL_RENOGIATE_WOULD_BE_INSECURE,
4628                         "TLS Pool cannot ask peer for secure renegotiation");
4629                 if (cryptfd >= 0) {
4630                         close (cryptfd);
4631                         cryptfd = -1;
4632                 }
4633                 if (plainfd >= 0) {
4634                         close (plainfd);
4635                         plainfd = -1;
4636                 }
4637                 if (ckn != NULL) {
4638                         if (ctlkey_unregister (ckn->regent.ctlkey)) {
4639                                 free (ckn);
4640                                 ckn = NULL;
4641                         }
4642                 }
4643                 assert (pthread_detach (pthread_self ()) == 0);
4644                 return NULL;
4645         }
4646
4647         //
4648         // Potentially decouple the controlling fd (ctlkey is in orig_starttls)
4649         if (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_FORK) {
4650                 cmd->cmd.pio_data.pioc_starttls.flags &= ~PIOF_STARTTLS_FORK;
4651                 forked = 1;
4652         }
4653
4654         //
4655         // Setup BDB transactions and reset credential datum fields
4656         if (!anonpost) {
4657                 memset (&cmd->lids, 0, sizeof (cmd->lids));
4658                 manage_txn_begin (&cmd->txn);
4659         }
4660
4661         //
4662         // Permit cancellation of this thread -- TODO: Cleanup?
4663 //TODO:TEST// Defer setcancelstate until copycat() activity
4664 /*
4665         errno = pthread_setcancelstate (PTHREAD_CANCEL_ENABLE, NULL);
4666         if (errno != 0) {
4667                 send_error (replycmd, E_TLSPOOL_CONNECTION_HANDLER_SETUP,
4668                                 "TLS Pool failed to setup the connection handler");
4669                 if (cryptfd >= 0) {
4670                         close (cryptfd);
4671                         cryptfd = -1;
4672                 }
4673                 if (plainfd >= 0) {
4674                         close (plainfd);
4675                         plainfd = -1;
4676                 }
4677                 if (ckn != NULL) {
4678                         if (ctlkey_unregister (ckn->regent.ctlkey)) {
4679                                 free (ckn);
4680                                 ckn = NULL;
4681                         }
4682                 }
4683                 manage_txn_rollback (&cmd->txn);
4684                 assert (pthread_detach (pthread_self ()) == 0);
4685                 return NULL;
4686         }
4687 */
4688         //
4689         // Check and setup the plaintext file handle
4690         if (cryptfd < 0) {
4691                 send_error (replycmd, E_TLSPOOL_CIPHER_SOCKET_NEEDED,
4692                                 "TLS Pool needs a ciphertext socket but got none");
4693                 if (plainfd >= 0) {
4694                         close (plainfd);
4695                         plainfd = -1;
4696                 }
4697 fprintf (stderr, "ctlkey_unregister under ckn=%p at %d\n", (void *)ckn, __LINE__);
4698                 if (ckn != NULL) {      /* TODO: CHECK NEEDED? */
4699                         if (ctlkey_unregister (ckn->regent.ctlkey)) {
4700                                 free (ckn);
4701                                 ckn = NULL;
4702                         }
4703                 }
4704                 manage_txn_rollback (&cmd->txn);
4705                 assert (pthread_detach (pthread_self ()) == 0);
4706                 return NULL;
4707         }
4708
4709         //
4710         // Decide on support for the Anonymous Precursor, based on the
4711         // service name and its appearance in the anonpre_registry.
4712         // If the remoteid is not interesting to the client then also
4713         // support an Anonymous Precursor; we have nothing to loose.
4714         cmd->anonpre &= ~ANONPRE_EITHER;
4715         if (renegotiating) {
4716                 ; // Indeed, during renegotiation we always disable ANON-DH
4717         } else if (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_IGNORE_REMOTEID) {
4718                 cmd->anonpre = ANONPRE_EITHER;
4719                 want_remoteid = 0;
4720         } else {
4721                 int anonpre_regidx =  anonpre_registry_size      >> 1;
4722                 int anonpre_regjmp = (anonpre_registry_size + 1) >> 1;
4723                 int cmp;
4724                 while (anonpre_regjmp > 0) {
4725                         anonpre_regjmp = anonpre_regjmp >> 1;
4726                         cmp = strncasecmp (anonpre_registry [anonpre_regidx].service,
4727                                 (const char *)cmd->cmd.pio_data.pioc_starttls.service,
4728                                 TLSPOOL_SERVICELEN);
4729 fprintf (stderr, "DEBUG: anonpre_determination, comparing [%d] %s to %s, found cmp==%d\n", anonpre_regidx, anonpre_registry [anonpre_regidx].service, cmd->cmd.pio_data.pioc_starttls.service, cmp);
4730                         if (cmp == 0) {
4731                                 // anonpre_regent matches
4732                                 cmd->anonpre = anonpre_registry [anonpre_regidx].flags;
4733                                 break;
4734                         } else if (cmp > 0) {
4735                                 // anonpre_regent too high
4736                                 anonpre_regidx -= 1 + anonpre_regjmp;
4737                                 if (anonpre_regidx < 0) {
4738                                         anonpre_regidx = 0;
4739                                 }
4740                         } else {
4741                                 // anonpre_regent too low
4742                                 anonpre_regidx += 1 + anonpre_regjmp;
4743                                 if (anonpre_regidx >= anonpre_registry_size) {
4744                                         anonpre_regidx = anonpre_registry_size - 1;
4745                                 }
4746                         }
4747                 }
4748         }
4749
4750         //
4751         // Setup flags for client and/or server roles (make sure there is one)
4752         if ((!renegotiating) && ((cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_REMOTEROLE_CLIENT) == 0)) {
4753                 cmd->cmd.pio_data.pioc_starttls.flags &= ~PIOF_STARTTLS_LOCALROLE_SERVER;
4754         }
4755         if ((!renegotiating) && ((cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_REMOTEROLE_SERVER) == 0)) {
4756                 cmd->cmd.pio_data.pioc_starttls.flags &= ~PIOF_STARTTLS_LOCALROLE_CLIENT;
4757         }
4758         if ((cmd->cmd.pio_data.pioc_starttls.flags & (PIOF_STARTTLS_LOCALROLE_CLIENT | PIOF_STARTTLS_LOCALROLE_SERVER)) == 0) {
4759                 //
4760                 // Neither a TLS client nor a TLS server
4761                 //
4762                 send_error (replycmd, E_TLSPOOL_COMMAND_NOTIMPL,
4763                                 "TLS Pool command or variety not implemented");
4764                 close (cryptfd);
4765                 if (plainfd >= 0) {
4766                         close (plainfd);
4767                         plainfd = -1;
4768                 }
4769 fprintf (stderr, "ctlkey_unregister under ckn=%p at %d\n", (void *)ckn, __LINE__);
4770                 if (ckn != NULL) { /* TODO: CHECK NEEDED? */
4771                         if (ctlkey_unregister (ckn->regent.ctlkey)) {
4772                                 free (ckn);
4773                                 ckn = NULL;
4774                         }
4775                 }
4776                 manage_txn_rollback (&cmd->txn);
4777                 assert (pthread_detach (pthread_self ()) == 0);
4778                 return NULL;
4779         }
4780
4781         //
4782         // Setup the TLS session.  Also see doc/p2p-tls.*
4783         //
4784         // TODO: GnuTLS cannot yet setup p2p connections
4785         if (ckn != NULL) {
4786                 gnutls_session_set_ptr (
4787                         session,
4788                         &cmd);
4789                 tlog (LOG_DAEMON, LOG_DEBUG, "posted session pointer %p\n", cmd);
4790                 //TODO:DONE?// Clear various settings... creds, flags, modes? CLI/SRV?
4791         } else {
4792                 E_g2e ("Failed to initialise GnuTLS peer session",
4793                         gnutls_init (
4794                                 &session,
4795                                 (((cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALROLE_CLIENT)? GNUTLS_CLIENT: 0) |
4796                                  ((cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALROLE_SERVER)? GNUTLS_SERVER: 0))
4797                                 ));
4798                 if (gtls_errno == GNUTLS_E_SUCCESS) {
4799                         got_session = 1;
4800                         gnutls_session_set_ptr (
4801                                 session,
4802                                 &cmd);
4803                         tlog (LOG_DAEMON, LOG_DEBUG, "posted session pointer %p\n", cmd);
4804                 }
4805         }
4806         cmd->session = session;
4807         //
4808         // Setup client-specific behaviour if needed
4809         if (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALROLE_CLIENT) {
4810 if (!renegotiating) {   //TODO:TEST//
4811                 //
4812                 // Setup as a TLS client
4813                 //
4814                 int srpbits;
4815                 //
4816                 // Require a minimum security level for SRP
4817                 srpbits = 3072;
4818                 //TODO:CRASH// if (gtls_errno == GNUTLS_E_SUCCESS) gnutls_srp_set_prime_bits (
4819                         //TODO:CRASH// session,
4820                         //TODO:CRASH// srpbits);
4821                 //
4822                 // Setup as a TLS client
4823                 //
4824                 // Setup for potential sending of SNI
4825                 if ((cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_WITHOUT_SNI) == 0) {
4826                         char *str = cmd->cmd.pio_data.pioc_starttls.remoteid;
4827                         int ofs = 0;
4828                         int len = 0;
4829                         while (str [len] && (len < 128)) {
4830                                 if (str [len] == '@') {
4831                                         ofs = len + 1;
4832                                 }
4833                                 len++;
4834                         }
4835                         // If no usable remoteid was setup, ignore it
4836                         if ((len > ofs) && (len < 128)) {
4837                                 cmd->cmd.pio_data.pioc_starttls.remoteid [sizeof (cmd->cmd.pio_data.pioc_starttls.remoteid)-1] = '\0';
4838                                 tlog (TLOG_TLS, LOG_DEBUG, "Sending ServerNameIndication \"%.*s\"", len - ofs, str + ofs);
4839                                 E_g2e ("Client failed to setup SNI",
4840                                         gnutls_server_name_set (
4841                                                 session,
4842                                                 GNUTLS_NAME_DNS,
4843                                                 str + ofs,
4844                                                 len - ofs));
4845                         }
4846                 }
4847 } //TODO:TEST//
4848                 //
4849                 // Setup for client credential installation in this session
4850                 //
4851                 // Setup client-specific credentials and priority string
4852 fprintf (stderr, "DEBUG: Configuring client credentials\n");
4853                 E_g2e ("Failed to configure GnuTLS as a client",
4854                         configure_session (cmd,
4855                                 session,
4856                                 anonpost? NULL: cli_creds,
4857                                 anonpost?    0: cli_credcount,
4858                                 cmd->anonpre & ANONPRE_CLIENT));
4859         }
4860         //
4861         // Setup callback to server-specific behaviour if needed
4862         if (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALROLE_SERVER) {
4863 fprintf (stderr, "DEBUG: Configuring for server credentials callback if %d==0\n", gtls_errno);
4864 if (!renegotiating) {   //TODO:TEST//
4865                 if (gtls_errno == GNUTLS_E_SUCCESS) {
4866                         gnutls_handshake_set_hook_function (
4867                                 session,
4868                                 GNUTLS_HANDSHAKE_CLIENT_HELLO,
4869                                 GNUTLS_HOOK_BOTH,
4870                                 srv_clienthello);
4871                 }
4872 } //TODO:TEST//
4873                 //TODO:TEST// configure_session _if_ not setup as a client (too)
4874                 //
4875                 // Setup for server credential installation in this session
4876                 //
4877                 // Setup server-specific credentials and priority string
4878 #if 0
4879                 if (! (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALROLE_CLIENT)) {
4880 fprintf (stderr, "DEBUG: Configuring server credentials (because it is not a client)\n");
4881                         E_g2e ("Failed to configure GnuTLS as a server",
4882                                 configure_session (cmd,
4883                                         session,
4884                                         anonpost? NULL: srv_creds,
4885                                         anonpost?    0: srv_credcount,
4886                                         cmd->anonpre & ANONPRE_SERVER));
4887                 }
4888 #endif
4889         }
4890
4891         //
4892         // Prefetch local identities that might be used in this session
4893         // Skip this for situations where it is done in clisrv_cert_retrieve()
4894         if ((cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALID_CHECK) == 0) {
4895                 if (!anonpost) {
4896                         E_g2e ("Failed to fetch local credentials",
4897                                 fetch_local_credentials (cmd));
4898                 }
4899         }
4900
4901         //
4902         // Setup a temporary priority string so handshaking can start
4903         if ((cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_LOCALROLE_CLIENT) == 0) {
4904                 E_g2e ("Failed to preconfigure server token priority string",
4905                                 gnutls_priority_set (
4906                                         session,
4907                                         priority_normal));
4908         }
4909
4910         //
4911         // Check if past code stored an error code through POSIX
4912         if (cmd->session_errno) {
4913                 gtls_errno = GNUTLS_E_USER_ERROR;
4914         }
4915
4916         //
4917         // Setup a timeout value as specified in the command, where TLS Pool
4918         // defines 0 as default and ~0 as infinite (GnuTLS has 0 as infinite).
4919         tout = cmd->cmd.pio_data.pioc_starttls.timeout;
4920 if (renegotiating) {
4921 ; // Do not set timeout
4922 } else
4923         if (tout == TLSPOOL_TIMEOUT_DEFAULT) {
4924                 gnutls_handshake_set_timeout (session, GNUTLS_DEFAULT_HANDSHAKE_TIMEOUT);
4925         } else if (tout == TLSPOOL_TIMEOUT_INFINITE) {
4926                 gnutls_handshake_set_timeout (session, 0);
4927         } else {
4928                 gnutls_handshake_set_timeout (session, tout);
4929         }
4930
4931         //
4932         // Now setup for the GnuTLS handshake
4933         //
4934 if (renegotiating) {
4935 ; // Do not setup cryptfd
4936 } else
4937         if (gtls_errno == GNUTLS_E_SUCCESS) {
4938                 gnutls_transport_set_int (session, cryptfd);
4939         }
4940         if (gtls_errno != GNUTLS_E_SUCCESS) {
4941                 tlog (TLOG_TLS, LOG_ERR, "Failed to prepare for TLS: %s", gnutls_strerror (gtls_errno));
4942                 if (cmd->session_errno) {
4943                         send_error (replycmd, cmd->session_errno, error_getstring ());
4944                 } else {
4945                         send_error (replycmd, E_TLSPOOL_CONNECTION_DRIVER_SETUP,
4946                                         "TLS Pool failed to setup the TLS driver");
4947                 }
4948                 if (got_session) {
4949 fprintf (stderr, "gnutls_deinit (%p) at %d\n", (void *)session, __LINE__);
4950                         gnutls_deinit (session);
4951                         got_session = 0;
4952                 }
4953                 close (cryptfd);
4954                 if (plainfd >= 0) {
4955                         close (plainfd);
4956                         plainfd = -1;
4957                 }
4958 fprintf (stderr, "ctlkey_unregister under ckn=%p at %d\n", (void *)ckn, __LINE__);
4959                 if (ckn != NULL) {      /* TODO: CHECK NEEDED? */
4960                         if (ctlkey_unregister (ckn->regent.ctlkey)) {
4961                                 free (ckn);
4962                                 ckn = NULL;
4963                         }
4964                 }
4965                 manage_txn_rollback (&cmd->txn);
4966                 assert (pthread_detach (pthread_self ()) == 0);
4967                 return NULL;
4968         }
4969         tlog (TLOG_UNIXSOCK | TLOG_TLS, LOG_DEBUG, "TLS handshake started over %d", cryptfd);
4970         do {
4971                 //
4972                 // Take a rehandshaking step forward.
4973                 //
4974                 gtls_errno = gnutls_handshake (session);
4975                 //
4976                 // When data is sent before completing
4977                 // the rehandshake, then it's something
4978                 // harmless, given the criteria for the
4979                 // anonpre_registry.  We pass it on and
4980                 // don't worry about it.  We do report
4981                 // it though!
4982                 //
4983                 // Note: Applications should be willing
4984                 // to buffer or process such early data
4985                 // before the handshake is over or else
4986                 // the handshake will bail out in error.
4987                 //
4988                 if (gtls_errno == GNUTLS_E_GOT_APPLICATION_DATA) {
4989                         if (my_maxpreauth <= 0) {
4990                                 tlog (TLOG_COPYCAT, LOG_ERR, "Received unwanted early data before authentication is complete");
4991                                 break; // Terminate the handshake
4992                         } else if (preauth == NULL) {
4993                                 preauth = malloc (my_maxpreauth);
4994                                 if (preauth == NULL) {
4995                                         gtls_errno = GNUTLS_E_MEMORY_ERROR;
4996                                         break; // Terminate the handshake
4997                                 }
4998                         }
4999                 }
5000                 if (gtls_errno == GNUTLS_E_GOT_APPLICATION_DATA) {
5001                         if (preauthlen >= my_maxpreauth) {
5002                                 tlog (TLOG_COPYCAT, LOG_ERR, "Received more early data than willing to receive (%d bytes)", my_maxpreauth);
5003                                 break; // Terminate the handshake
5004                         }
5005                 }
5006                 if (gtls_errno == GNUTLS_E_GOT_APPLICATION_DATA) {
5007                         ssize_t sz;
5008                         sz = gnutls_record_recv (session, preauth + preauthlen, my_maxpreauth - preauthlen);
5009                         tlog (TLOG_COPYCAT, LOG_DEBUG, "Received %d remote bytes (or error if <0) from %d during anonymous precursor\n", (int) sz, cryptfd);
5010                         if (sz > 0) {
5011                                 preauthlen += sz;
5012                                 gtls_errno = GNUTLS_E_SUCCESS;
5013                         } else {
5014                                 gtls_errno = sz; // It's actually an error code
5015                         }
5016                 }
5017         } while ((gtls_errno < 0) &&
5018                 //DROPPED// (gtls_errno != GNUTLS_E_GOT_APPLICATION_DATA) &&
5019                 //DROPPED// (gtls_errno != GNUTLS_E_WARNING_ALERT_RECEIVED) &&
5020                 (gnutls_error_is_fatal (gtls_errno) == 0));
5021         //
5022         // Handshake done -- initialise replycmd, remote_xxx, vfystatus, got_remoteid
5023         if (replycmd != NULL) {
5024                 replycmd = cmd;
5025         }
5026         if ((gtls_errno == 0) && !(cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_IGNORE_REMOTEID)) {
5027                 // We want to try to authenticate the peer
5028                 E_g2e ("Failed to retrieve peer credentials",
5029                                 fetch_remote_credentials (cmd));
5030                 if (gtls_errno == GNUTLS_E_AUTH_ERROR) {
5031                         if (cmd->cmd.pio_data.pioc_starttls.flags & PIOF_STARTTLS_REQUEST_REMOTEID) {
5032                                 // We do not _require_ authentication of the peer
5033                                 gtls_errno = 0;
5034                         }
5035                 }
5036         }
5037         if (gtls_errno == 0) {
5038                 const gnutls_datum_t *certs;
5039                 unsigned int num_certs;
5040                 got_remoteid = 0;
5041                 switch (cmd->remote_auth_type) { // Peer's cred type
5042                 case GNUTLS_CRD_CERTIFICATE:
5043                         if (cmd->remote_cert_count >= 1) {
5044                                 got_remoteid = 1;
5045                         }
5046 #ifdef PHASED_OUT_DIRECT_VALIDATION
5047                         E_g2e ("Failed to validate peer",
5048                                 gnutls_certificate_verify_peers2 (
5049                                         session,
5050                                         &cmd->vfystatus));
5051 #endif
5052                         cmd->vfystatus = 0;
5053                         break;
5054                 case GNUTLS_CRD_PSK:
5055                         // Difficult... what did the history say about this?
5056                         got_remoteid = 0;
5057                         cmd->vfystatus = GNUTLS_CERT_SIGNER_NOT_FOUND;
5058                         break;
5059 #ifdef EXPERIMENTAL_SRP
5060                 case GNUTLS_CRD_SRP:
5061                         // Got a credential, validation follows later on
5062                         //TODO// SRP does not really auth the server
5063                         got_remoteid = 1;
5064                         cmd->vfystatus = GNUTLS_CERT_SIGNER_NOT_FOUND;
5065                         break;
5066 #endif
5067                 case GNUTLS_CRD_ANON:
5068                         // Did not get a credential, perhaps due to anonpre
5069                         got_remoteid = 0;
5070                         cmd->vfystatus = GNUTLS_CERT_INVALID | GNUTLS_CERT_SIGNER_NOT_FOUND | GNUTLS_CERT_SIGNATURE_FAILURE;
5071                         break;
5072                 case GNUTLS_CRD_IA:
5073                         // Inner Application extension is no true credential
5074                         // Should we compare the client-requested service?
5075                         // Should we renegotiate into the ALPN protocol?
5076                         got_remoteid = 0;
5077                         cmd->vfystatus = GNUTLS_CERT_INVALID | GNUTLS_CERT_SIGNER_NOT_FOUND | GNUTLS_CERT_SIGNATURE_FAILURE;
5078                         break;
5079                 default:
5080                         // Unknown creds cautiously considered unauthentitcated
5081                         got_remoteid = 0;
5082                         cmd->vfystatus = ~ (unsigned short) 0;  // It's all bad
5083                         break;
5084                 }
5085                 //
5086                 // Now recognise and handle the Anonymous Precursor
5087                 if (((cmd->anonpre & ANONPRE_EITHER) != 0)
5088                                         && want_remoteid && !got_remoteid) {
5089                         assert (anonpost == 0);
5090                         valexp_valflag_set (cmd, 'A');
5091                         // Disable ANON-protocols but keep creds from before
5092                         //TODO:ELSEWHERE// tlog (TLOG_TLS, LOG_DEBUG, "Reconfiguring TLS over %d without Anonymous Precursor\n", cryptfd);
5093                         //TODO:ELSEWHERE// E_g2e ("Failed to reconfigure GnuTLS without anonymous precursor",
5094                                 //TODO:ELSEWHERE// configure_session (cmd,
5095                                         //TODO:ELSEWHERE// session,
5096                                         //TODO:ELSEWHERE// NULL, 0,
5097                                         //TODO:ELSEWHERE// 0));
5098                         // We do not want to use ANON-DH if the flag
5099                         // ANONPRE_EXTEND_MASTER_SECRET is set for the protocol
5100                         // but the remote peer does not support it.  Only if
5101                         // this problem cannot possibly occur, permit
5102                         // my_maxpreauth > 0 for early data acceptance.
5103                         my_maxpreauth = 0;
5104                         if (cmd->anonpre & ANONPRE_EXTEND_MASTER_SECRET) {
5105 #if GNUTLS_VERSION_NUMBER >= 0x030400
5106                                 gnutls_ext_priv_data_t ext;
5107                                 if (!gnutls_ext_get_data (session, 23, &ext)) {
5108                                         my_maxpreauth = maxpreauth;
5109                                 }
5110 #endif
5111                         } else {
5112                                 my_maxpreauth = maxpreauth;
5113                         }
5114                         if (gtls_errno == 0) {
5115                                 tlog (TLOG_UNIXSOCK | TLOG_TLS, LOG_DEBUG, "TLS handshake continued over %d after anonymous precursor", cryptfd);
5116                                 renegotiating = 1; // (de)selects steps
5117                                 anonpost = 1;      // (de)selects steps
5118                                 goto renegotiate;
5119                         }
5120                 }
5121         }
5122         if ((gtls_errno == GNUTLS_E_SUCCESS) && cmd->session_errno) {
5123                 gtls_errno = GNUTLS_E_USER_ERROR;
5124         }
5125         taking_over = 0;
5126
5127         //
5128         // Run the validation expression logic, using expressions we ran into
5129 fprintf (stderr, "DEBUG: Prior to valexp, gtls_errno = %d\n", gtls_errno);
5130         if (gtls_errno == GNUTLS_E_SUCCESS) {
5131                 struct valexp *verun = NULL;
5132                 char *valexp_conj [3];
5133                 int valexp_conj_count = 0;
5134                 // Setup for validation expression runthrough
5135                 cmd->valexp_result = -1;
5136                 if ((cmd->trust_valexp != NULL) && (0 != strcmp (cmd->trust_valexp, "1"))) {
5137 fprintf (stderr, "DEBUG: Trust valexp \"%s\" @ %p\n", cmd->trust_valexp, (void *) cmd->trust_valexp);
5138                         valexp_conj [valexp_conj_count++] = cmd->trust_valexp;
5139                 }
5140                 if (cmd->lids [LID_TYPE_VALEXP - LID_TYPE_MIN].data != NULL) {
5141                         // Interpret the entry, abuse p11uri as valexp
5142                         int ok;
5143                         uint32_t flags;
5144                         char *lid_valexp;
5145                         gnutls_datum_t ignored;
5146                         ok = dbcred_interpret (
5147                                 &cmd->lids [LID_TYPE_VALEXP - LID_TYPE_MIN],
5148                                 &flags,
5149                                 &lid_valexp,
5150                                 &ignored.data,
5151                                 &ignored.size);
5152 fprintf (stderr, "DEBUG: LocalID valexp \"%s\" @ %p (ok=%d)\n", lid_valexp, (void *) lid_valexp, ok);
5153                         if (ok && (lid_valexp != NULL)) {
5154                                 valexp_conj [valexp_conj_count++] = lid_valexp;
5155                         } else {
5156                                 gtls_errno = GNUTLS_E_AUTH_ERROR;
5157                         }
5158                 }
5159 fprintf (stderr, "DEBUG: Number of valexp is %d, gtls_errno=%d\n", valexp_conj_count, gtls_errno);
5160                 // Optionally start computing the validation expression
5161                 if ((gtls_errno == GNUTLS_E_SUCCESS) && (valexp_conj_count > 0)) {
5162                         valexp_conj [valexp_conj_count] = NULL;
5163                         verun = valexp_register (
5164                                 valexp_conj,
5165                                 have_starttls_validation (),
5166                                 (void *) cmd);
5167 fprintf (stderr, "DEBUG: Registered to verun = %p\n", (void *) verun);
5168                         if (verun == NULL) {
5169                                 gtls_errno = GNUTLS_E_AUTH_ERROR;
5170                         }
5171                 }
5172                 // When setup, run the validation expressions to completion
5173                 if (verun != NULL) {
5174                         while (cmd->valexp_result == -1) {
5175                                 ; //TODO: Tickle async predicate run completion
5176                         }
5177 fprintf (stderr, "DEBUG: Finishing tickling \"async\" predicates for valexp\n");
5178                         if (cmd->valexp_result != 1) {
5179                                 tlog (TLOG_TLS, LOG_INFO, "TLS validation expression result is %d", cmd->valexp_result);
5180                                 gtls_errno = GNUTLS_E_AUTH_ERROR;
5181 fprintf (stderr, "DEBUG: valexp returns NEGATIVE result\n");
5182                         }
5183 else fprintf (stderr, "DEBUG: valexp returns POSITIVE result\n");
5184                         valexp_unregister (verun);
5185 fprintf (stderr, "DEBUG: Unregistered verun %p\n", (void *) verun);
5186                 }
5187         }
5188
5189         //
5190         // Cleanup any prefetched identities
5191         for (i=LID_TYPE_MIN; i<=LID_TYPE_MAX; i++) {
5192                 if (cmd->lids [i - LID_TYPE_MIN].data != NULL) {
5193 fprintf (stderr, "DEBUG: Freeing cmd->lids[%d].data %p\n", i-LID_TYPE_MIN, (void *)(cmd->lids [i-LID_TYPE_MIN].data));
5194                         free (cmd->lids [i - LID_TYPE_MIN].data);
5195                 }
5196         }
5197         memset (cmd->lids, 0, sizeof (cmd->lids));
5198         //
5199         // Cleanup any trust_valexp duplicate string
5200         if (cmd->trust_valexp != NULL) {
5201                 free (cmd->trust_valexp);
5202                 cmd->trust_valexp = NULL;
5203         }
5204 #ifdef HAVE_TLS_KDH
5205         //
5206         // Cleanup any Kerberos session key -- it served its purpose
5207         if (cmd->krb_key.contents != NULL) {
5208                 // RATHER BLUNT: It shouldn't matter which krbctx_ is used...
5209                 krb5_free_keyblock_contents (krbctx_srv, &cmd->krb_key);
5210                 memset (&cmd->krb_key, 0, sizeof (cmd->krb_key));
5211         }
5212         if (cmd->krbid_srv != NULL) {
5213                 // RATHER BLUNT: It shouldn't matter which krbctx_ is used...
5214                 krb5_free_principal (krbctx_srv, cmd->krbid_srv);
5215                 cmd->krbid_srv = NULL;
5216         }
5217         if (cmd->krbid_cli != NULL) {
5218                 // RATHER BLUNT: It shouldn't matter which krbctx_ is used...
5219                 krb5_free_principal (krbctx_srv, cmd->krbid_cli);
5220                 cmd->krbid_cli = NULL;
5221         }
5222 #endif
5223
5224 #if 0
5225 /* This is not proper.  gnutls_certificate_set_key() suggests that these are
5226  * automatically cleaned up, and although this is not repeated in
5227  * gnutls_certificate_set_retrieve_function2() it is likely to be related.
5228  * Plus, renegotiation with this code in place bogged down on failed pcerts;
5229  * they were detected in _gnutls_selected_cert_supported_kx() but their
5230  * key exchange algorithm was never found.
5231  */
5232         if (NULL != (void *) cmd->session_privatekey) {
5233                 gnutls_privkey_deinit ((void *) cmd->session_privatekey);
5234                 cmd->session_privatekey = (intptr_t) (void *) NULL;
5235         }
5236         if (NULL != (void *) cmd->session_certificate) {
5237                 gnutls_pcert_deinit ((void *) cmd->session_certificate);
5238                 free ((void *) cmd->session_certificate);
5239                 cmd->session_certificate = (intptr_t) (void *) NULL;
5240         }
5241 #endif
5242
5243         //
5244         // From here, assume nothing about the cmd->cmd structure; as part of
5245         // the handshake, it may have passed through the client's control, as
5246         // part of a callback.  So, reinitialise the entire return structure.
5247         //TODO// Or backup the (struct pioc_starttls) before handshaking
5248         cmd->cmd.pio_cmd = orig_cmdcode;
5249         cmd->cmd.pio_data.pioc_starttls.localid  [0] =
5250         cmd->cmd.pio_data.pioc_starttls.remoteid [0] = '\0';
5251
5252         //
5253         // Respond to positive or negative outcome of the handshake
5254         if (gtls_errno != GNUTLS_E_SUCCESS) {
5255                 tlog (TLOG_TLS, LOG_ERR, "TLS handshake failed: %s", gnutls_strerror (gtls_errno));
5256                 if (cmd->session_errno) {
5257                         char *errstr;
5258                         tlog (TLOG_TLS, LOG_ERR, "Underlying cause may be: %s", strerror (cmd->session_errno));
5259                         errstr = error_getstring ();
5260                         if (errstr == NULL) {
5261                                 errstr = "TLS handshake failed";
5262                         }
5263                         send_error (replycmd, cmd->session_errno, errstr);
5264                 } else {
5265                         send_error (replycmd, E_TLSPOOL_STIRRED_NOT_SHAKEN,
5266                                         "TLS Pool and peer failed during the TLS handshake");
5267                 }
5268                 if (preauth) {
5269                         free (preauth);
5270                 }
5271                 if (got_session) {
5272 fprintf (stderr, "gnutls_deinit (%p) at %d\n", (void *)session, __LINE__);
5273                         gnutls_deinit (session);
5274                         got_session = 0;
5275                 }
5276                 close (cryptfd);
5277                 if (plainfd >= 0) {
5278                         close (plainfd);
5279                         plainfd = -1;
5280                 }
5281 fprintf (stderr, "ctlkey_unregister under ckn=%p at %d\n", (void *)ckn, __LINE__);
5282                 if (ckn != NULL) {      /* TODO: CHECK NEEDED? */
5283                         if (ctlkey_unregister (ckn->regent.ctlkey)) {
5284                                 free (ckn);
5285                                 ckn = NULL;
5286                         }
5287                 }
5288                 manage_txn_rollback (&cmd->txn);
5289                 assert (pthread_detach (pthread_self ()) == 0);
5290                 return NULL;
5291         } else {
5292                 tlog (TLOG_UNIXSOCK | TLOG_TLS, LOG_INFO, "TLS handshake succeeded over %d", cryptfd);
5293                 //TODO// extract_authenticated_remote_identity (cmd);
5294         }
5295
5296         //
5297         // Request the plaintext file descriptor with a callback (or dig up from clisrv_ handshake)
5298         if (cmd->passfd >= 0) {
5299                 if (plainfd >= 0) {
5300                         tlog (TLOG_UNIXSOCK | TLOG_USER, LOG_ERR, "Doubly supplied plainfd, closing the second one supplied %d\n", cmd->passfd);
5301                         close (cmd->passfd);
5302                 } else {
5303                         plainfd = cmd->passfd;
5304                 }
5305                 cmd->passfd = -1;
5306         }
5307         if (plainfd < 0) {
5308                 //TODO// Up to the commit blamed for this line, we silently dropped cmd and had a resp instead
5309                 uint32_t oldcmd = cmd->cmd.pio_cmd;
5310                 cmd->cmd.pio_cmd = PIOC_PLAINTEXT_CONNECT_V2;
5311                 tlog (TLOG_UNIXSOCK, LOG_DEBUG, "Calling send_callback_and_await_response with PIOC_PLAINTEXT_CONNECT_V2");
5312                 cmd = send_callback_and_await_response (replycmd, 0);
5313                 if (replycmd != NULL) {
5314                         replycmd = cmd;
5315                 }
5316                 assert (cmd != NULL);   // No timeout given, so the result should never be NULL
5317                 if (cmd->cmd.pio_cmd != PIOC_PLAINTEXT_CONNECT_V2) {
5318                         tlog (TLOG_UNIXSOCK, LOG_ERR, "Callback response has unexpected command code");
5319                         send_error (replycmd, E_TLSPOOL_COMMAND_BAD_CALLBACK_RESPONSE,
5320                                         "TLS Pool command code unacceptable as callback response");
5321                         if (preauth) {
5322                                 free (preauth);
5323                         }
5324                         if (got_session) {
5325 fprintf (stderr, "gnutls_deinit (%p) at %d\n", (void *)session, __LINE__);
5326                                 gnutls_deinit (session);
5327                                 got_session = 0;
5328                         }
5329                         close (cryptfd);
5330 fprintf (stderr, "ctlkey_unregister under ckn=%p at %d\n", (void *)ckn, __LINE__);
5331                         if (ckn) {      /* TODO: CHECK NEEDED? PRACTICE=>YES */
5332                                 if (ctlkey_unregister (ckn->regent.ctlkey)) {
5333                                         free (ckn);
5334                                         ckn = NULL;
5335                                 }
5336                         }
5337                         manage_txn_rollback (&cmd->txn);
5338                         assert (pthread_detach (pthread_self ()) == 0);
5339                         return NULL;
5340                 }
5341                 cmd->cmd.pio_cmd = oldcmd;
5342                 tlog (TLOG_UNIXSOCK, LOG_DEBUG, "Processing callback response that set plainfd:=%d for lid==\"%s\" and rid==\"%s\"", cmd->passfd, cmd->cmd.pio_data.pioc_starttls.localid, cmd->cmd.pio_data.pioc_starttls.remoteid);
5343                 plainfd = cmd->passfd;
5344         }
5345         if (plainfd < 0) {
5346                 tlog (TLOG_UNIXSOCK, LOG_ERR, "No plaintext file descriptor supplied to TLS Pool");
5347                 send_error (replycmd, E_TLSPOOL_PLAIN_SOCKET_NEEDED,
5348                                         "TLS Pool needs a plaintext socket but got none");
5349                 if (preauth) {
5350                         free (preauth);
5351                 }
5352                 if (got_session) {
5353 fprintf (stderr, "gnutls_deinit (%p) at %d\n", (void *)session, __LINE__);
5354                         gnutls_deinit (session);
5355                         got_session = 0;
5356                 }
5357                 close (cryptfd);
5358 fprintf (stderr, "ctlkey_unregister under ckn=%p at %d\n", (void *)ckn, __LINE__);
5359                 if (ckn != NULL) {      /* TODO: CHECK NEEDED? */
5360                         if (ctlkey_unregister (ckn->regent.ctlkey)) {
5361                                 free (ckn);
5362                                 ckn = NULL;
5363                         }
5364                 }
5365                 manage_txn_rollback (&cmd->txn);
5366                 assert (pthread_detach (pthread_self ()) == 0);
5367                 return NULL;
5368         }
5369         //DEFERRED// send_command (replycmd, -1);               // app sent plainfd to us
5370
5371         //
5372         // Copy TLS records until the connection is closed
5373         manage_txn_commit (&cmd->txn);
5374         if (!renegotiating) {
5375                 ckn = (struct ctlkeynode_tls *) malloc (sizeof (struct ctlkeynode_tls));
5376         }
5377         if (ckn == NULL) {
5378                 send_error (replycmd, E_TLSPOOL_OUT_OF_MEMORY,
5379                                 "TLS Pool ran out of memory");
5380         } else {
5381                 int detach = (orig_starttls.flags & PIOF_STARTTLS_DETACH) != 0;
5382                 ckn->session = session;
5383                 ckn->owner = pthread_self ();
5384                 ckn->cryptfd = cryptfd;
5385                 ckn->plainfd = plainfd;
5386 //DEBUG// fprintf (stderr, "Registering control key\n");
5387                 if (renegotiating || (ctlkey_register (orig_starttls.ctlkey, &ckn->regent, security_tls, detach ? -1 : cmd->clientfd, forked) == 0)) {
5388                         int copied = GNUTLS_E_SUCCESS;
5389                         send_command (replycmd, -1);            // app sent plainfd to us
5390                         if (preauth) {
5391
5392                                 //
5393                                 // Check on extended master secret if desired
5394                                 if (cmd->anonpre & ANONPRE_EXTEND_MASTER_SECRET) {
5395 #if GNUTLS_VERSION_NUMBER >= 0x030400
5396                                         gnutls_ext_priv_data_t ext;
5397                                         if (!gnutls_ext_get_data (session, 23, &ext)) {
5398                                                 cmd->anonpre &= ~ANONPRE_EXTEND_MASTER_SECRET;
5399                                         }
5400 #endif
5401                                 }
5402                                 if (cmd->anonpre & ANONPRE_EXTEND_MASTER_SECRET) {
5403                                         tlog (TLOG_COPYCAT, LOG_ERR, "Received %d remote bytes from anonymous precursor but lacking %s-required authentication through extended master secret", orig_starttls.service);
5404                                         gtls_errno = GNUTLS_E_LARGE_PACKET;
5405                                         copied = 0;
5406
5407                                 } else if (write (plainfd, preauth, preauthlen) == preauthlen) {
5408                                         tlog (TLOG_COPYCAT, LOG_DEBUG, "Passed on %d remote bytes from anonymous precursor to %d\n", preauthlen, plainfd);
5409                                         free (preauth);
5410                                         preauth = NULL;
5411                                         copied = copycat (plainfd, cryptfd, session, detach ? -1 : cmd->clientfd);
5412                                 } else {
5413                                         tlog (TLOG_COPYCAT, LOG_DEBUG, "Failed to pass on %d remote bytes from anonymous precursor to %d\n", preauthlen, plainfd);
5414                                 }
5415                         } else {
5416                                 copied = copycat (plainfd, cryptfd, session, detach ? -1 : cmd->clientfd);
5417                         }
5418                         // Renegotiate if copycat asked us to
5419                         if (copied == GNUTLS_E_REHANDSHAKE) {
5420                                 // Yes, goto is a dirty technique.  On the
5421                                 // other hand, so is forcing unstructured
5422                                 // code flows into a make-belief structure
5423                                 // that needs changing over and over again.
5424                                 // I fear goto is the most reasonable way
5425                                 // of handling this rather obtuse structure
5426                                 // of renegotiation of security in TLS :(
5427                                 //TODO// Ensure secure renegotiation!!!
5428                                 renegotiating = 1;
5429                                 replycmd = NULL; // Bypass all send_XXX()
5430                                 memcpy (&cmd_copy, cmd, sizeof (cmd_copy));
5431                                 cmd = &cmd_copy;
5432                                 memcpy (cmd->cmd.pio_data.pioc_starttls.localid, orig_starttls.localid, sizeof (cmd->cmd.pio_data.pioc_starttls.localid));
5433                                 memcpy (cmd->cmd.pio_data.pioc_starttls.remoteid, orig_starttls.remoteid, sizeof (cmd->cmd.pio_data.pioc_starttls.remoteid));
5434                                 cmd->cmd.pio_data.pioc_starttls.flags = orig_starttls.flags & ~PIOF_STARTTLS_LOCALID_CHECK;
5435                                 // Disabling the flag causing LOCALID_CHECK
5436                                 // ...and plainfd >= 0 so no PLAINTEXT_CONNECT
5437                                 // ...so there will be no callbacks to cmd
5438 fprintf (stderr, "DEBUG: Goto renegotiate with cmd.lid = \"%s\" and orig_cmd.lid = \"%s\" and cmd.rid = \"%s\" and orig_cmd.rid = \"%s\" and cmd.flags = 0x%x and orig_cmd.flags = 0x%x\n", cmd->cmd.pio_data.pioc_starttls.localid, orig_starttls.localid, cmd->cmd.pio_data.pioc_starttls.remoteid, orig_starttls.remoteid, cmd->cmd.pio_data.pioc_starttls.flags, orig_starttls.flags);
5439                                 goto renegotiate;
5440                         }
5441 //DEBUG// fprintf (stderr, "Unregistering control key\n");
5442                         // Unregister by ctlkey, which should always succeed
5443                         // if the TLS connection hadn't been closed down yet;
5444                         // and if it does, the memory can be freed.  Note that
5445                         // the ctlkey is not taken from the ckn, which may
5446                         // already have been freed if the ctlfd was closed
5447                         // and the connection could not continue detached
5448                         // (such as after forking it).
5449 fprintf (stderr, "ctlkey_unregister under ckn=%p at %d\n", (void *)ckn, __LINE__);
5450                         if (ctlkey_unregister (orig_starttls.ctlkey)) {
5451                                 free (ckn);
5452                         }
5453                         ckn = NULL;
5454 //DEBUG// fprintf (stderr, "Unregistered  control key\n");
5455                 } else {
5456                         send_error (replycmd, E_TLSPOOL_CTLKEY_REGISTRATION_FAILED,
5457                                         "TLS Pool failed to register control key for connection");
5458                 }
5459         }
5460         if (preauth) {
5461                 free (preauth);
5462                 preauth = NULL;
5463         }
5464         close (plainfd);
5465         close (cryptfd);
5466         cleanup_any_remote_credentials (cmd);
5467         if (got_session) {
5468 fprintf (stderr, "gnutls_deinit (%p) at %d\n", (void *)session, __LINE__);
5469                 gnutls_deinit (session);
5470                 got_session = 0;
5471         }
5472         assert (pthread_detach (pthread_self ()) == 0);
5473         return NULL;
5474 }
5475
5476
5477 /*
5478  * The starttls function responds to an application's request to
5479  * setup TLS for a given file descriptor, and return a file descriptor
5480  * with the unencrypted view when done.  The main thing done here is to
5481  * spark off a new thread that handles the operations.
5482  */
5483 void starttls (struct command *cmd) {
5484         /* Create a thread and, if successful, wait for it to unlock cmd */
5485         errno = pthread_create (&cmd->handler, NULL, starttls_thread, (void *) cmd);
5486         if (errno != 0) {
5487                 send_error (cmd, E_TLSPOOL_ENTANGLED_THREADS,
5488                                 "TLS Pool failed to start a threa");
5489                 return;
5490         }
5491 //TODO:TEST// Thread detaches itself before terminating w/o followup
5492 /*
5493         errno = pthread_detach (cmd->handler);
5494         if (errno != 0) {
5495                 pthread_cancel (cmd->handler);
5496                 send_error (cmd, E_TLSPOOL_CONNECTION_HANDLER_SETUP,
5497                                 "TLS Pool failed to setup the connection handler");
5498                 return;
5499         }
5500 */
5501 }
5502
5503
5504 /*
5505  * Run the PRNG for a TLS connection, identified by its control key.  If the connection
5506  * is not a TLS connection, or if the control key is not found, reply with ERROR;
5507  * otherwise, the session should help to create pseudo-random bytes.
5508  */
5509 void starttls_prng (struct command *cmd) {
5510         uint8_t in1 [TLSPOOL_PRNGBUFLEN];
5511         uint8_t in2 [TLSPOOL_PRNGBUFLEN];
5512         int16_t in1len, in2len, prnglen;
5513         struct ctlkeynode_tls *ckn = NULL;
5514         char **prefixes;
5515         int err = 0;
5516         int gtls_errno = GNUTLS_E_SUCCESS;
5517         struct pioc_prng *prng = &cmd->cmd.pio_data.pioc_prng;
5518         //
5519         // Find arguments and validate them
5520         in1len  = prng->in1_len;
5521         in2len  = prng->in2_len;
5522         prnglen = prng->prng_len;
5523         err = err || (in1len <= 0);
5524         err = err || (prnglen > TLSPOOL_PRNGBUFLEN);
5525         err = err || ((TLSPOOL_CTLKEYLEN + in1len + (in2len >= 0? in2len: 0))
5526                                 > TLSPOOL_PRNGBUFLEN);
5527         if (!err) {
5528                 memcpy (in1, prng->buffer + TLSPOOL_CTLKEYLEN         , in1len);
5529                 if (in2len > 0) {
5530                         memcpy (in2, prng->buffer + TLSPOOL_CTLKEYLEN + in1len, in2len);
5531                 }
5532         }
5533         //  - check the label string
5534         prefixes = tlsprng_label_prefixes;
5535         while ((!err) && (*prefixes)) {
5536                 char *pf = *prefixes++;
5537                 if (strlen (pf) != in1len) {
5538                         continue;
5539                 }
5540                 if (strcmp (pf, (const char *)in1) != 0) {
5541                         continue;
5542                 }
5543         }
5544         if (*prefixes == NULL) {
5545                 // RFC 5705 defines a private-use prefix "EXPERIMENTAL"
5546                 if ((in1len <= 12) || (strncmp ((const char *)in1, "EXPERIMENTAL", 12) != 0)) {
5547                         err = 1;
5548                 }
5549         }
5550         //  - check the ctlkey (and ensure it is for TLS)
5551         if (!err) {
5552 //DEBUG// fprintf (stderr, "Hoping to find control key\n");
5553                 ckn = (struct ctlkeynode_tls *) ctlkey_find (prng->buffer, security_tls, cmd->clientfd);
5554         }
5555         //
5556         // Now wipe the PRNG buffer to get rid of any sensitive bytes
5557         memset (prng->buffer, 0, TLSPOOL_PRNGBUFLEN);
5558         //
5559         // If an error occurrend with the command, report it now
5560         if (err) {
5561                 send_error (cmd, E_TLSPOOL_PRNG_UNAVAILABLE,
5562                                 "TLS Pool cannot use pseudo-random number generator");
5563                 // ckn is NULL if err != 0, so no need for ctlkey_unfind()
5564                 return;
5565         }
5566         if (ckn == NULL) {
5567                 send_error (cmd, E_TLSPOOL_CTLKEY_NOT_FOUND,
5568                                 "TLS Pool cannot find the control key");
5569                 return;
5570         }
5571         //
5572         // Now actually invoke the PRNG command in the GnuTLS backend
5573         errno = 0;
5574         E_g2e ("GnuTLS PRNG based on session master key failed",
5575                 gnutls_prf_rfc5705 (ckn->session,
5576                         in1len, (const char *)in1,
5577                         (in2len >= 0)? in2len: 0,
5578                         (const char *)((in2len >= 0) ? in2: NULL),
5579                         prnglen, (char *)prng->buffer));
5580         err = err || (errno != 0);
5581         //
5582         // Wipe temporary data / buffers for security reasons
5583         memset (in1, 0, sizeof (in1));
5584         memset (in2, 0, sizeof (in2));
5585         ctlkey_unfind ((struct ctlkeynode *) ckn);
5586         //
5587         // Return the outcome to the user
5588         if (err) {
5589                 send_error (cmd, errno? errno: E_TLSPOOL_PRNG_UNAVAILABLE,
5590                                 "TLS Pool cannot use pseudo-random number generator");
5591         } else {
5592                 send_command (cmd, -1);
5593         }
5594 }
5595
5596
5597 /* General handling of info queries.  Though they all are different, they invariably
5598  * come down to byte ranges; to comparing them and/or extracting them.  This generic
5599  * part is covered in the starttls_info_query() function, returning true when the info
5600  * is a good response, or false otherwise.  Since it handles a single piece of data at
5601  * a time, it may be useful to loop around this function, until a positive result.
5602  * Such a loop would be an OR compisition of the various options.
5603  *
5604  * We will not only accept a value, but in case of a query, we will copy it.  This
5605  * is why buf and len are both pointers.
5606  */
5607 static bool starttls_info_query (uint16_t *len, uint8_t *buf, size_t findlen, uint8_t *findbuf) {
5608         if (findlen > TLSPOOL_INFOBUFLEN) {
5609                 /* Even if this is 0xffff or ~(size_t)0 then
5610                  * it is still not going to be an information
5611                  * source.  At best could we say that in what
5612                  * we return.
5613                  */
5614                 return false;
5615         }
5616         if (*len == 0xffff) {
5617                 /* Any information is accceptable.  So this is, too.
5618                  * Requirements could be imposed to avoid queries,
5619                  * but not here.  We will in fact complete the
5620                  * query with the information found.
5621                  */
5622                 memcpy (buf, findbuf, findlen);
5623                 *len = findlen;
5624                 return true;
5625         }
5626         /* This is a match, so return the desired value */
5627         return (*len == findlen) && (0 == memcmp (buf, findbuf, findlen));
5628 }
5629
5630
5631 /* An iterative form of the generic info query handler.  This iterates through
5632  * a SEQUENCE OF or SET OF structure in DER, and treats every value found
5633  * individually.  As soon as a match is found, it returns success.  It is
5634  * semantically wrong to send a query through an iterator, as there are not
5635  * grounds for selecting an instance.
5636  */
5637 static bool starttls_info_iteration (uint16_t len, uint8_t *buf, struct dercursor findings) {
5638         struct dercursor finding;
5639         if (len > TLSPOOL_INFOBUFLEN) {
5640                 return false;
5641         }
5642         if (der_iterate_first (&findings, &finding)) do {
5643                 if (starttls_info_query (&len, buf, finding.derlen, finding.derptr)) {
5644                         return true;
5645                 }
5646         } while (der_iterate_next (&finding));
5647         return false;
5648 }
5649
5650
5651 /* Make a DER walk into one of the certificates and consider the
5652  * element found in its entirety.  This may still require iteration
5653  * within the field, so actual info processing is not yet done here.
5654  */
5655 static bool starttls_info_walk (struct command *cmd, struct ctlkeynode *node,
5656                                         const derwalk *walkpath, struct dercursor *out_data) {
5657         bool ok = true;
5658         struct ctlkeynode_tls *ckn = (struct ctlkeynode_tls *) node;
5659         //
5660         // Fetch the appropriate certificate
5661         const gnutls_datum_t *cert_datum = NULL;
5662         if (!ok) {
5663                 /* Already failed */
5664                 ;
5665         } else if ((cmd->cmd.pio_data.pioc_info.info_kind & 0x00000100) == 0x00000000) {
5666                 /* Peer certificate */
5667                 cert_datum = gnutls_certificate_get_peers (ckn->session, NULL);
5668         } else {
5669                 /* My certificate */
5670                 cert_datum = gnutls_certificate_get_ours  (ckn->session);
5671         }
5672         ok = ok && (cert_datum != NULL);
5673         //
5674         // Walk into the certificate
5675         struct dercursor crs = { .derptr =  NULL, .derlen = 0 };
5676         if (ok) {
5677                 crs.derptr = cert_datum->data;
5678                 crs.derlen = cert_datum->size;
5679                 ok = ok && (der_walk (&crs, walkpath) == 0);
5680                 // ok = ok && (der_focus (&crs) == 0);
5681                 uint8_t tag;
5682                 uint8_t hlen;
5683                 size_t len;
5684                 ok = ok && (der_header (&crs, &tag, &len, &hlen) == 0);
5685                 crs.derptr -= hlen;
5686                 crs.derlen  = hlen + len;
5687         }
5688         if (ok) {
5689                 *out_data = crs;
5690         }
5691         return ok;
5692 }
5693
5694
5695 /* Info query for the subject in one of the certificates */
5696 void starttls_info_cert_subject (struct command *cmd, struct ctlkeynode *node, uint16_t len, uint8_t *buf) {
5697         bool ok = (len == 0xffff);      /* Only query */
5698         static const derwalk cert2subject [] = {
5699                 DER_WALK_ENTER | DER_TAG_SEQUENCE,
5700                 DER_WALK_ENTER | DER_TAG_SEQUENCE,
5701                 DER_WALK_OPTIONAL,
5702                 DER_WALK_SKIP  | DER_TAG_CONTEXT(0),    // Version DEFAULT v1
5703                 DER_WALK_SKIP  | DER_TAG_INTEGER,       // CertificateSerialNumber
5704                 DER_WALK_SKIP  | DER_TAG_SEQUENCE,      // AlgorithmIdentifier
5705                 DER_WALK_SKIP  | DER_TAG_SEQUENCE,      // Name (a CHOICE with one option, grinn)
5706                 DER_WALK_SKIP  | DER_TAG_SEQUENCE,      // Validity
5707                 DER_WALK_END                            // Arrived at the Name of the Subject
5708         };
5709         struct dercursor crs;
5710         ok = ok && starttls_info_walk (cmd, node, cert2subject, &crs);
5711         //
5712         // Compare the finding with the request
5713         ok = ok && starttls_info_query (&cmd->cmd.pio_data.pioc_info.len,
5714                                 cmd->cmd.pio_data.pioc_info.buffer,
5715                                 crs.derlen, crs.derptr);
5716         //
5717         // Report the requested information, or failure to find it
5718         if (ok) {
5719                 send_command (cmd, -1);
5720         } else {
5721                 send_error (cmd, E_TLSPOOL_INFO_NOT_FOUND,
5722                                 "TLS Pool cannot answer the info query");
5723         }
5724 }
5725
5726
5727 /* Info query for the issuer in one of the certificates */
5728 void starttls_info_cert_issuer (struct command *cmd, struct ctlkeynode *node, uint16_t len, uint8_t *buf) {
5729         bool ok = (len == 0xffff);      /* Only query */
5730         static const derwalk cert2issuer [] = {
5731                 DER_WALK_ENTER | DER_TAG_SEQUENCE,
5732                 DER_WALK_ENTER | DER_TAG_SEQUENCE,
5733                 DER_WALK_OPTIONAL,
5734                 DER_WALK_SKIP  | DER_TAG_CONTEXT(0),    // Version DEFAULT v1
5735                 DER_WALK_SKIP  | DER_TAG_INTEGER,       // CertificateSerialNumber
5736                 DER_WALK_SKIP  | DER_TAG_SEQUENCE,      // AlgorithmIdentifier
5737                 DER_WALK_END                            // Arrived at the Name of the Issuer
5738         };
5739         struct dercursor crs;
5740         ok = ok && starttls_info_walk (cmd, node, cert2issuer, &crs);
5741         //
5742         // Compare the finding with the request
5743         ok = ok && starttls_info_query (&cmd->cmd.pio_data.pioc_info.len,
5744                                 cmd->cmd.pio_data.pioc_info.buffer,
5745                                 crs.derlen, crs.derptr);
5746         //
5747         // Report the requested information, or failure to find it
5748         if (ok) {
5749                 send_command (cmd, -1);
5750         } else {
5751                 send_error (cmd, E_TLSPOOL_INFO_NOT_FOUND,
5752                                 "TLS Pool cannot answer the info query");
5753         }
5754 }
5755
5756
5757 /* Info query for a subjectAltName in one of the certificates;
5758  * These sit in extensions, and so must search those until we
5759  * find a matching OID (which is easily memcmp()d for) and
5760  * then we enter the value, which is a SEQUENCE OF GeneralName;
5761  * the GeneralName is what the user wants us to match (not extract).
5762  *
5763  * The applicable OID is 2.5.29.17, which encodes to DER bytes
5764  * 0x55, 0x1d, 0x11  -- yeah, they used a weird compressor...
5765  */
5766 void starttls_info_cert_subjectaltname (struct command *cmd, struct ctlkeynode *node, uint16_t len, uint8_t *buf) {
5767         bool ok = (len < sizeof (cmd->cmd.pio_data.pioc_info.buffer));  /* Only compare */
5768         static const derwalk cert2extensions [] = {
5769                 DER_WALK_ENTER | DER_TAG_SEQUENCE,
5770                 DER_WALK_ENTER | DER_TAG_SEQUENCE,
5771                 DER_WALK_OPTIONAL,
5772                 DER_WALK_SKIP  | DER_TAG_CONTEXT(0),    // Version DEFAULT v1
5773                 DER_WALK_SKIP  | DER_TAG_INTEGER,       // CertificateSerialNumber
5774                 DER_WALK_SKIP  | DER_TAG_SEQUENCE,      // AlgorithmIdentifier
5775                 DER_WALK_SKIP  | DER_TAG_SEQUENCE,      // Name (a CHOICE with one option, grinn)
5776                 DER_WALK_SKIP  | DER_TAG_SEQUENCE,      // Validity
5777                 DER_WALK_SKIP  | DER_TAG_SEQUENCE,      // Name (a CHOICE with one option, grinn)
5778                 DER_WALK_SKIP  | DER_TAG_SEQUENCE,      // SubjectPublicKeyInfo
5779                 //TODO// DER_WALK_OPTIONAL,
5780                 //TODO// DER_WALK_SKIP  | DER_TAG_CONTEXT(1),   // UniqueIdentifier, the issuerUniqueId
5781                 //TODO// DER_WALK_OPTIONAL,
5782                 //TODO// DER_WALK_SKIP  | DER_TAG_CONTEXT(2),   // UniqueIdentifier, the subjectUniqueId
5783                 DER_WALK_ENTER | DER_TAG_CONTEXT(3),    // Extenions with tag [3] EXPLICIT
5784                                                         // It is optional, so we may get an error
5785                 //NOTHERE// DER_WALK_ENTER | DER_TAG_SEQUENCE,  // The SEQUENCE inside [3] is also visible
5786                 DER_WALK_END
5787         };
5788         static const uint8_t oid_san [] = { 0x06, 0x03, 0x55, 0x1d, 0x11 };
5789         //
5790         // Find the certificate extensions and check presence through the [3] tag
5791         struct dercursor exts;
5792         ok = ok && starttls_info_walk (cmd, node, cert2extensions, &exts);
5793         //
5794         // Iterate over extensions
5795         struct dercursor iter;
5796         bool done = false;
5797         ok = ok && (der_enter (&exts) == 0);
5798         if (ok && der_iterate_first (&exts, &iter)) do {
5799                 struct dercursor ext = iter;
5800                 // ok = ok && (der_focus (&ext) == 0) && (der_enter (&ext) == 0);
5801                 ok = ok && (der_focus (&ext) == 0);
5802                 tlog (TLOG_CERT, LOG_DEBUG, "Found an extension sized %d -- 0x%02x 0x%02x 0x%02x...\n",
5803                                 ext.derlen, ext.derptr [0], ext.derptr [1], ext.derptr [2]);
5804                 bool extok = ok;
5805                 extok = extok && (ext.derlen > sizeof (oid_san));
5806                 extok = extok && (memcmp (ext.derptr, oid_san, sizeof (oid_san)) == 0);
5807                 extok = extok && (der_skip (&ext) == 0);
5808                 if ((ext.derlen > 3) && (*ext.derptr == DER_TAG_BOOLEAN)) {
5809                         // skip the optional "critical" flag
5810                         extok = extok && (der_skip (&ext) == 0);
5811                 }
5812                 extok = extok && (*ext.derptr == DER_TAG_OCTETSTRING) && (der_enter (&ext) == 0);
5813                 struct dercursor saniter;
5814                 if (extok && der_iterate_first (&ext, &saniter)) do {
5815                         struct dercursor general_name = saniter;
5816                         extok = extok && (der_enter (&general_name) == 0);
5817                         if (extok && starttls_info_query (&len, buf,
5818                                         general_name.derlen, general_name.derptr)) {
5819                                 done = true;
5820                                 goto found_ext;
5821                         }
5822                 } while (extok && der_iterate_next (&saniter));
5823         } while (der_iterate_next (&iter));
5824 found_ext:
5825         ok = ok & done;
5826         //
5827         // Report the requested information, or failure to find it
5828         if (ok) {
5829                 send_command (cmd, -1);
5830         } else {
5831                 send_error (cmd, E_TLSPOOL_INFO_NOT_FOUND,
5832                                 "TLS Pool cannot answer the info query");
5833         }
5834 }
5835
5836
5837 /* Info query to retrieve a "tls-unique" channel binding */
5838 void starttls_info_chanbind_tls_unique (struct command *cmd, struct ctlkeynode *node, uint16_t len, uint8_t *buf) {
5839         bool ok = (len == 0xffff);      /* Only query */
5840         struct ctlkeynode_tls *ckn = (struct ctlkeynode_tls *) node;
5841         gnutls_datum_t cbbuf;   /* Who cleans up its contents? */
5842         memset (&cbbuf, 0, sizeof (cbbuf));
5843         ok = ok && (GNUTLS_E_SUCCESS == gnutls_session_channel_binding (
5844                         ckn->session, GNUTLS_CB_TLS_UNIQUE, &cbbuf));
5845         tlog (TLOG_TLS, LOG_INFO, "After channel binding (tls-unique) retrieval, ok=%d", ok);
5846         ok = ok && starttls_info_query (&len, buf, cbbuf.size, cbbuf.data);
5847         if (ok) {
5848                 memcpy (cmd->cmd.pio_data.pioc_info.buffer, cbbuf.data, cbbuf.size);
5849                 cmd->cmd.pio_data.pioc_info.len = cbbuf.size;
5850                 send_command (cmd, -1);
5851         } else {
5852                 send_error (cmd, E_TLSPOOL_INFO_NOT_FOUND,
5853                                 "TLS Pool cannot answer the info query");
5854         }
5855         if (cbbuf.data != NULL) {
5856                 free (cbbuf.data);
5857         }
5858 }
5859
5860
5861 /* Info query to retrieve a "tls-server-end-point" channel binding */
5862 void starttls_info_chanbind_tls_server_end_point (struct command *cmd, struct ctlkeynode *node, uint16_t len, uint8_t *buf) {
5863         bool ok = (len == 0xffff);      /* Only query */
5864         /* This form of channel binding is not supported in GnuTLS.
5865          * We could use Quick DER to parse it, of course */
5866         send_error (cmd, E_TLSPOOL_INFO_NOT_FOUND,
5867                         "TLS Pool cannot answer the info query");
5868 }
5869
5870
5871 /* Flying signer functionality.  Create an on-the-fly certificate because
5872  * the lidentry daemon and/or application asks for this to represent the
5873  * local identity.  Note that this will only work if the remote party
5874  * accepts the root identity under which on-the-signing is done.
5875  *
5876  * When no root credentials have been configured, this function will
5877  * fail with GNUTLS_E_AGAIN; it may be used as a hint to try through
5878  * other (more conventional) means to obtain a client certificate.
5879  *
5880  * The API of this function matches that of fetch_local_credentials()
5881  * and that is not a coincidence; this is a drop-in replacement in some
5882  * cases.
5883  *
5884  * Limitations: The current implementation only supports X.509 certificates
5885  * to be generated on the fly.  So, this will set LID_TYPE_X509, if anything.
5886  */
5887 gtls_error certificate_onthefly (struct command *cmd) {
5888         gtls_error gtls_errno = GNUTLS_E_SUCCESS;
5889         gnutls_x509_crt_t otfcert;
5890         time_t now;
5891         gnutls_x509_subject_alt_name_t altnmtp;
5892         int i;
5893
5894         //
5895         // Sanity checks
5896         if ((onthefly_issuercrt == NULL) || (onthefly_issuerkey == NULL) || (onthefly_subjectkey == NULL)) {
5897                 // Not able to supply on-the-fly certificates; try someway else
5898                 return GNUTLS_E_AGAIN;
5899         }
5900         if (cmd->cmd.pio_data.pioc_starttls.localid [0] == '\0') {
5901                 return GNUTLS_E_NO_CERTIFICATE_FOUND;
5902         }
5903         if (cmd->lids [LID_TYPE_X509 - LID_TYPE_MIN].data != NULL) {
5904                 free (cmd->lids [LID_TYPE_X509 - LID_TYPE_MIN].data);
5905                 cmd->lids [LID_TYPE_X509 - LID_TYPE_MIN].data = NULL;
5906                 cmd->lids [LID_TYPE_X509 - LID_TYPE_MIN].size = 0;
5907         }
5908
5909         //
5910         // Create an empty certificate
5911         E_g2e ("Failed to initialise on-the-fly certificate",
5912                 gnutls_x509_crt_init (&otfcert));
5913         if (gtls_errno != GNUTLS_E_SUCCESS) {
5914                 return gtls_errno;
5915         }
5916
5917         //
5918         // Fill the certificate with the usual field
5919         E_g2e ("Failed to set on-the-fly certificate to non-CA mode",
5920                 gnutls_x509_crt_set_ca_status (otfcert, 0));
5921         E_g2e ("Failed to set on-the-fly certificate version",
5922                 gnutls_x509_crt_set_version (otfcert, 3));
5923         onthefly_serial++;      //TODO// Consider a random byte string
5924         E_g2e ("Failed to set on-the-fly serial number",
5925                 gnutls_x509_crt_set_serial (otfcert, &onthefly_serial, sizeof (onthefly_serial)));
5926         // Skip gnutls_x509_crt_set_issuer_by_dn_by_oid(), added when signing
5927         time (&now);
5928         E_g2e ("Failed to set on-the-fly activation time to now - 2 min",
5929                 gnutls_x509_crt_set_activation_time (otfcert, now - 120));
5930         E_g2e ("Failed to set on-the-fly expiration time to now + 3 min",
5931                 gnutls_x509_crt_set_expiration_time (otfcert, now + 180));
5932         E_g2e ("Setup certificate CN with local identity",
5933                 gnutls_x509_crt_set_dn_by_oid (otfcert, GNUTLS_OID_X520_COMMON_NAME, 0, cmd->cmd.pio_data.pioc_starttls.localid, strnlen (cmd->cmd.pio_data.pioc_starttls.localid, sizeof (cmd->cmd.pio_data.pioc_starttls.localid)-1))); /* TODO: Consider pioc_lidentry as well? */
5934         E_g2e ("Setup certificate OU with TLS Pool on-the-fly",
5935                 gnutls_x509_crt_set_dn_by_oid (otfcert, GNUTLS_OID_X520_ORGANIZATIONAL_UNIT_NAME, 0, "TLS Pool on-the-fly", 19));
5936         if (strchr (cmd->cmd.pio_data.pioc_starttls.localid, '@')) {
5937                 // localid has the format of an emailAddress
5938                 altnmtp = GNUTLS_SAN_RFC822NAME;
5939         } else {
5940                 // localid has the format of a dnsName
5941                 altnmtp = GNUTLS_SAN_DNSNAME;
5942         }
5943         E_g2e ("Failed to set subjectAltName to localid",
5944                 gnutls_x509_crt_set_subject_alt_name (otfcert, altnmtp, &cmd->cmd.pio_data.pioc_starttls.localid, strnlen (cmd->cmd.pio_data.pioc_starttls.localid, sizeof (cmd->cmd.pio_data.pioc_starttls.localid) - 1), GNUTLS_FSAN_APPEND));
5945         //TODO:SKIP, hoping that signing adds: gnutls_x509_crt_set_authority_key_id()
5946         //TODO:SKIP, hoping that a cert without also works: gnutls_x509_crt_set_subjectkey_id()
5947         //TODO:SKIP? gnutls_x509_crt_set_extension_by_oid
5948         //TODO:      gnutls_x509_crt_set_key_usage
5949         //TODO:SKIP? gnutls_x509_crt_set_ca_status
5950         for (i=0; i < svcusage_registry_size; i++) {
5951                 if (strcmp (svcusage_registry [i].service, (const char *)(cmd->cmd.pio_data.pioc_starttls.service)) == 0) {
5952                         const char **walker;
5953                         E_g2e ("Failed to setup basic key usage during on-the-fly certificate creation",
5954                                 gnutls_x509_crt_set_key_usage (otfcert, svcusage_registry [i].usage));
5955                         walker = svcusage_registry [i].oids_non_critical;
5956                         if (walker) {
5957                                 while (*walker) {
5958                                         E_g2e ("Failed to append non-critical extended key purpose during on-the-fly certificate creation",
5959                                                 gnutls_x509_crt_set_key_purpose_oid (otfcert, *walker, 0));
5960                                         walker++;
5961                                 }
5962                         }
5963                         walker = svcusage_registry [i].oids_critical;
5964                         if (walker) {
5965                                 while (*walker) {
5966                                         E_g2e ("Failed to append critical extended key purpose during on-the-fly certificate creation",
5967                                                 gnutls_x509_crt_set_key_purpose_oid (otfcert, *walker, 1));
5968                                         walker++;
5969                                 }
5970                         }
5971                         break;
5972                 }
5973         }
5974         E_g2e ("Failed to et the on-the-fly subject key",
5975                 gnutls_x509_crt_set_key (otfcert, onthefly_subjectkey));
5976         /* TODO: The lock below should not be necessary; it is handled by p11-kit
5977          *       or at least it ought to be.  What I found however, was that
5978          *       a client and server would try to use the onthefly_issuerkey
5979          *       at virtually the same time, and then the second call to
5980          *       C_SignInit returns CKR_OPERATION_ACTIVE.  The lock solved this.
5981          *       This makes me frown about server keys stored in PKCS #11...
5982          */
5983 {gnutls_datum_t data = { 0, 0}; if (gnutls_x509_crt_print (otfcert, GNUTLS_CRT_PRINT_UNSIGNED_FULL, &data) == 0) { fprintf (stderr, "DEBUG: PRESIGCERT: %s\n", data.data); gnutls_free (data.data); } else {fprintf (stderr, "DEBUG: PRESIGCERT failed to print\n"); } }
5984         assert (pthread_mutex_lock (&onthefly_signer_lock) == 0);
5985         E_g2e ("Failed to sign on-the-fly certificate",
5986                 gnutls_x509_crt_privkey_sign (otfcert, onthefly_issuercrt, onthefly_issuerkey, GNUTLS_DIG_SHA256, 0));
5987         pthread_mutex_unlock (&onthefly_signer_lock);
5988
5989         //
5990         // Construct cmd->lids [LID_TYPE_X509 - LID_TYPE_MIN].data+size for this certificate
5991         cmd->lids [LID_TYPE_X509 - LID_TYPE_MIN].size = 0;
5992         if (gtls_errno == GNUTLS_E_SUCCESS) {
5993                 gtls_errno = gnutls_x509_crt_export (otfcert, GNUTLS_X509_FMT_DER, NULL, &cmd->lids [LID_TYPE_X509 - LID_TYPE_MIN].size);
5994                 if (gtls_errno == GNUTLS_E_SHORT_MEMORY_BUFFER) {
5995                         // This is as expected, now .size will have been set
5996                         gtls_errno = GNUTLS_E_SUCCESS;
5997                 } else {
5998                         if (gtls_errno == GNUTLS_E_SUCCESS) {
5999                                 // Something must be wrong if we receive OK
6000                                 gtls_errno = GNUTLS_E_INVALID_REQUEST;
6001                         }
6002                 }
6003                 E_g2e ("Error while measuring on-the-fly certificate size",
6004                         gtls_errno);
6005         }
6006         uint8_t *ptr = NULL;
6007         if (gtls_errno == GNUTLS_E_SUCCESS) {
6008                 cmd->lids [LID_TYPE_X509 - LID_TYPE_MIN].size += 4 + strlen (onthefly_p11uri) + 1;
6009                 ptr = malloc (cmd->lids [LID_TYPE_X509 - LID_TYPE_MIN].size);
6010                 if (ptr == NULL) {
6011                         cmd->lids [LID_TYPE_X509 - LID_TYPE_MIN].size = 0;
6012                         gnutls_x509_crt_deinit (otfcert);
6013                         return GNUTLS_E_MEMORY_ERROR;
6014                 }
6015         }
6016         if (ptr != NULL) {
6017                 size_t restsz;
6018                 cmd->lids [LID_TYPE_X509 - LID_TYPE_MIN].data = ptr;
6019                 * (uint32_t *) ptr = htonl (LID_TYPE_X509 | LID_ROLE_BOTH);
6020                 ptr += 4;
6021                 strcpy ((char *)ptr, onthefly_p11uri);
6022                 ptr += strlen (onthefly_p11uri) + 1;
6023                 restsz = cmd->lids [LID_TYPE_X509 - LID_TYPE_MIN].size - 4 - strlen (onthefly_p11uri) - 1;
6024                 E_g2e ("Failed to export on-the-fly certificate as a credential",
6025                         gnutls_x509_crt_export (otfcert, GNUTLS_X509_FMT_DER, ptr, &restsz));
6026 char pembuf [10000];
6027 size_t pemlen = sizeof (pembuf) - 1;
6028 int exporterror = gnutls_x509_crt_export (otfcert, GNUTLS_X509_FMT_PEM, pembuf, &pemlen);
6029 if (exporterror == 0) {
6030 pembuf [pemlen] = '\0';
6031 fprintf (stderr, "DEBUG: otfcert ::=\n%s\n", pembuf);
6032 } else {
6033 fprintf (stderr, "DEBUG: otfcert export to PEM failed with %d, gtls_errno already was %d\n", exporterror, gtls_errno);
6034 }
6035         }
6036
6037         //
6038         // Cleanup the allocated and built structures
6039         gnutls_x509_crt_deinit (otfcert);
6040
6041         //
6042         // Return the overall result that might have stopped otf halfway
6043         return gtls_errno;
6044 }
6045