Commit b5f0da4c94 for openssl.org

commit b5f0da4c9412202bc546555f0e7f459ee427a791
Author: Jakub Zelenka <jakub.zelenka@openssl.foundation>
Date:   Fri Jul 17 23:44:14 2026 +0200

    test: assert the specific alert in DTLS sslrecords tests

    The DTLS unknown-record-type tests in 70-test_sslrecords.t checked only
    that s_client exited non-zero, which does not distinguish a genuine
    rejection of the record from an unrelated failure (or a crash).

    Capture s_client's stdout+stderr in TLSProxy and parse the alerts it
    logs via the -msg message callback, exposing them through new accessors:
    clientoutput, client_alerts and client_sent_fatal_alert(). The check
    reflects the alert s_client generated locally and so does not depend on
    the peer receiving it, keeping the test deterministic.

    In the DTLS cases add -msg to the client flags and assert that s_client
    generated the fatal unexpected_message alert and exited cleanly with a
    failure, using a new client_failed() helper that decodes the child
    status so a signal death is not mistaken for a rejection. On failure
    the captured client output is dumped for diagnostics.

    Assisted-by: Claude:claude-fable-5

    Reviewed-by: Tomas Mraz <tomas@openssl.foundation>
    Reviewed-by: Ryan Hooper <ryanh@openssl.foundation>
    Reviewed-by: Neil Horman <nhorman@openssl.org>
    MergeDate: Thu Sep 10 21:33:34 2026
    (Merged from https://github.com/openssl/openssl/pull/32135)

diff --git a/test/recipes/70-test_sslrecords.t b/test/recipes/70-test_sslrecords.t
index 4c24aada50..c66093ac9a 100644
--- a/test/recipes/70-test_sslrecords.t
+++ b/test/recipes/70-test_sslrecords.t
@@ -137,7 +137,7 @@ sub run_tests
     $proxy->clear();
     if ($run_test_as_dtls == 1) {
         $proxy->serverflags("-min_protocol DTLSv1.2 -max_protocol DTLSv1.2");
-        $proxy->clientflags("-max_protocol DTLSv1.2");
+        $proxy->clientflags("-max_protocol DTLSv1.2 -msg");
     } else {
         $proxy->serverflags("-tls1_2");
         $proxy->clientflags("-no_tls1_3");
@@ -146,12 +146,15 @@ sub run_tests
     $proxy_start_success = $proxy->start();

     if ($run_test_as_dtls == 1) {
-        # DTLS alerts are best-effort (RFC 6347 section 4.2.7): the client's
-        # fatal alert may be lost, so we cannot rely on observing it. What we
-        # verify is that the client rejected the connection, i.e. exited with a
-        # failure. Whether we happened to see the alert is only diagnostic.
-        ok($proxy->clientexit != 0, "Unrecognised record type in DTLS1.2");
-        note("client fatal alert observed") if $fatal_alert;
+        # DTLS alerts are best-effort (RFC 6347 section 4.2.7) so we cannot
+        # rely on the peer observing the client's fatal alert. Instead check
+        # that s_client itself generated the expected unexpected_message alert
+        # and then exited cleanly with a failure (rather than crashing).
+        ok($proxy->client_sent_fatal_alert("unexpected_message")
+               && $proxy->client_failed(),
+           "Unrecognised record type in DTLS1.2")
+            or diag("client exit status: ".$proxy->clientexit.
+                    "\nclient output:\n".$proxy->clientoutput);
     } else {
         ok($fatal_alert, "Unrecognised record type in TLS1.2");
     }
@@ -164,15 +167,18 @@ sub run_tests
         $fatal_alert = 0;
         $proxy->clear();
         if ($run_test_as_dtls == 1) {
-            $proxy->clientflags("-min_protocol DTLSv1 -max_protocol DTLSv1 -cipher DEFAULT:\@SECLEVEL=0");
+            $proxy->clientflags("-min_protocol DTLSv1 -max_protocol DTLSv1 -msg -cipher DEFAULT:\@SECLEVEL=0");
         } else {
             $proxy->clientflags("-tls1_1 -cipher DEFAULT:\@SECLEVEL=0");
         }
         $proxy->ciphers("AES128-SHA:\@SECLEVEL=0");
         $proxy_start_success = $proxy->start();
         if ($run_test_as_dtls == 1) {
-            ok($proxy->clientexit != 0, "Unrecognised record type in DTLSv1");
-            note("client fatal alert observed") if $fatal_alert;
+            ok($proxy->client_sent_fatal_alert("unexpected_message")
+                   && $proxy->client_failed(),
+               "Unrecognised record type in DTLSv1")
+                or diag("client exit status: ".$proxy->clientexit.
+                        "\nclient output:\n".$proxy->clientoutput);
         } else {
             ok($fatal_alert, "Unrecognised record type in TLSv1.1");
         }
diff --git a/util/perl/TLSProxy/Proxy.pm b/util/perl/TLSProxy/Proxy.pm
index f1d9c2bf97..bcd8fd5e7b 100644
--- a/util/perl/TLSProxy/Proxy.pm
+++ b/util/perl/TLSProxy/Proxy.pm
@@ -11,6 +11,7 @@ use POSIX ":sys_wait_h";
 package TLSProxy::Proxy;

 use File::Spec;
+use File::Temp qw/tempfile/;
 use IO::Socket;
 use IO::Select;
 use TLSProxy::Record;
@@ -126,6 +127,8 @@ sub init
         serverpid => 0,
         clientpid => 0,
         clientexit => 0,
+        clientoutput => "",
+        client_alerts => [],
         execute => $execute,
         cert => $cert,
         debug => $debug,
@@ -168,6 +171,8 @@ sub clearClient
     $self->{expected_tickets} = 2;
     $self->{clientpid} = 0;
     $self->{clientexit} = 0;
+    $self->{clientoutput} = "";
+    $self->{client_alerts} = [];
     $is_tls13 = 0;
     $ciphersuite = undef;

@@ -432,11 +437,21 @@ sub clientstart
         if ($self->debug) {
             print STDERR "Client command: $execcmd\n";
         }
+
+        # Capture s_client's stdout+stderr so it can be inspected after exit
+        # (see clientoutput/client_alerts). The open() below only wires the
+        # client's stdin. The file is created in the test results directory
+        # (the current working directory during a test run).
+        my (undef, $capturefile) = tempfile("client-XXXXXX",
+                                            DIR => File::Spec->curdir,
+                                            SUFFIX => ".out", OPEN => 0);
+        $self->{clientcapture} = $capturefile;
+
         open(my $savedout, ">&STDOUT");
         # If we open pipe with new descriptor, attempt to close it,
         # explicitly or implicitly, would incur waitpid and effectively
         # dead-lock...
-        if (!($pid = open(STDOUT, "| $execcmd"))) {
+        if (!($pid = open(STDOUT, "| $execcmd >\"$capturefile\" 2>&1"))) {
             my $err = $!;
             kill(3, $self->{real_serverpid});
             die "Failed to $execcmd: $err\n";
@@ -645,6 +660,19 @@ sub clientstart
     waitpid($pid, 0);
     $self->{clientexit} = $?;

+    # Slurp and parse the captured s_client output
+    if (defined $self->{clientcapture}) {
+        if (open(my $fh, '<', $self->{clientcapture})) {
+            local $/;
+            $self->{clientoutput} = <$fh>;
+            close($fh);
+        }
+        unlink $self->{clientcapture};
+        $self->{clientcapture} = undef;
+        print STDERR $self->{clientoutput} if $self->debug;
+        $self->{client_alerts} = _parse_alerts($self->{clientoutput});
+    }
+
     return $success;
 }

@@ -724,6 +752,26 @@ sub construct_alert_message
            $payload;
 }

+# Parse alerts logged by s_client's -msg message callback, e.g.
+#   >>> DTLS 1.2, Alert [length 0002], fatal unexpected_message
+# ">>>" is an alert we sent, "<<<" one we received. Returns a list of
+# { direction => 'sent'|'recv', level, name } hashrefs.
+sub _parse_alerts
+{
+    my $output = shift;
+    my @alerts;
+
+    foreach my $line (split /\n/, $output) {
+        next unless $line =~ /^(>>>|<<<) .+, Alert \[length [0-9a-f]+\], (warning|fatal) (\S+)$/;
+        push @alerts, {
+            direction => ($1 eq '>>>') ? 'sent' : 'recv',
+            level => $2,
+            name => $3,
+        };
+    }
+    return \@alerts;
+}
+
 sub process_packet
 {
     my ($self, $serverissender, $packet) = @_;
@@ -966,6 +1014,40 @@ sub clientexit
     my $self = shift;
     return $self->{clientexit};
 }
+# True only if s_client exited cleanly (i.e. was not killed by a signal) with
+# a non-zero status, meaning it rejected the connection rather than crashing.
+sub client_failed
+{
+    my $self = shift;
+    my $status = $self->{clientexit};
+    return 0 if ($status & 127) != 0;
+    return ($status >> 8) != 0;
+}
+# Raw captured s_client stdout+stderr from the last run.
+sub clientoutput
+{
+    my $self = shift;
+    return $self->{clientoutput};
+}
+# Arrayref of all alerts parsed from the s_client -msg output.
+sub client_alerts
+{
+    my $self = shift;
+    return $self->{client_alerts};
+}
+# True if s_client locally generated the named fatal alert (e.g.
+# "unexpected_message"). Requires -msg in clientflags. Reflects the alert
+# s_client generated regardless of whether the peer ever received it.
+sub client_sent_fatal_alert
+{
+    my ($self, $name) = @_;
+    foreach my $alert (@{$self->{client_alerts}}) {
+        return 1 if $alert->{direction} eq 'sent'
+                    && $alert->{level} eq 'fatal'
+                    && $alert->{name} eq $name;
+    }
+    return 0;
+}

 #Read/write accessors
 sub filter