1#! /usr/bin/env perl
2# Copyright 2025 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 OpenSSL::Test qw/:DEFAULT srctop_dir result_dir/;
10use OpenSSL::Test::Utils;
11use File::Temp qw(tempfile);
12use File::Path 2.00 qw(rmtree mkpath);
13
14setup("test_handshake_memfail");
15
16#
17# Don't run this test if mdebug isn't enabled, it won't work
18#
19plan skip_all => "$test_name requires allocfail-tests to be enabled"
20    if disabled("allocfail-tests");
21
22#
23# We need to know how many mallocs we plan to fail, so run the test in count mode
24# To tell us how many mallocs it executes
25# We capture the result of the test into countinfo.txt
26# and parse that to figure out what our values are
27#
28my $resultdir = result_dir();
29run(test(["handshake-memfail", "count", srctop_dir("test", "certs")], stderr => "$resultdir/countinfo.txt"));
30
31#
32# Read the result file into an array
33#
34open my $handle, '<', "$resultdir/countinfo.txt";
35chomp(my @lines = <$handle>);
36close $handle;
37
38#
39# some line contains our counts, find and split that into an array
40#
41my @vals;
42foreach(@lines) {
43    if ($_ =~/skip:/) {
44        @vals = split ' ', $_;
45        break;
46    }
47}
48
49#
50# The number of mallocs we need to skip is in entry two
51# The number of mallocs to test is in entry 4
52#
53my $skipcount = $vals[2];
54my $malloccount = $vals[4];
55
56#
57# Now we can plan our tests.  We plan to run malloccount iterations of this
58# test
59#
60plan tests => $malloccount;
61
62my @seq = (1..$malloccount);
63for my $idx (@seq) {
64    #
65    # We need to setup our openssl malloc failures env var to fail the target malloc
66    # the format of this string is a series of A@B;C@D tuples where A,C are the number
67    # of mallocs to consider, and B,D are the likelyhood that they should fail.
68    # We always skip the first "skip" allocations, then iteratively guarantee that
69    # next <idx> mallocs pass, followed by the next single malloc failing, with the remainder
70    # passing
71    #
72    $ENV{OPENSSL_MALLOC_FAILURES} = "$skipcount\@0;$idx\@0;1\@100;0\@0";
73    ok(run(test(["handshake-memfail", "run", srctop_dir("test", "certs")])));
74}
75