GH-71 Expose rest of SSL_CTX_set_client_hello_cb family of functions.

Also update tests in 48_client_hello_callback.t and documentation in
SSLeay.pod.

4 files changed, 321 insertions, 6 deletions

diff --git a/Changes b/Changes
index bcccd57..838058d 100644
--- a/Changes
+++ b/Changes
@@ -30,6 +30,29 @@ Revision history for Perl extension Net::SSLeay.
 	  Update the previous minor releases to their latest versions. Add
 	  NetBSD to BSDs job and update the other BSDs and Alpine Linux jobs to
 	  cover additional and latest releases. Use the latest MacOS runners.
+	- 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.
+	  - SSL_client_hello_isv2
+	  - SSL_client_hello_get0_legacy_version
+	  - SSL_client_hello_get0_random
+	  - SSL_client_hello_get0_session_id
+	  - SSL_client_hello_get0_ciphers
+	  - SSL_client_hello_get0_compression_methods
+	  - SSL_client_hello_get1_extensions_present
+	  - SSL_client_hello_get_extension_order
+	  - SSL_client_hello_get0_ext
+	- Expose constants used by SSL_CTX_set_client_hello_cb related
+          functions:
+	  - AD_ prefixed constants naming TLS alert codes for
+	    returning from a ClientHello callback or where alert types
+	    are used
+	  - CLIENT_HELLO_ERROR, CLIENT_HELLO_RETRY and
+	    CLIENT_HELLO_SUCCESS for returning from a ClientHello
+	    callback
+	  - TLSEXT_TYPE_ prefixed contants for naming TLS extension
+	    types
 
 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 2c7e785..7136e17 100644
--- a/SSLeay.xs
+++ b/SSLeay.xs
@@ -5896,6 +5896,112 @@ SSL_CTX_set_client_hello_cb(SSL_CTX *ctx, SV *callback, SV *arg=&PL_sv_undef)
 int
 SSL_client_hello_isv2(SSL *s)
 
+unsigned int
+SSL_client_hello_get0_legacy_version(SSL *s)
+
+void
+SSL_client_hello_get0_random(SSL *s)
+    PREINIT:
+	const unsigned char *out = NULL;
+	size_t outlen;
+    CODE:
+	outlen = SSL_client_hello_get0_random(s, &out);
+	if (outlen == 0) XSRETURN_PV("");
+	ST(0) = sv_newmortal();
+	sv_setpvn(ST(0), (const char *)out, (STRLEN)outlen);
+
+void
+SSL_client_hello_get0_session_id(SSL *s)
+    PREINIT:
+	const unsigned char *out = NULL;
+	size_t outlen;
+    CODE:
+	outlen = SSL_client_hello_get0_session_id(s, &out);
+	if (outlen == 0) XSRETURN_PV("");
+	ST(0) = sv_newmortal();
+	sv_setpvn(ST(0), (const char *)out, (STRLEN)outlen);
+
+void
+SSL_client_hello_get0_ciphers(SSL *s)
+    PREINIT:
+	const unsigned char *out = NULL;
+	size_t outlen;
+    CODE:
+	outlen = SSL_client_hello_get0_ciphers(s, &out);
+	if (outlen == 0) XSRETURN_PV("");
+	ST(0) = sv_newmortal();
+	sv_setpvn(ST(0), (const char *)out, (STRLEN)outlen);
+
+void
+SSL_client_hello_get0_compression_methods(SSL *s)
+    PREINIT:
+	const unsigned char *out = NULL;
+	size_t outlen;
+    CODE:
+	outlen = SSL_client_hello_get0_compression_methods(s, &out);
+	if (outlen == 0) XSRETURN_PV("");
+	ST(0) = sv_newmortal();
+	sv_setpvn(ST(0), (const char *)out, (STRLEN)outlen);
+
+void
+SSL_client_hello_get1_extensions_present(SSL *s)
+    PREINIT:
+	int ret, *out = NULL, i;
+	size_t outlen;
+	AV *av;
+    PPCODE:
+	ret = SSL_client_hello_get1_extensions_present(s, &out, &outlen);
+	if (ret != 1) XSRETURN_UNDEF;
+
+	av = newAV();
+	mXPUSHs(newRV_noinc((SV*)av));
+	for (i=0; i < outlen; i++) {
+	    av_push(av, newSViv(*(out + i)));
+	}
+	OPENSSL_free(out);
+
+#if OPENSSL_VERSION_NUMBER >= 0x30200000L && !defined(LIBRESSL_VERSION_NUMBER)
+
+void
+SSL_client_hello_get_extension_order(SSL *s)
+    PREINIT:
+	int ret, i;
+	uint16_t *exts;
+	size_t num_exts;
+	AV *av;
+    PPCODE:
+	ret = SSL_client_hello_get_extension_order(s, NULL, &num_exts);
+	if (ret != 1) XSRETURN_UNDEF;
+
+	Newx(exts, num_exts, uint16_t);
+	ret = SSL_client_hello_get_extension_order(s, exts, &num_exts);
+	if (ret != 1) {
+	    Safefree(exts);
+	    XSRETURN_UNDEF;
+	}
+
+	av = newAV();
+	mXPUSHs(newRV_noinc((SV*)av));
+	for (i=0; i < num_exts; i++) {
+	    av_push(av, newSViv(*(exts + i)));
+	}
+	Safefree(exts);
+
+#endif
+
+void
+SSL_client_hello_get0_ext(SSL *s, unsigned int type)
+    PREINIT:
+	int ret;
+	const unsigned char *out = NULL;
+	size_t outlen;
+    CODE:
+	ret = SSL_client_hello_get0_ext(s, type, &out, &outlen);
+	if (ret != 1) XSRETURN_UNDEF;
+
+	ST(0) = sv_newmortal();
+	sv_setpvn(ST(0), (const char *)out, (STRLEN)outlen);
+
 #endif
 
 int
diff --git a/lib/Net/SSLeay.pod b/lib/Net/SSLeay.pod
index 7226c01..f50b03a 100644
--- a/lib/Net/SSLeay.pod
+++ b/lib/Net/SSLeay.pod
@@ -5510,6 +5510,91 @@ Indicate if the ClientHello was carried in a SSLv2 record and is in the SSLv2 fo
 
 Check openssl doc L<https://www.openssl.org/docs/manmaster/man3/SSL_client_hello_isv2.html>
 
+=item * client_hello_get0_legacy_version
+
+B<COMPATIBILITY:> not available in Net-SSLeay-1.92 and before; requires at least OpenSSL 1.1.1pre1, not in LibreSSL
+
+B<NOTE:> to be used only from a callback set with L<CTX_set_client_hello_cb>.
+
+Returns legacy_version, also known as client_version, field from the ClientHello.
+
+ my $rv = client_hello_get0_legacy_version($s);
+ # $s - value corresponding to openssl's SSL structure
+ #
+ # returns: unsigned integer, for example 0x0303 (TLS v1.2) with TLS 1.3
+
+Check openssl doc L<https://www.openssl.org/docs/manmaster/man3/SSL_client_hello_get0_legacy_version.html>
+
+=item * client_hello_get0_random, client_hello_get0_session_id, client_hello_get0_ciphers and client_hello_get0_compression_methods
+
+B<COMPATIBILITY:> not available in Net-SSLeay-1.92 and before; requires at least OpenSSL 1.1.1pre1, not in LibreSSL
+
+B<NOTE:> to be used only from a callback set with L<CTX_set_client_hello_cb>.
+
+These functions return random, session_id, cipher_suites and compression_methods fields from the ClientHello, respectively.
+
+ my $random = client_hello_get0_random($s);
+ my $session_id = client_hello_get0_session_id($s);
+ my $ciphers = client_hello_get0_ciphers($s);
+ my $compression_methods = client_hello_get0_compression_methods($s);
+ # $s - value corresponding to openssl's SSL structure
+ #
+ # returns: raw octet data where data length, zero or more, depends on the field definition
+
+Check openssl doc L<https://www.openssl.org/docs/manmaster/man3/SSL_client_hello_get0_random.html>
+
+=item * client_hello_get1_extensions_present and client_hello_get_extension_order
+
+B<COMPATIBILITY:> not available in Net-SSLeay-1.92 and before; requires at least OpenSSL 1.1.1pre1, not in LibreSSL
+
+B<NOTE:> to be used only from a callback set with L<CTX_set_client_hello_cb>.
+
+Returns a reference to an array holding the numerical value of the TLS extension types in the order they appear in the ClientHello. client_hello_get_extension_order is similar and requires at least OpenSSL 3.2.0, not in LibreSSL.
+
+ my $ref = client_hello_get1_extensions_present($s);
+ # $s - value corresponding to openssl's SSL structure
+ #
+ # returns: an array reference of zero or more extension types or undef on failure
+
+Example from a TLS 1.3 ClientHello:
+
+ sub client_hello_cb {
+    my ($ssl, $arg) = @_;
+    my $ref = client_hello_get1_extensions_present($ssl);
+    print join(' ', @$ref), "\n" if $ref;
+  }
+
+Prints: C<11 10 35 22 23 13 43 45 51>
+
+Check openssl doc L<https://www.openssl.org/docs/manmaster/man3/SSL_client_hello_get1_extensions_present.html>
+
+
+=item * client_hello_get0_ext
+
+B<COMPATIBILITY:> not available in Net-SSLeay-1.92 and before; requires at least OpenSSL 1.1.1pre1, not in LibreSSL
+
+B<NOTE:> to be used only from a callback set with L<CTX_set_client_hello_cb>.
+
+Returns an extension by type number from the ClientHello.
+
+ my $ref = client_hello_get1_extensions_present($s, $type);
+ # $s - value corresponding to openssl's SSL structure
+ # $type - (integer) extension type number
+ #
+ # returns: zero or more octets of extension contents including extension length, undef if the extension is not present
+
+Example: Get the value of TLS extension C<supported_versions>. You can use constant C<TLSEXT_TYPE_supported_versions> or 43 directly.
+
+ sub client_hello_cb {
+    my ($ssl, $arg) = @_;
+    my $ext_ver = Net::SSLeay::client_hello_get0_ext($ssl, Net::SSLeay::TLSEXT_TYPE_supported_versions());
+    print unpack('H*', $ext_ver), "\n" if defined $ext_ver;
+  }
+
+Prints: C<080304030303020301> where the first octet 0x08 is the extension length and the following four 16bit values correspond to TLS versions 1.3, 1.2, 1.1 and 1.0.
+
+Check openssl doc L<https://www.openssl.org/docs/manmaster/man3/SSL_client_hello_get0_ext.html>
+
 =back
 
 =head3 Low level API: RAND_* related functions
diff --git a/t/local/48_client_hello_callback.t b/t/local/48_client_hello_callback.t
index a521856..d99122c 100644
--- a/t/local/48_client_hello_callback.t
+++ b/t/local/48_client_hello_callback.t
@@ -11,7 +11,7 @@ BEGIN {
     } elsif (not can_fork()) {
         plan skip_all => "fork() not supported on this system";
     } else {
-        plan tests => 19;
+        plan tests => 41;
     }
 }
 
@@ -33,13 +33,86 @@ sub client_hello_cb_v2hello_detection
 {
     my ($ssl, $arg) = @_;
 
+    pass('client_hello_cb_v2hello_detection called for SSLv2 hello');
     is(Net::SSLeay::client_hello_isv2($ssl), 1, 'SSLv2 ClientHello');
+    is(Net::SSLeay::client_hello_get0_legacy_version($ssl), 0x0301, 'SSLv2 get0_legacy_version');
+
+    my $random  = Net::SSLeay::client_hello_get0_random($ssl);
+    my $sess_id = Net::SSLeay::client_hello_get0_session_id($ssl);
+    my $ciphers = Net::SSLeay::client_hello_get0_ciphers($ssl);
+    my $compres = Net::SSLeay::client_hello_get0_compression_methods($ssl);
+    is($random,  pack('H*', '1f90dda05ec4a857523dcc0ae06c461a99c36ce647a84aa64061c054333376b9'), 'SSLv2 get0_random / Challenge');
+    is($sess_id, '', 'SSLv2 get0_session_id');
+    is($ciphers, pack('H*', '00003900003800003500001600001300000a00003300003200002f0000070000050000040000150000120000090000ff'), 'SSLv2 get0_ciphers');
+    is($compres, pack('H*', '00'), 'SSLv2 get0_compression_methods');
+
+    # See bug https://github.com/openssl/openssl/pull/8756
+    # With 1.1.1b and earlier, MALLOC_FAILURE is raised when there are
+    # no extensions. This is fixed in 1.1.1c.
+    my $extensions = Net::SSLeay::client_hello_get1_extensions_present($ssl);
+    Net::SSLeay::SSLeay > 0x1010102f ? # 1.1.1c or later
+	is_deeply($extensions, [], 'SSLv2 get1_extensions_present') :  # No extensions: empty array
+	is($extensions, undef, 'SSLv2 get1_extensions_present buggy'); # No extensions: buggy undef
+
+    if (defined &Net::SSLeay::client_hello_get_extension_order) {
+	$extensions = Net::SSLeay::client_hello_get_extension_order($ssl);
+	is_deeply($extensions, [], 'SSLv2 get_extension_order');
+    } else {
+      SKIP: { skip('Do not have Net::SSLeay::client_hello_get_extension_order', 1); }
+    }
+
     my $al = Net::SSLeay::AD_BAD_CERTIFICATE();
     return (Net::SSLeay::CLIENT_HELLO_ERROR(), $al);
 }
 
 # See that the exact same reference with unchanged contents are made
 # available for the callback. Allow handshake to proceed.
+sub client_hello_cb_getters
+{
+    my ($ssl, $arg) = @_;
+
+    pass('client_hello_cb_getters called for TLS hello');
+    is(Net::SSLeay::client_hello_isv2($ssl), 0, 'Not SSLv2 ClientHello');
+    is(Net::SSLeay::client_hello_get0_legacy_version($ssl), 0x0303, 'TLS get0_legacy_version');
+
+    my $random  = Net::SSLeay::client_hello_get0_random($ssl);
+    my $sess_id = Net::SSLeay::client_hello_get0_session_id($ssl);
+    my $ciphers = Net::SSLeay::client_hello_get0_ciphers($ssl);
+    my $compres = Net::SSLeay::client_hello_get0_compression_methods($ssl);
+    is($random,  pack('H*', '8bbef485edd728d6c02c421b5a9a3a137d6dfda43c5796ef825d8ac7dcbbbc53'), 'TLS get0_random');
+    is($sess_id, pack('H*', '0d687c7511cb0b65eb3cde414c2385bc0ecb56d8c81403c571184c4acbd1ee31'), 'TLS get0_session_id');
+    is($ciphers, pack('H*', '130213031301c02cc03000a3009fcca9cca8ccaac0afc0adc0a3c09fc05dc061c057c05300a7c02bc02f00a2009ec0aec0acc0a2c09ec05cc060c056c05200a6c024c028006b006ac073c07700c400c3006d00c5c023c02700670040c072c07600be00bd006c00bfc00ac0140039003800880087c019003a0089c009c0130033003200450044c01800340046009dc0a1c09dc051009cc0a0c09cc050003d00c0003c00ba00350084002f004100ff'), 'TLS get0_ciphers');
+    is($compres, pack('H*', '00'), 'TLS get0_compression_methods');
+
+    # OpenSSL extensions_presents does not guarantee that extensions
+    # are returned in the order the appear ClientHello. Therefore we
+    # compare sorted arrays. Note: that the both functions also do not
+    # return extensions OpenSSL does not recognise. For more, see:
+    # https://github.com/openssl/openssl/issues/18286#issuecomment-1123436664
+    my @ordered_ext = (11, 10, 35, 22, 23, 13, 43, 45, 51);
+    my $extensions = Net::SSLeay::client_hello_get1_extensions_present($ssl);
+    is_deeply($extensions, \@ordered_ext, 'TLS get1_extensions_present');
+
+    if (defined &Net::SSLeay::client_hello_get_extension_order) {
+	$extensions = Net::SSLeay::client_hello_get_extension_order($ssl);
+	is_deeply($extensions, \@ordered_ext, 'TLS get_extension_order');
+    } else {
+      SKIP: { skip('Do not have Net::SSLeay::client_hello_get_extension_order', 1); }
+    }
+
+    my $ext_ems = Net::SSLeay::client_hello_get0_ext($ssl, Net::SSLeay::TLSEXT_TYPE_extended_master_secret());
+    my $ext_ver = Net::SSLeay::client_hello_get0_ext($ssl, Net::SSLeay::TLSEXT_TYPE_supported_versions());
+    my $ext_n_a = Net::SSLeay::client_hello_get0_ext($ssl, 101);
+    is($ext_ems, '', 'TLS get0_ext extended master secret'); # Present with empty value
+    is($ext_ver, pack('H*', '080304030303020301'), 'TLS get0_ext supported versions');
+    is($ext_n_a, undef, 'TLS get0_ext extension not present'); # Not present
+
+    my $al = Net::SSLeay::AD_HANDSHAKE_FAILURE();
+    return (Net::SSLeay::CLIENT_HELLO_ERROR(), $al);
+}
+
+# See that the exact same reference with unchanged contents are made
+# available for the callback. Allow handshake to proceed.
 sub client_hello_cb_value_passing
 {
     my ($ssl, $arg) = @_;
@@ -100,6 +173,7 @@ my @cb_tests = (
     # true if the callback function triggers croak()
     # true if the client needs to test that ALPN alert (120) is received
     [ \&client_hello_cb_v2hello_detection, undef, 0 ],
+    [ \&client_hello_cb_getters, undef, 0 ],
     [ \&client_hello_cb_value_passing, \$cb_test_arg, 0 ],
     [ \&client_hello_cb_alert_alpn, undef, 0, 'alerts'],
     [ \&client_hello_cb_alert_alpn, undef, 0, 'alerts'], # Call again to increase alert counter
@@ -182,7 +256,23 @@ my @results;
 	sysread($s_clientv2, my $buf, 16384);
 
 	# Alert (15), version (0303|4), length (0002), level fatal (02), bad cert(2a)
-	push @results, [unpack('H*', $buf) =~ m/^15030.0002022a\z/, 'Alert from SSLv2 ClientHello'];
+	my $alert_matches = unpack('H*', $buf) =~ m/^15030.0002022a\z/s;
+	push @results, [$alert_matches, 'Client: Alert from canned SSLv2 ClientHello'];
+	close($s_clientv2) || die("s_clientv2 close");
+	shift @cb_tests;
+    }
+
+    # Start with TLSv1.3 ClientHello detection test. Send a canned TLSv1.3
+    # ClientHello.
+    {
+	my $s_clientv2 = $server->connect();
+	my $clientv2_hello = get_tlsv13_hello();
+	syswrite($s_clientv2, $clientv2_hello, length $clientv2_hello);
+	sysread($s_clientv2, my $buf, 16384);
+
+	# Alert (15), version (0303|4), length (0002), level fatal (02), handshake failure(28)
+	my $alert_matches = unpack('H*', $buf) =~ m/^15030.00020228\z/s;
+	push @results, [$alert_matches, 'Client: Alert from canned TLS ClientHello'];
 	close($s_clientv2) || die("s_clientv2 close");
 	shift @cb_tests;
     }
@@ -210,13 +300,13 @@ my @results;
 	close($s_c) || die("client close: $!");
     }
     $server->close() || die("client listen socket close: $!");
-    push @results, [$alpn_alert_count == 2, "ALPN alert count is correct: got $alpn_alert_count"];
+    push @results, [$alpn_alert_count == 2, "Client: ALPN alert count is correct: got $alpn_alert_count"];
 }
 
 waitpid $pid, 0;
-push @results, [$? == 0, 'server exited with 0'];
+push @results, [$? == 0, 'Client: server exited with 0'];
 END {
-  Test::More->builder->current_test(16);
+  Test::More->builder->current_test(37);
   ok( $_->[0], $_->[1] ) for (@results);
 }
 
@@ -237,9 +327,20 @@ sub get_sslv2_hello
     # The first capture is similar to 0.9.8f but the ciphersuites are
     # now ordered with the strongest first.The second capture uses
     # TLSv1.0 as Version but compared to 0.9.8f has a more modern set
-    # of ciphers and includes TLS_EMPTY_RENEGOTIATION_INFO_SCSV.
+    # of ciphers including TLS_EMPTY_RENEGOTIATION_INFO_SCSV.
     my $sslv2_sslv2_hex_zh = '802e0100020015000000100700c006004005008004008003008002008001008015c9eb78cbf9702542ac2d4c46b6101a';
     my $sslv2_tlsv1_hex_zh = '805901030100300000002000003900003800003500001600001300000a00003300003200002f0000070000050000040000150000120000090000ff1f90dda05ec4a857523dcc0ae06c461a99c36ce647a84aa64061c054333376b9';
 
     return pack('H*', $sslv2_tlsv1_hex_zh);
 }
+
+# Use a canned TLS ClientHello for testing the different get functions
+sub get_tlsv13_hello
+{
+    # Capture with locally confgured OpenSSL 3.1.2
+    #
+    # openssl s_client -connect 127.0.0.1:443 -cipher ALL:@SECLEVEL=0
+    my $tlsv13_hex = '160301019a0100019603038bbef485edd728d6c02c421b5a9a3a137d6dfda43c5796ef825d8ac7dcbbbc53200d687c7511cb0b65eb3cde414c2385bc0ecb56d8c81403c571184c4acbd1ee3100ae130213031301c02cc03000a3009fcca9cca8ccaac0afc0adc0a3c09fc05dc061c057c05300a7c02bc02f00a2009ec0aec0acc0a2c09ec05cc060c056c05200a6c024c028006b006ac073c07700c400c3006d00c5c023c02700670040c072c07600be00bd006c00bfc00ac0140039003800880087c019003a0089c009c0130033003200450044c01800340046009dc0a1c09dc051009cc0a0c09cc050003d00c0003c00ba00350084002f004100ff0100009f000b000403000102000a00160014001d0017001e0019001801000101010201030104002300000016000000170000000d0030002e040305030603080708080809080a080b080408050806040105010601030302030301020103020202040205020602002b0009080304030303020301002d00020101003300260024001d0020330c4636c46839dcd22288191791649290b432ed8748a8d7935799dc6e37f246';
+
+    return pack('H*', $tlsv13_hex);
+}