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