From c58bc1c928655fc4b258f4d2475158e84421f2ab Mon Sep 17 00:00:00 2001 From: Heikki Vatiainen Date: Sat, 16 Sep 2023 14:47:55 +0300 Subject: [PATCH] GH-442 Expose functions for setting up TLS PSK on the server side. (#443) - SSL_use_psk_identity_hint - SSL_CTX_use_psk_identity_hint - SSL_set_psk_server_callback - SSL_CTX_set_psk_server_callback - SSL_set_psk_find_session_callback - SSL_CTX_set_psk_find_session_callback - SSL_SESSION_set1_master_key - SSL_SESSION_set_cipher - SSL_SESSION_set_protocol_version - SSL_CIPHER_find The SSL_SESSION_ and SSL_CIPHER family of functions are typically needed with TLSv1.3 specific callback functions set with SSL_set_psk_find_session_callback and SSL_CTX_set_psk_find_session_callback. --- Changes | 16 ++- SSLeay.xs | 298 +++++++++++++++++++++++++++++++++++++++++++++ lib/Net/SSLeay.pod | 216 ++++++++++++++++++++++++++++++++ 3 files changed, 528 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index 838058db..6363ecdd 100644 --- a/Changes +++ b/Changes @@ -33,7 +33,7 @@ Revision history for Perl extension Net::SSLeay. - Expose SSL_CTX_set_client_hello_cb for setting a callback the server calls when it processes a ClientHello. Expose the following functions that can be called only from the - callback. + callback. None of these are available with LibreSSL. - SSL_client_hello_isv2 - SSL_client_hello_get0_legacy_version - SSL_client_hello_get0_random @@ -44,7 +44,7 @@ Revision history for Perl extension Net::SSLeay. - SSL_client_hello_get_extension_order - SSL_client_hello_get0_ext - Expose constants used by SSL_CTX_set_client_hello_cb related - functions: + functions. - AD_ prefixed constants naming TLS alert codes for returning from a ClientHello callback or where alert types are used @@ -53,6 +53,18 @@ Revision history for Perl extension Net::SSLeay. callback - TLSEXT_TYPE_ prefixed contants for naming TLS extension types + - Expose functions for setting up TLS PSK on the server + side. Only SSL_CIPHER_find is available with LibreSSL. + - SSL_use_psk_identity_hint + - SSL_CTX_use_psk_identity_hint + - SSL_set_psk_server_callback + - SSL_CTX_set_psk_server_callback + - SSL_set_psk_find_session_callback + - SSL_CTX_set_psk_find_session_callback + - SSL_SESSION_set1_master_key + - SSL_SESSION_set_cipher + - SSL_SESSION_set_protocol_version + - SSL_CIPHER_find 1.93_02 2023-02-22 - Update ppport.h to version 3.68. This eliminates thousands of diff --git a/SSLeay.xs b/SSLeay.xs index 7136e170..90a9d709 100644 --- a/SSLeay.xs +++ b/SSLeay.xs @@ -1109,6 +1109,211 @@ unsigned int ssleay_ctx_set_psk_client_callback_invoke(SSL *ssl, const char *hin return psk_len; } +unsigned int ssleay_set_psk_server_callback_invoke(SSL *ssl, const char *identity, + unsigned char *psk, unsigned int max_psk_len) +{ + dSP; + int count = -1; + unsigned int psk_len = 0; + SV * cb_func, *psk_sv; + + PR1("STARTED: ssleay_set_psk_server_callback_invoke\n"); + + cb_func = cb_data_advanced_get(ssl, "ssleay_set_psk_server_callback!!func"); + if(!SvOK(cb_func)) + croak ("Net::SSLeay: ssleay_set_psk_server_callback_invoke called, but not set to point to any perl function.\n"); + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + EXTEND(SP, 3); + PUSHs(sv_2mortal(newSViv(PTR2IV(ssl)))); + PUSHs(sv_2mortal(newSVpv(identity, 0))); + PUSHs(sv_2mortal(newSViv(max_psk_len))); + + PUTBACK; + + count = call_sv( cb_func, G_SCALAR ); + + SPAGAIN; + + if (count != 1) + croak ("Net::SSLeay: ssleay_set_psk_server_callback_invoke perl function did not return 1 value.\n"); + + psk_sv = POPs; + if (SvOK(psk_sv)) { + STRLEN new_psk_len; + char *new_psk = SvPV(psk_sv, new_psk_len); + + if (!SvPOK(psk_sv)) + croak ("Net::SSLeay: ssleay_set_psk_server_callback_invoke PSK is not a string.\n"); + + if (new_psk_len > max_psk_len) + croak ("Net::SSLeay: ssleay_set_psk_server_callback_invoke PSK is longer than allowed (%lu > %u).\n", new_psk_len, max_psk_len); + memcpy(psk, new_psk, new_psk_len); + psk_len = new_psk_len; + } + + PUTBACK; + FREETMPS; + LEAVE; + + return psk_len; +} + +unsigned int ssleay_ctx_set_psk_server_callback_invoke(SSL *ssl, const char *identity, + unsigned char *psk, unsigned int max_psk_len) +{ + dSP; + SSL_CTX *ctx; + int count = -1; + unsigned int psk_len = 0; + SV * cb_func, *psk_sv; + + PR1("STARTED: ssleay_ctx_set_psk_server_callback_invoke\n"); + + ctx = SSL_get_SSL_CTX(ssl); + cb_func = cb_data_advanced_get(ctx, "ssleay_ctx_set_psk_server_callback!!func"); + if(!SvOK(cb_func)) + croak ("Net::SSLeay: ssleay_ctx_set_psk_server_callback_invoke called, but not set to point to any perl function.\n"); + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + EXTEND(SP, 3); + PUSHs(sv_2mortal(newSViv(PTR2IV(ssl)))); + PUSHs(sv_2mortal(newSVpv(identity, 0))); + PUSHs(sv_2mortal(newSViv(max_psk_len))); + + PUTBACK; + + count = call_sv( cb_func, G_SCALAR ); + + SPAGAIN; + + if (count != 1) + croak ("Net::SSLeay: ssleay_ctx_set_psk_server_callback_invoke perl function did not return 1 value.\n"); + + psk_sv = POPs; + if (SvOK(psk_sv)) { + STRLEN new_psk_len; + char *new_psk = SvPV(psk_sv, new_psk_len); + + if (!SvPOK(psk_sv)) + croak ("Net::SSLeay: ssleay_ctx_set_psk_server_callback_invoke PSK is not a string.\n"); + + if (new_psk_len > max_psk_len) + croak ("Net::SSLeay: ssleay_ctx_set_psk_server_callback_invoke PSK is longer than allowed (%lu > %u).\n", new_psk_len, max_psk_len); + memcpy(psk, new_psk, new_psk_len); + psk_len = new_psk_len; + } + + PUTBACK; + FREETMPS; + LEAVE; + + return psk_len; +} + +#if OPENSSL_VERSION_NUMBER >= 0x10101001L + +/* TLS 1.3 has its own callbacks */ +int ssleay_set_psk_find_session_callback_invoke(SSL *ssl, const unsigned char *identity, + size_t identity_len, + SSL_SESSION **sess) +{ + dSP; + int count = -1, ret; + SV * cb_func, *sess_sv; + + PR1("STARTED: ssleay_psk_find_session_callback_callback_invoke\n"); + + cb_func = cb_data_advanced_get(ssl, "ssleay_set_psk_find_session_callback!!func"); + if(!SvOK(cb_func)) + croak ("Net::SSLeay: ssleay_psk_find_session_callback_callback_invoke called, but not set to point to any perl function.\n"); + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + EXTEND(SP, 2); + PUSHs(sv_2mortal(newSViv(PTR2IV(ssl)))); + PUSHs(sv_2mortal(newSVpvn((const char *)identity, identity_len))); + + PUTBACK; + + count = call_sv( cb_func, G_LIST ); + + SPAGAIN; + + if (count != 2) + croak ("Net::SSLeay: ssleay_psk_find_session_callback_callback_invoke perl function did not return 2 values.\n"); + + *sess = NULL; + sess_sv = POPs; + if (SvOK(sess_sv)) + *sess = INT2PTR(SSL_SESSION *, SvIV(sess_sv)); + + ret = POPi; + + PUTBACK; + FREETMPS; + LEAVE; + + return ret; +} + +int ssleay_ctx_set_psk_find_session_callback_invoke(SSL *ssl, const unsigned char *identity, + size_t identity_len, + SSL_SESSION **sess) +{ + dSP; + SSL_CTX *ctx; + int count = -1, ret; + SV * cb_func, *sess_sv; + + ctx = SSL_get_SSL_CTX(ssl); + + PR1("STARTED: ssleay_ctx_psk_find_session_callback_callback_invoke\n"); + + cb_func = cb_data_advanced_get(ctx, "ssleay_ctx_set_psk_find_session_callback!!func"); + if(!SvOK(cb_func)) + croak ("Net::SSLeay: ssleay_ctx_psk_find_session_callback_callback_invoke called, but not set to point to any perl function.\n"); + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + EXTEND(SP, 2); + PUSHs(sv_2mortal(newSViv(PTR2IV(ssl)))); + PUSHs(sv_2mortal(newSVpvn((const char *)identity, identity_len))); + + PUTBACK; + + count = call_sv( cb_func, G_LIST ); + + SPAGAIN; + + if (count != 2) + croak ("Net::SSLeay: ssleay_ctx_psk_find_session_callback_callback_invoke perl function did not return 2 values.\n"); + + *sess = NULL; + sess_sv = POPs; + if (SvOK(sess_sv)) + *sess = INT2PTR(SSL_SESSION *, SvIV(sess_sv)); + + ret = POPi; + + PUTBACK; + FREETMPS; + LEAVE; + + return ret; +} + +#endif #endif #if (OPENSSL_VERSION_NUMBER >= 0x10001000L && !defined(OPENSSL_NO_NEXTPROTONEG)) || (OPENSSL_VERSION_NUMBER >= 0x10002000L && !defined(OPENSSL_NO_TLSEXT)) @@ -5435,6 +5640,13 @@ SSL_CIPHER_get_bits(c, ...) const char * SSL_CIPHER_get_version(const SSL_CIPHER *cipher) +#if (OPENSSL_VERSION >= 0x1000200fL && !defined(LIBRESSL_VERSION_NUMBER)) || (LIBRESSL_VERSION_NUMBER >= 0x3040000fL) /* LibreSSL >= 3.4.0 */ + +const SSL_CIPHER * +SSL_CIPHER_find(SSL *ssl, const unsigned char *ptr) + +#endif + #ifndef OPENSSL_NO_COMP int @@ -6801,6 +7013,27 @@ SSL_SESSION_set_master_key(s,key) #endif +#if (OPENSSL_VERSION_NUMBER >= 0x10101001L && !defined(LIBRESSL_VERSION_NUMBER)) + +int +SSL_SESSION_set1_master_key(SSL_SESSION *sess, in) + PREINIT: + STRLEN len; + INPUT: + const unsigned char *in = (unsigned char*)SvPV(ST(1), len); + CODE: + RETVAL = SSL_SESSION_set1_master_key(sess, in, len); + OUTPUT: + RETVAL + +int +SSL_SESSION_set_cipher(SSL_SESSION *s, const SSL_CIPHER *cipher) + +int +SSL_SESSION_set_protocol_version(SSL_SESSION *s, int version) + +#endif + #if (OPENSSL_VERSION_NUMBER >= 0x10100000L && !defined(LIBRESSL_VERSION_NUMBER)) || (LIBRESSL_VERSION_NUMBER >= 0x2070000fL) void @@ -6988,6 +7221,71 @@ SSL_CTX_set_psk_client_callback(ctx,callback=&PL_sv_undef) SSL_CTX_set_psk_client_callback(ctx, ssleay_ctx_set_psk_client_callback_invoke); } +int +SSL_use_psk_identity_hint(SSL *ssl, const char *hint) + +int +SSL_CTX_use_psk_identity_hint(SSL_CTX *ctx, const char *hint) + +void +SSL_set_psk_server_callback(ssl,cb=&PL_sv_undef) + SSL * ssl + SV * cb + CODE: + if (cb==NULL || !SvOK(cb)) { + SSL_set_psk_server_callback(ssl, NULL); + cb_data_advanced_put(ssl, "ssleay_set_psk_server_callback!!func", NULL); + } + else { + cb_data_advanced_put(ssl, "ssleay_set_psk_server_callback!!func", newSVsv(cb)); + SSL_set_psk_server_callback(ssl, ssleay_set_psk_server_callback_invoke); + } + +void +SSL_CTX_set_psk_server_callback(ctx,cb=&PL_sv_undef) + SSL_CTX * ctx + SV * cb + CODE: + if (cb==NULL || !SvOK(cb)) { + SSL_CTX_set_psk_server_callback(ctx, NULL); + cb_data_advanced_put(ctx, "ssleay_ctx_set_psk_server_callback!!func", NULL); + } + else { + cb_data_advanced_put(ctx, "ssleay_ctx_set_psk_server_callback!!func", newSVsv(cb)); + SSL_CTX_set_psk_server_callback(ctx, ssleay_ctx_set_psk_server_callback_invoke); + } + +#if OPENSSL_VERSION_NUMBER >= 0x10101001L + +void +SSL_set_psk_find_session_callback(s,cb=&PL_sv_undef) + SSL * s + SV * cb + CODE: + if (cb==NULL || !SvOK(cb)) { + SSL_set_psk_find_session_callback(s, NULL); + cb_data_advanced_put(s, "ssleay_set_psk_find_session_callback!!func", NULL); + } + else { + cb_data_advanced_put(s, "ssleay_set_psk_find_session_callback!!func", newSVsv(cb)); + SSL_set_psk_find_session_callback(s, ssleay_set_psk_find_session_callback_invoke); + } + +void +SSL_CTX_set_psk_find_session_callback(ctx,cb=&PL_sv_undef) + SSL_CTX * ctx + SV * cb + CODE: + if (cb==NULL || !SvOK(cb)) { + SSL_CTX_set_psk_find_session_callback(ctx, NULL); + cb_data_advanced_put(ctx, "ssleay_ctx_set_psk_find_session_callback!!func", NULL); + } + else { + cb_data_advanced_put(ctx, "ssleay_ctx_set_psk_find_session_callback!!func", newSVsv(cb)); + SSL_CTX_set_psk_find_session_callback(ctx, ssleay_ctx_set_psk_find_session_callback_invoke); + } + +#endif #endif #ifdef NET_SSLEAY_CAN_TICKET_KEY_CB diff --git a/lib/Net/SSLeay.pod b/lib/Net/SSLeay.pod index f50b03ad..5fc9aa92 100644 --- a/lib/Net/SSLeay.pod +++ b/lib/Net/SSLeay.pod @@ -2153,6 +2153,25 @@ Returns 'master_key' value from SSL_SESSION structure $s # # returns: master key (binary data) +=item * SESSION_set1_master_key + +B not available in Net-SSLeay-1.92 and before; requires at least OpenSSL 1.1.1pre1, not in LibreSSL + +Sets the master key value associated with a SSL_SESSION. + + my $ret = Net::SSLeay::SESSION_set1_master_key($sess, $key); + # $sess - value corresponding to OpenSSL SSL_SESSION structure + # $key - PSK key in packed binary format + # + # returns: 1 on success, 0 on failure + +Example: + + my $key = pack('H*', 'deadbeef'); + my $ret = Net::SSLeay::SESSION_set1_master_key($sess, $key); + +Check openssl doc L + =item * SESSION_set_master_key Sets 'master_key' value for SSL_SESSION structure $s @@ -2168,6 +2187,34 @@ Code that previously used SESSION_set_master_key must now set $secret in the session_secret callback set with SSL_set_session_secret_cb. +=item * SESSION_set_cipher + +B not available in Net-SSLeay-1.92 and before; requires at least OpenSSL 1.1.1pre1, not in LibreSSL + +Set the ciphersuite associated with an SSL_SESSION. + + my $ret = Net::SSLeay::SESSION_set_cipher($s, $cipher); + # $s - value corresponding to OpenSSL SSL_SESSION structure + # $cipher - value corresponding to OpenSSL SSL_CIPHER structure + # + # returns: 1 on success, 0 on failure + +Check openssl doc L + +=item * SESSION_set_protocol_version + +B not available in Net-SSLeay-1.92 and before; requires at least OpenSSL 1.1.1pre1, not in LibreSSL + +Sets the protocol version associated with an SSL_SESSION. + + my $ret = Net::SSLeay::SESSION_set_protocol_version($s, $version); + # $s - value corresponding to OpenSSL SSL_SESSION structure + # $version - integer version constant. For example Net::SSLeay::TLS1_3_VERSION() + # + # returns: 1 on success, 0 on failure + +Check openssl doc L + =item * SESSION_get_time Returns the time at which the session s was established. @@ -8892,6 +8939,28 @@ Returns version of SSL/TLS protocol that first defined the cipher Check openssl doc L +=item * CIPHER_find + +B not available in Net-SSLeay-1.92 and before; requires at least OpenSSL 1.0.2 or LibreSSL 3.4.0 + +Returns a SSL_CIPHER structure from the current SSL using a two octet cipher ID. + + my $cipher = Net::SSLeay::CIPHER_find($ssl, $id); + # $ssl - value corresponding to OpenSSL SSL structure + # $id - two octet cipher ID. + # + # returns: A value corresponding to OpenSSL SSL_CIPHER structure or undef if cipher is not found or an error occurs. + +Example that prints 'OpenSSL name is: TLS_AES_128_GCM_SHA256' with +TLSv1.3 when the ciphersuite is enabled: + + # TLS Cipher Suite 0x13, 0x01 is TLS_AES_128_GCM_SHA256 + my $id = pack('n', 0x1301); + my $cipher = Net::SSLeay::CIPHER_find($ssl, $id); + printf("OpenSSL name is: " . Net::SSLeay::CIPHER_get_name($cipher)); + +Check openssl doc L + =back =head3 Low level API: BN_* related functions @@ -9837,6 +9906,153 @@ Check openssl doc L not available in Net-SSLeay-1.92 and before. The +TLSv1.3 specific functions require at least OpenSSL 1.1.1; the others +OpenSSL 1.0.0. Not available in LibreSSL. + +=over + +=item * CTX_use_psk_identity_hint + +Set PSK identity hint for SSL_CTX on TLS server for TLSv1.2 and earlier versions. + + my $ret = Net::SSLeay::CTX_use_psk_identity_hint($ctx, $hint); + # $ctx - value corresponding to OpenSSL SSL_CTX structure + # $hint - string, a hint sent to the TLS clients + # + # returns: 1 on success, 0 on failure + +Example: + + my $ret = Net::SSLeay::CTX_use_psk_identity_hint($ctx, 'ctx server identity_hint'); + +Check openssl doc L + +=item * use_psk_identity_hint + +Set PSK identity hint for SSL on TLS server for TLSv1.2 and earlier versions. + + my $ret = Net::SSLeay::use_psk_identity_hint($ssl, $hint); + # $ssl - value corresponding to OpenSSL SSL structure + # $hint - string, a hint sent to the TLS clients + # + # returns: 1 on success, 0 on failure + +Example: + + my $ret = Net::SSLeay::use_psk_identity_hint($ssl, 'ssl server identity_hint'); + +Check openssl doc L + +=item * CTX_set_psk_server_callback + +Set a callback for an SSL_CTX on TLS server for using PSKs with all TLS versions. + +B With TLSv1.3 Net::SSLeay::CTX_set_psk_find_session_callback +or Net::SSLeay::set_psk_find_session_callback is recommended. + + # First set up a callback function. + sub tls12_psk_cb + { + my ($ssl, $identity, $max_psk_len) = @_; + + # Note: $identity is potentially hostile user supplied data + + my $psk = pack('H*', 'deadbeef'); + return $psk if length $psk <= $max_psk_len; + + return undef; + } + + my $cb = \&tls12_psk_cb; + Net::SSLeay::CTX_set_psk_server_callback($ctx, $cb); + # $ctx - value corresponding to OpenSSL SSL_CTX structure + # $cb - reference to callback function + # + # returns: no return value + +The callback function must return a PSK in packed binary format, or +C to trigger C alert and TLS handshake +failure. If TLS handshake failure without PSK specific alert is +required, return packed random data. + +Check openssl doc L + +=item * set_psk_server_callback + +Set a callback for an SSL on TLS server for using PSKs with all TLS versions. + +B With TLSv1.3 Net::SSLeay::CTX_set_psk_find_session_callback +or Net::SSLeay::set_psk_find_session_callback is recommended. + + Net::SSLeay::set_psk_server_callback($ssl, $cb); + # $ssl - value corresponding to OpenSSL SSL structure + # $cb - reference to callback function + # + # returns: no return value + +See Net::SSLeay::CTX_set_psk_server_callback() documentation for +a full example with a callback. + +Check openssl doc L + +=item * CTX_set_psk_find_session_callback + +Set a callback for an SSL_CTX on TLS server for using TLSv1.3 PSKs. + + # First set up a callback function. + sub tls13_psk_cb + { + my ($ssl, $identity) = @_; + + # Note: $identity is potentially hostile user supplied data + + my $sess = Net::SSLeay::SESSION_new(); + my $cipher = Net::SSLeay::CIPHER_find($ssl, pack('n', 0x1301)); + Net::SSLeay::SESSION_set1_master_key($sess, pack('H*', 'deadbeef')); + Net::SSLeay::SESSION_set_cipher($sess, $cipher); + Net::SSLeay::SESSION_set_protocol_version($sess, Net::SSLeay::version($ssl)); + + return (1, $sess); + } + + my $cb = \&tls13_psk_cb; + Net::SSLeay::CTX_set_psk_find_session_callback($ctx, $cb); + # $ctx - value corresponding to OpenSSL SSL_CTX structure + # $cb - reference to callback function + # + # returns: no return value + +The callback function must return a two value list. When the first +value is 0, the connection setup fails. When the first value is 1, the +second value must be a valid C or C. When the +second value is a valid C, the TLS handshake proceeds +with PSK authentication. When the the second value is C, PSK is +not used the TLS handshake proceeds with certificate authentication. + +Check openssl doc L + +=item * set_psk_find_session_callback + +Set a callback for an SSL on TLS server for using TLSv1.3 PSKs. + + Net::SSLeay::set_psk_find_session_callback($ssl, $cb); + # $ssl - value corresponding to OpenSSL SSL structure + # $cb - reference to callback function + # + # returns: no return value + +See Net::SSLeay::CTX_set_psk_find_session_callback() documentation for +a full example with a callback. + +Check openssl doc L + +=back + + =head2 Constants There are many openssl constants available in L. You can use them like this: