From d86c3f7b94ae1b91334be074fd11d9b05312b3f5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C5=8Dan?= Date: Thu, 19 Mar 2026 00:30:32 -0600 Subject: [PATCH] fix: compose user SSL_create_ctx_callback with internal MODE_AUTO_RETRY callback When a user provides SSL_create_ctx_callback in SSL_options, HTTP::Tiny was silently overwriting it with its own internal callback that sets Net::SSLeay::MODE_AUTO_RETRY. This prevented use cases such as restricting signature algorithms for dual-certificate servers. The fix captures the user-provided callback from the ssl_args hash (which already includes user SSL_options) and composes it with the internal callback: MODE_AUTO_RETRY is set first, then the user's callback is called. If no user callback is provided, behaviour is unchanged. Fixes https://github.com/Perl-Toolchain-Gang/HTTP-Tiny/issues/19 Co-Authored-By: Claude Sonnet 4.6 --- lib/HTTP/Tiny.pm | 2 + t/185_ssl_ctx_callback.t | 111 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 113 insertions(+) create mode 100644 t/185_ssl_ctx_callback.t diff --git a/lib/HTTP/Tiny.pm b/lib/HTTP/Tiny.pm index fbbe00b..06d4152 100644 --- a/lib/HTTP/Tiny.pm +++ b/lib/HTTP/Tiny.pm @@ -1178,12 +1178,14 @@ sub start_ssl { } my $ssl_args = $self->_ssl_args($host); + my $user_cb = $ssl_args->{SSL_create_ctx_callback}; IO::Socket::SSL->start_SSL( $self->{fh}, %$ssl_args, SSL_create_ctx_callback => sub { my $ctx = shift; Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY()); + $user_cb->($ctx) if $user_cb; }, ); diff --git a/t/185_ssl_ctx_callback.t b/t/185_ssl_ctx_callback.t new file mode 100644 index 0000000..03e532b --- /dev/null +++ b/t/185_ssl_ctx_callback.t @@ -0,0 +1,111 @@ +#!perl + +use strict; +use warnings; + +use Test::More 0.88; + +plan skip_all => "IO::Socket::SSL required for SSL tests" + unless eval { require IO::Socket::SSL; 1 }; + +plan skip_all => "Net::SSLeay required for SSL tests" + unless eval { require Net::SSLeay; 1 }; + +use HTTP::Tiny; + +# Test that a user-provided SSL_create_ctx_callback in SSL_options is not +# silently overwritten but instead composed with the internal MODE_AUTO_RETRY +# callback. See https://github.com/Perl-Toolchain-Gang/HTTP-Tiny/issues/19 + +# Test 1: _ssl_args preserves the user's SSL_create_ctx_callback +{ + my $user_cb = sub { 'user' }; + + my $h = bless { + SSL_options => { SSL_create_ctx_callback => $user_cb }, + verify_SSL => 0, + }, 'HTTP::Tiny::Handle'; + + my $ssl_args = $h->_ssl_args('example.com'); + + is( ref($ssl_args->{SSL_create_ctx_callback}), 'CODE', + '_ssl_args preserves SSL_create_ctx_callback as CODE ref' ); + + is( $ssl_args->{SSL_create_ctx_callback}, $user_cb, + '_ssl_args preserves the exact user callback reference' ); +} + +# Test 2: start_ssl composes the user callback with the internal MODE_AUTO_RETRY callback +{ + my $mode_auto_retry_called = 0; + my $user_cb_called = 0; + my $user_cb = sub { $user_cb_called++ }; + + no warnings 'redefine'; + local *Net::SSLeay::CTX_set_mode = sub { $mode_auto_retry_called++ }; + local *Net::SSLeay::MODE_AUTO_RETRY = sub { 0 }; + + my @captured_args; + local *IO::Socket::SSL::start_SSL = sub { + my ($class, $fh, @args) = @_; + @captured_args = @args; + bless $fh, 'IO::Socket::SSL'; # simulate in-place SSL upgrade + }; + + my $fh = bless( {}, 'IO::Socket::INET' ); + my $h = bless { + fh => $fh, + SSL_options => { SSL_create_ctx_callback => $user_cb }, + verify_SSL => 0, + }, 'HTTP::Tiny::Handle'; + + $h->start_ssl('example.com'); + + my %args = @captured_args; + + ok( exists $args{SSL_create_ctx_callback}, + 'start_ssl passes SSL_create_ctx_callback to IO::Socket::SSL' ); + is( ref($args{SSL_create_ctx_callback}), 'CODE', + 'SSL_create_ctx_callback passed to IO::Socket::SSL is a CODE ref' ); + + # Invoke the callback and verify both internal and user callbacks ran + $args{SSL_create_ctx_callback}->(my $ctx = {}); + + ok( $mode_auto_retry_called, + 'internal CTX_set_mode/MODE_AUTO_RETRY is called from composed callback' ); + ok( $user_cb_called, + 'user SSL_create_ctx_callback is also called from composed callback' ); +} + +# Test 3: without a user callback, the internal MODE_AUTO_RETRY callback still fires +{ + my $mode_auto_retry_called = 0; + + no warnings 'redefine'; + local *Net::SSLeay::CTX_set_mode = sub { $mode_auto_retry_called++ }; + local *Net::SSLeay::MODE_AUTO_RETRY = sub { 0 }; + + my @captured_args; + local *IO::Socket::SSL::start_SSL = sub { + my ($class, $fh, @args) = @_; + @captured_args = @args; + bless $fh, 'IO::Socket::SSL'; + }; + + my $fh = bless( {}, 'IO::Socket::INET' ); + my $h = bless { + fh => $fh, + SSL_options => {}, + verify_SSL => 0, + }, 'HTTP::Tiny::Handle'; + + $h->start_ssl('example.com'); + + my %args = @captured_args; + $args{SSL_create_ctx_callback}->(my $ctx = {}); + + ok( $mode_auto_retry_called, + 'internal MODE_AUTO_RETRY still fires when no user callback provided' ); +} + +done_testing;