xref: /freebsd/crypto/openssl/test/recipes/20-test_app_s_client.t (revision 78e936b2d0b5e6554425009199be31e76bc67c10) 
1#! /usr/bin/env perl
2# Copyright 2026 The OpenSSL Project Authors. All Rights Reserved.
3#
4# Licensed under the Apache License 2.0 (the "License").  You may not use
5# this file except in compliance with the License.  You can obtain a copy
6# in the file LICENSE in the source distribution or at
7# https://www.openssl.org/source/license.html
8
9use strict;
10use warnings;
11
12use IO::Socket::INET;
13use OpenSSL::Test qw/:DEFAULT result_file with/;
14use OpenSSL::Test::Utils;
15
16setup("test_app_s_client");
17
18plan skip_all => "test_app_s_client needs sock enabled"
19    if disabled("sock");
20plan skip_all => "test_app_s_client needs IPv4"
21    unless have_IPv4();
22plan skip_all => "test_app_s_client needs fork"
23    if $^O =~ /^(VMS|MSWin32|msys)$/;
24
25plan tests => 5;
26
27my $timeout = 30;
28local $SIG{ALRM} = sub { BAIL_OUT("s_client Sieve STARTTLS test timed out") };
29alarm($timeout);
30
31my $listener = IO::Socket::INET->new(
32    LocalAddr => "127.0.0.1",
33    LocalPort => 0,
34    Listen => 1,
35    Proto => "tcp",
36    ReuseAddr => 1,
37) or BAIL_OUT("failed to create local Sieve listener: $!");
38
39my $port = $listener->sockport();
40my $command_file = result_file("sieve-starttls-command.txt");
41my $stdout_file = result_file("s_client-stdout.txt");
42my $stderr_file = result_file("s_client-stderr.txt");
43my $server_pid = fork();
44
45BAIL_OUT("failed to fork Sieve listener: $!") unless defined $server_pid;
46
47if ($server_pid == 0) {
48    eval {
49        local $SIG{ALRM} = sub { die "Sieve listener timed out\n" };
50        alarm($timeout);
51
52        my $server = $listener->accept()
53            or die "failed to accept s_client connection: $!";
54
55        $server->autoflush(1);
56        print $server "\"STARTTLS\"\r\nOK\r\n";
57
58        my $command = <$server>;
59        open my $fh, ">", $command_file
60            or die "failed to open command capture file: $!";
61        print $fh $command if defined $command;
62        close $fh;
63
64        # This stub only needs to drive s_client through the plaintext
65        # Sieve STARTTLS response parser.  After sending an exact two-byte
66        # lowercase OK response, it closes instead of performing TLS.  The
67        # resulting handshake failure is expected, but sanitizer failures
68        # before that are not.
69        print $server "ok";
70        close $server;
71        alarm(0);
72    };
73    warn $@ if $@;
74    exit($@ ? 1 : 0);
75}
76
77close $listener;
78
79with({ exit_checker => sub { return shift() < 128; } },
80     sub {
81         ok(run(app(["openssl", "s_client", "-brief", "-starttls", "sieve",
82                     "-connect", "127.0.0.1:$port"],
83                    stdin => undef, stdout => $stdout_file,
84                    stderr => $stderr_file)),
85            "s_client exits without signal");
86     });
87
88waitpid($server_pid, 0);
89is($?, 0, "Sieve listener completed");
90
91my $command = "";
92if (open my $fh, "<", $command_file) {
93    local $/;
94    $command = <$fh>;
95    close $fh;
96}
97is($command, "STARTTLS\r\n", "s_client sends Sieve STARTTLS command");
98
99my $stderr = "";
100if (open my $fh, "<", $stderr_file) {
101    local $/;
102    $stderr = <$fh>;
103    close $fh;
104}
105unlike($stderr, qr/STARTTLS not supported/,
106       "s_client accepts case-insensitive two-byte OK response");
107unlike($stderr, qr/AddressSanitizer/,
108       "s_client does not trigger AddressSanitizer");
109
110alarm(0);
111