ngircd/debian/tests/test-s2s-tls

#!/usr/bin/perl

#%# Copyright (C) 2014-2024 Christoph Biedl <debian.axhn@manchmal.in-ulm.de>
#%# License: GPL-2.0+

=head1 NAME

ngircd-test-tls-link - test certificate validation in ngircd's TLS based s2s links

=head1 VERSION

Version YYYY.MM.DD

=cut

our $VERSION = 'YYYY.MM.DD';

=head1 SYNOPSIS

    ngircd-test-tls-link --x509-dir /path/to/dir --x509-populate

    ngircd-test-tls-link --x509-dir /path/to/dir [<test-name> ...]

=cut

use 5.010;
use strict;
use warnings;

use Test::More;

use File::Basename;
use File::Copy;
use File::Slurp;
use File::Temp qw<tempdir>;
use Getopt::Long;
use Pod::Usage;
use Proc::Simple;
use Socket;
use Time::HiRes qw<sleep time>;

my $ngircd_exe_default = '/usr/sbin/ngircd';
my @ngircd_exe = ( $ngircd_exe_default );
my @tls_mode;
my $x509_dir;
my $x509_populate;
my $verbose = 0;

=head1 OPTIONS

=over

=cut

{
    my $help;
    my $man;
    my %GetOptions = (
        'help|?' => \$help,
        'man' =>    \$man,
    );

=item B<--x509-dir> F<directory>

A directory to hold the x509 credentials needed. Default: Use a
temporary directory which is deleted upon exit. This delays every
execution of this program by a few seconds.

=cut

    $GetOptions{'x509-dir=s'} = \$x509_dir;

=item B<--x509-populate>

Populate a given C<--x509-dir> with the files needed, then exit.

=cut

    $GetOptions{'x509-populate'} = \$x509_populate;

=item B<--tls-mode> C<mode>

One of C<openssl> or C<gnutls>.

The type of TLS configuration to use. Must match ngircd's compilation
option. Use only if auto-detection failed, and report a bug then.

For TLS interoperability tests, you can provide two strings, separated
by C<:> (colon).

Default: Detect from the binary.

=cut

    $GetOptions{'tls-mode=s'} = sub {
        @tls_mode = split (/:/, $_[1], 2);
    };

=item B<--ngircd> F<program>

The ngircd binary. For TLS interoperability tests, you can provide two
programs, separated by C<:> (colon).

Default: F</usr/sbin/ngircd>

=cut

    $GetOptions{'ngircd=s'} = sub {
        @ngircd_exe = split (/:/, $_[1], 2);
    };

=item B<--verbose>

Add verbosity.

=cut

    $GetOptions{'verbose+'} = \$verbose++;

=item B<--Version>

Show the version number and exit.

=cut

    $GetOptions{'Version'} = sub {
        printf "%s version %s\n",
            (split (/\//, $0))[-1],
            $VERSION;
        exit 1;
    };

=item [ <test> ... ]

Select specific tests to run only. Default: Run all tests.

=back

=cut

    GetOptions (%GetOptions) or pod2usage (2);
    $help and pod2usage (1);
    $man and pod2usage (-exitstatus => 0, -verbose => 2);

    if (@tls_mode) {
        foreach my $m (@tls_mode) {
            ($m =~ /^(openssl|gnutls)$/) or
                die ("Invalid '--tls-mode' value '$m'");
        }
    } else {
        for (my $i = 0; $i < scalar (@ngircd_exe); $i++) {
            my $x = $ngircd_exe[$i];
            my $tls_mode;
            (-x $x) or
                die ("Not an executable: '$x'");
            my $pipe;
            open ($pipe, '-|', 'ldd', $x) or
                die ("Cannot run ldd on '$x': $!");
            while (defined (my $line = <$pipe>)) {
                if ($line =~ /^\tlibssl\.so\./) {
                    $tls_mode = 'openssl';
                    last;
                } elsif ($line =~ /^\tlibgnutls/) {
                    $tls_mode = 'gnutls';
                    last;
                }
            }
            close ($pipe);
            if ($tls_mode) {
                note ("Auto-detected TLS mode for '$x' is '$tls_mode'");
                $tls_mode[$i] = $tls_mode;
            } else {
                die ("BUG: Failed to determine TLS mode for '$x'");
            }
        }
    }
    $ngircd_exe[1] //= $ngircd_exe[0];
    $tls_mode[1] //= $tls_mode[0];
}


my $temp_dir = tempdir (
    "ngircd-test-tls-link.$$.XXXXX",
    'TMPDIR' => 1,
    'CLEANUP' => 1,
);

my $exit_after_x509_populate;
if ($x509_dir) {
    (-d $x509_dir || $x509_populate) or
        die ("Not a directory: '$x509_dir' - perhaps you forgot --x509-populate?");
    $exit_after_x509_populate = $x509_populate;
} else {
    # not provided, use a temporary directoryy
    $x509_dir = "$temp_dir/CA";
    # always populate it, and continue
    $x509_populate and
        note ('Ignoring --x509-populate option as no --x509-dir was provided');
    $x509_populate = 1;
    $exit_after_x509_populate = undef;
}
my $conf_dir = "$temp_dir/conf";
my $hosts_file ="$temp_dir/hosts";

write_file (
    $hosts_file,
    <<__EOS__,
127.0.0.1 server1
127.0.0.1 server2
127.0.0.1 server1.example.com
127.0.0.1 server2.example.com
__EOS__
);

foreach my $dir (($x509_dir, $conf_dir)) {
    (
        -d $dir ||
        mkdir ($dir)
    ) or die ("Cannot create directory '$dir'");
}

my $src_dir = dirname ($0);

my $one_month_future = $^T + 30*86400;

my %tests = (
    'regular' => {
        'expect' => 'pass',
        'fail' => qr/Connection [0-9]+ with "server2:6692" closed/,
        ':order' => __LINE__,
    },

    'different-CAs' => {
        'expect' => 'pass',
        'server1-extra' => {
            'SSL' => {
                'CAFile' => "$x509_dir/CA2/root-ca.crt",
            },
        },
        'server2-extra' => {
            'SSL' => {
                'CertFile' => "$x509_dir/CA2/server2.example.com.crt",
                'KeyFile' => "$x509_dir/CA2/server2.example.com.key",
            },
        },
        ':order' => __LINE__,
    },

    'CN-mismatch' => {
        # using certificate with wrong CN, must fail
        'expect' => 'fail',
        'server2-extra' => {
            'SSL' => {
                'CertFile' => "$x509_dir/CA1/server3.example.com.crt",
                'KeyFile' => "$x509_dir/CA1/server3.example.com.key",
            },
        },
        'pass' => qr/Peer certificate check failed for/,
        ':order' => __LINE__,
    },

    'using-peer-cert-as-CA' => {
        # using peer cert as CA a.k.a. self-signed
        'unsupported' => 1, # fails on openssl
        'expect' => 'pass',
        'server1-extra' => {
            'SSL' => {
                'CAFile' => "$x509_dir/CA1/server2.example.com.crt",
            },
        },
        ':order' => __LINE__,
    },

    'peer-cert-signed-by-unknown-CA' => {
        # peer cert signed by unknown CA, must fail
        'expect' => 'fail',
        'server2-extra' => {
            'SSL' => {
                'CertFile' => "$x509_dir/CA2/server2.example.com.crt",
                'KeyFile' => "$x509_dir/CA2/server2.example.com.key",
            },
        },
        ':order' => __LINE__,
    },

    'peer-cert-signed-by-unknown-CA-but-verify-disabled' => {
        'expect' => 'pass',
        'server1-extra' => {
            'Server' => {
                'SSLVerify' => 'no',
            }
        },
        'server2-extra' => {
            'SSL' => {
                'CertFile' => "$x509_dir/CA2/server2.example.com.crt",
                'KeyFile' => "$x509_dir/CA2/server2.example.com.key",
            },
        },
        'pass' => qr/Synchronization with "ngircd\.test\.server2" done/,
        'noop' => qr/Certificate validation failed/,
        ':order' => __LINE__,
    },

    'peer-cert-revoked' => {
        # certificate is revoked, must fail
        'expect' => 'fail',
        'server1-extra' => {
            'SSL' => {
                'CAFile' => "$x509_dir/CA3/root-ca.crt",
                'CertFile' => "$x509_dir/CA3/server1.example.com.crt",
                'KeyFile' => "$x509_dir/CA3/server1.example.com.key",
                'CRLFile' => "$x509_dir/CA3/crl.pem",
            },
        },
        'server2-extra' => {
            'SSL' => {
                'CAFile' => "$x509_dir/CA3/root-ca.crt",
                'CertFile' => "$x509_dir/CA3/server2.example.com.crt",
                'KeyFile' => "$x509_dir/CA3/server2.example.com.key",
            },
        },
        ':order' => __LINE__,
    },

    'peer-cert-revoked-but-verify-disabled' => {
        'expect' => 'pass',
        'server1-extra' => {
            'SSL' => {
                'CAFile' => "$x509_dir/CA3/root-ca.crt",
                'CertFile' => "$x509_dir/CA3/server1.example.com.crt",
                'KeyFile' => "$x509_dir/CA3/server1.example.com.key",
                'CRLFile' => "$x509_dir/CA3/crl.pem",
            },
            'Server' => {
                'SSLVerify' => 'no',
            }
        },
        'server2-extra' => {
            'SSL' => {
                'CAFile' => "$x509_dir/CA3/root-ca.crt",
                'CertFile' => "$x509_dir/CA3/server2.example.com.crt",
                'KeyFile' => "$x509_dir/CA3/server2.example.com.key",
            },
        },
        'pass' => qr/Synchronization with "ngircd\.test\.server2" done/,
        'noop' => qr/Certificate validation failed/,
        ':order' => __LINE__,
    },

    'revocation-by-wrong-CA' => {
        # CRL signed by a different CA
        'expect' => 'fail',
        'server1-extra' => {
            'SSL' => {
                'CRLFile' => "$x509_dir/CA2/crl.pem",
            },
        },
        ':order' => __LINE__,
    },

    'wildcard-cert' => {
        # server uses a wildcard certificate
        'expect' => 'pass',
        'server1-extra' => {
            'SSL' => {
                'CAFile' => "$x509_dir/CA4/root-ca.crt",
                'CertFile' => "$x509_dir/CA4/server1.example.com.crt",
                'KeyFile' => "$x509_dir/CA4/server1.example.com.key",
            },
        },
        'server2-extra' => {
            'SSL' => {
                'CAFile' => "$x509_dir/CA4/root-ca.crt",
                'CertFile' => "$x509_dir/CA4/*.example.com.crt",
                'KeyFile' => "$x509_dir/CA4/*.example.com.key",
            },
        },
        ':order' => __LINE__,
    },

    'mixed-case' => {
        # uppercase letters in certificate name
        'expect' => 'pass',
        'server1-extra' => {
            'SSL' => {
                'CAFile' => "$x509_dir/CA5/root-ca.crt",
                'CertFile' => "$x509_dir/CA5/server1.example.com.crt",
                'KeyFile' => "$x509_dir/CA5/server1.example.com.key",
            },
        },
        'server2-extra' => {
            'SSL' => {
                'CAFile' => "$x509_dir/CA5/root-ca.crt",
                'CertFile' => "$x509_dir/CA5/Server2.example.com.crt",
                'KeyFile' => "$x509_dir/CA5/Server2.example.com.key",
            },
        },
        ':order' => __LINE__,
    },

    'subject-alternate-name' => {
        'expect' => 'pass',
        'server1-extra' => {
            'SSL' => {
                'CAFile' => "$x509_dir/CA6/root-ca.crt",
                'CertFile' => "$x509_dir/CA6/server1.example.com.crt",
                'KeyFile' => "$x509_dir/CA6/server1.example.com.key",
            },
        },
        'server2-extra' => {
            'SSL' => {
                'CAFile' => "$x509_dir/CA6/root-ca.crt",
                'CertFile' => "$x509_dir/CA6/server2.example.com.crt",
                'KeyFile' => "$x509_dir/CA6/server2.example.com.key",
            },
        },
        ':order' => __LINE__,
    },

    'subject-alternate-name-mismatch' => {
        'expect' => 'fail',
        'pass' => qr/Failed to verify the hostname, expected/,
        'server1-extra' => {
            'SSL' => {
                'CAFile' => "$x509_dir/CA6/root-ca.crt",
                'CertFile' => "$x509_dir/CA6/server1.example.com.crt",
                'KeyFile' => "$x509_dir/CA6/server1.example.com.key",
            },
        },
        'server2-extra' => {
            'SSL' => {
                'CAFile' => "$x509_dir/CA6/root-ca.crt",
                'CertFile' => "$x509_dir/CA6/server3.example.com.crt",
                'KeyFile' => "$x509_dir/CA6/server3.example.com.key",
            },
        },
        ':order' => __LINE__,
    },

    'cert-expired' => {
        'expect' => 'fail',
        'pass' => qr/SSL error: A TLS fatal alert has been received/,
        'prefix' => [ 'faketime', "\@$one_month_future" ],
        ':order' => __LINE__,
    },
);


sub write_config {
    my ($file, $number, $tls_mode, @extras) = @_;

    my $cipher_list = ($tls_mode =~ /^o/ ?
        'HIGH:!aNULL:@STRENGTH:!SSLv3' :
        'SECURE128:-VERS-SSL3.0'
    );

    my $peer_number = 3 - $number;

    # write server configurations
    my %config = (
        'Global' => {
            'Name' => "ngircd.test.server$number",
            'Info' => "ngIRCd Test-Server $number",
            'Listen' => '127.0.0.1',
            'Ports' => "678$number",
            'AdminEMail' => "admin\@server$number.example",
            'ServerUID' => $<,
            'ServerGID' => $(,
            'MotdFile' => '/dev/null',
        },
        'Options' => {
            'OperCanUseMode' => 'yes',
            'Ident' => 'no',
            'IncludeDir' => '',
            'PAM' => 'no',
        },
        'Operator' => {
            'Name' => 'TestOp',
            'Password' => '123',
        },
        'Server' => {
            'Name' => "ngircd.test.server$peer_number",
            'Host' => "server$peer_number.example.com",
            'Port' => "669$peer_number",
            'MyPassword' => "pwd$number",
            'PeerPassword' => "pwd$peer_number",
            'SSLConnect' => 'yes',
            'SSLVerify' => 'yes',
        },
        'SSL' => {
            'CAFile' => "$x509_dir/CA1/root-ca.crt",
            'CertFile' => "$x509_dir/CA1/server$number.example.com.crt",
            'CipherList' => $cipher_list,
            'DHFile' => "$x509_dir/dhparams.pem",
            'KeyFile' => "$x509_dir/CA1/server$number.example.com.key",
            'Ports' => "669$number",
        },
    );

    foreach my $extra (@extras) {
        foreach my $section (keys %$extra) {
            foreach my $key (keys %{$extra->{$section}}) {
                if (
                    exists ($config{$section}{$key}) &&
                    defined ($config{$section}{$key}) &&
                    exists ($extra->{$section}{$key}) &&
                    defined ($extra->{$section}{$key}) &&
                    $config{$section}{$key} eq $extra->{$section}{$key}
                ) {
                    note ("W: Identical re-definition of server/section/key: $number/$section/$key");
                }
                $config{$section}{$key} = $extra->{$section}{$key};
            }
        }
    }

    my $return = '';
    my $fh;
    open ($fh, '>', \$return);
    foreach my $section (sort keys %config) {
        print $fh "[$section]\n";
        foreach my $key (sort keys %{$config{$section}}) {
            my $value = $config{$section}{$key};
            defined ($value) and
                printf $fh "    %s = %s\n", $key, $value;
        }
    }
    close ($fh);

    write_file ($file, $return);
}


sub write_configs {
    my (
        $server1_config_file,
        $server2_config_file,
        $server1_config_extra,
        $server2_config_extra,
    ) = @_;

    write_config (
        $server1_config_file,
        '1',
        $tls_mode[0],
        {
            'SSL' => {
                'Ports' => undef,
            },
        },
        $server1_config_extra,
    );

    write_config (
        $server2_config_file,
        '2',
        $tls_mode[1],
        {
            'Server' => {
                'Passive' => 'yes',
            },
        },
        $server2_config_extra,
    );
}


sub test1 {
    my ($name, $test) = @_;

    {
        my $l = length ($name);
        note ('+-' . ('-' x $l) . '-+');
        note ("| $name | ");
        note ('+-' . ('-' x $l) . '-+');
    }

    my $server1_config = "$conf_dir/ngircd-test1.conf";
    my $server2_config = "$conf_dir/ngircd-test2.conf";
    write_configs (
        $server1_config,
        $server2_config,
        $test->{'server1-extra'},
        $test->{'server2-extra'},
    ),

    my $prefix = $test->{'prefix'} // [];

    # start the receiving server2 first, it might need a
    # little extra time
    my $server2_log = "$temp_dir/server2.log";
    write_file ($server2_log, '');  # so open below won't fail
    my $server2 = Proc::Simple->new;
    $server2->redirect_output ($server2_log, $server2_log);
    $server2->start ((
        @$prefix,
        $ngircd_exe[1],
        '--config', $server2_config,
        '--nodaemon',
    ));
    $server2->kill_on_destroy (1);
    sleep (0.5);

    # start connecting server1
    my $server1_log = "$temp_dir/server1.log";
    write_file ($server1_log, '');  # so open below won't fail
    my $server1 = Proc::Simple->new;
    $server1->redirect_output ($server1_log, $server1_log);
    $server1->start ((
        @$prefix,
        $ngircd_exe[0],
        '--config', $server1_config,
        '--nodaemon',
    ));
    $server1->kill_on_destroy (1);
    sleep (0.5);

    my $fh;
    open ($fh, '<', $server1_log) or
        die ("Cannot read '$server1_log': $!");

    # read output from server1, find 'pass' or 'fail' line
    my $timeout = time + 10;

    my $t0 = time;
    my $firstline;
    my $got_verdict;
TAIL:
    while (1) {
        if (time > $timeout) {
            fail (sprintf ('Timeout (%u sec)', time - $t0));
            last TAIL;
        }
        my $curpos;
        my $line;
        for ($curpos = tell ($fh); $line = <$fh>; $curpos = tell ($fh)) {
            chomp ($line);
            $firstline //= $line;
            $verbose and note (sprintf ('%.2f %s', time-$t0, $line));

            # generic pass/fail pattern
            my $passed;
            if ($line =~ /(Can't bind socket to address 127\.0\.0\.1.*$)/) {
                # previous instance running
                fail ($1);
                $got_verdict = 1;
                last TAIL;
            } elsif (
                # configured pass/fail pattern
                $test->{'pass'} && $line =~ /$test->{'pass'}/
            ) {
                $passed = 1;
            } elsif ($test->{'fail'} && $line =~ /$test->{'fail'}/) {
                $passed = 0;
            } elsif ($test->{'noop'} && $line =~ /$test->{'noop'}/) {
                next;
            } elsif ($line =~ /Synchronization with "ngircd\.test\.server2" done/) {
                $passed = $test->{'expect'};
            } elsif ($line =~ /Certificate validation failed/) {
                $passed = 1 - $test->{'expect'};
            } elsif ($line =~ /Fatail: /) {
                # some fatal error
                fail ($1);
            }
            if (defined ($passed)) {
                if ($passed) {
                    pass ("Got expected line: '$line'");
                } else {
                    fail ("Got line that should not be there: '$line'");
                }
                $got_verdict = 1;
                last TAIL;
            }
        }
        if (!$server1->poll) {
            note ('server1 has left the building');
            $got_verdict = 1;
            last TAIL;
        }
        sleep (0.1);
        seek ($fh, $curpos, 0);
    }
    close ($fh);

    $server1->kill;
    $server2->kill;

    wait;

    ok ($got_verdict, 'have a verdict');

    if ($firstline && $firstline =~ /^\[[0-9]+:[0-9] +[0-9]+\./) {
        # have absolute timestamps
        my @log = read_file ($server1_log);
        my $first_server2_line = scalar (@log);
        push @log, read_file ($server2_log);

my $RED = "\e[1;31m";
my $GREEN = "\e[1;32m";
my $NORMAL = "\e[0m";


        my @log_sorter;
        for (my $i = 0; $i < scalar (@log); $i++) {
            my $line = $log[$i];
            chomp ($line);
            my $srt;
            my $server = $i < $first_server2_line ? 1 : 2;
            if ($line =~ /^
                \[
                (?<pid>[0-9]+):
                (?<prio>[0-9])\s+
                (?<time>[0-9]+\.[0-9]+)
                \]\s(?<msg>.+)
            $/x) {
                $srt = [
                    $+{'time'},
                    $server,
                    $+{'prio'},
                    $+{'msg'},
                ];
            } else {
                fail ("Cannot parse log line '$line'");
                $srt = [ 0, $server, 0, $line ];
            }
            $log_sorter[$i] = $srt;
        }

        # sort the log file by time, process, line
        my @idx = sort {
            $log_sorter[$a][0] <=> $log_sorter[$b][0] ||
            $log_sorter[$a][1] <=> $log_sorter[$b][1] ||
            $log_sorter[$a][3] cmp $log_sorter[$b][3] ||
            $a cmp $b
        } 0..$#log_sorter;

        note ('combined log ([server:prio ms])');
        my $t1 = $log_sorter[$idx[0]][0];
        foreach my $idx (@idx) {
            my $data = $log_sorter[$idx];
            note (sprintf (
                '| %s[%s:%d %.6f] %s%s',
                ($data->[1] == 1 ? $GREEN : $RED),
                $data->[1],
                $data->[2],
                $data->[0] - $t1,
                $data->[3],
                $NORMAL,
            ));
        }
    } else {
        # Just combine
        my @log;
        @log = read_file ($server1_log);
        note ('server 1 log:');
        foreach my $line (@log) {
            note ("1: $line");
        }
        @log = read_file ($server2_log);
        note ('server 2 log:');
        foreach my $line (@log) {
            note ("2: $line");
        }
    }
}


# start the show

if ($x509_populate) {
    note ('setting up x509 stuff');

    my $fail_x509;

    $ENV{'RNDFILE'} = "$temp_dir/.rnd";

    for my $f (qw<dhparams.pem openssl.cnf openssl.san.cnf>) {
        copy ("$src_dir/data/$f", "$x509_dir/$f") or
            die ("Failed to copy $f: $!");
    }

    foreach my $command ((
        [ "$src_dir/gen-x509-stuff", $x509_dir, qw<CA1 server1.example.com> ],
        [ "$src_dir/gen-x509-stuff", $x509_dir, qw<CA1 server2.example.com> ],
        [ "$src_dir/gen-x509-stuff", $x509_dir, qw<CA1 server3.example.com> ],

        [ "$src_dir/gen-x509-stuff", $x509_dir, qw<CA2 server2.example.com> ],

        [ "$src_dir/gen-x509-stuff", $x509_dir, qw<CA3 server1.example.com> ],
        [ "$src_dir/gen-x509-stuff", $x509_dir, qw<--revoke CA3 server2.example.com> ],

        [ "$src_dir/gen-x509-stuff", $x509_dir, qw<CA4 server1.example.com> ],
        [ "$src_dir/gen-x509-stuff", $x509_dir, qw<CA4 *.example.com> ],

        [ "$src_dir/gen-x509-stuff", $x509_dir, qw<CA5 server1.example.com> ],
        [ "$src_dir/gen-x509-stuff", $x509_dir, qw<CA5 Server2.example.com> ],

        [ "$src_dir/gen-x509-stuff", $x509_dir, qw<CA6 server1.example.com> ],
        [ "$src_dir/gen-x509-stuff", $x509_dir, qw<--san CA6 server2.example.com> ],
        [ "$src_dir/gen-x509-stuff", $x509_dir, qw<--san CA6 server3.example.com> ],
    )) {
        my $run = Proc::Simple->new;
        my $log = "$temp_dir/gen-stuff.log";
        write_file ($log, '');
        $run->redirect_output ($log, $log);
        $run->start (@$command);
        my $exit = $run->wait;
        my $fail = !is (
            $exit,
            0,
            'gen-x509-stuff ' . join (' ', @$command[2..$#$command]),
        );
        $fail and $fail_x509++;
        if ($fail || $verbose) {
            my $out = read_file ($log);
            $log and note ("Output:\n$out");
        }
    }
    $fail_x509 and exit 1;
    if ($exit_after_x509_populate) {
        pass ('here we go');
        done_testing;
        exit 0;
    }
}

$ENV{'LD_PRELOAD'} = 'libnss_wrapper.so';
$ENV{'NSS_WRAPPER_HOSTS'} = $hosts_file;

note ('checking mocked resolver');
{
    my $fail;

    foreach my $hostname (qw<server1 server2>) {
        my $output = `getent hosts $hostname`;
        is ($?, 0, "resolve $hostname") or $fail++;
        is ($?, 0, "resolve $hostname.example.com") or $fail++;
    }
}

my @tests;
# check test description integrity
{
    my $fail;
    my @required = qw<expect :order>;  # NB: pass and fail may be missing
    foreach my $test (sort keys %tests) {
        foreach my $r (@required) {
            exists ($tests{$test}{$r}) and next;
            fail ("No '$r' field in test '$test'");
            $fail++;
        }
    }
    $fail and die ('Cannot continue');
    @tests =
        sort { $tests{$a}{':order'} <=> $tests{$b}{':order'} }
        keys %tests;

    foreach my $test (@tests) {
        my $got = $tests{$test}{'expect'};
        if ($got =~ /^(pass|fail)$/) {
            $tests{$test}{'expect'} = $got eq 'pass' ? 1 : 0;
            next;
        }
        fail ("The 'expect' in test '$test' is '$got', not 'pass' or 'fail'");
        $fail++;
    }
    $fail and die ('Cannot continue');
    # drop those who are expected to fail
    @tests = grep { !$tests{$_}{'unsupported'} } @tests;
}

if (@ARGV) {
    my $warned;
    foreach my $t (@ARGV) {
        if (exists ($tests{$t})) {
            $tests{$t}{'unsupported'} and
                note ("Warn: Test '$t' is marked unsupported. Expect breakage");
            test1 ($t, $tests{$t});
            next;
        }
        fail ("Don't know how to test '$t'");
        if (!$warned) {
            note ("Available tests:\n" . join ("\n", map { "    $_" } @tests));
            $warned = 1;
        }
    }
} else {
    # run all
    foreach my $test (@tests) {
        test1 ($test, $tests{$test});
    }
}

done_testing;

exit 0;

=head1 DESCRIPTION

Build ngircd for both TLS linkages, possibly using the following script:

    #!/bin/sh
    set -e
    case "$1" in
        openssl | gnutls)
            [ -f ./configure ] || ./autogen.sh
            ./configure \
                --prefix=/usr \
                --mandir="\${prefix}/share/man" \
                --infodir="\${prefix}/share/info" \
                --sysconfdir=/etc/ngircd \
                "--with-$1"
            make 2>&1 | tee "../build.$1.log"
            cp src/ngircd/ngircd "../ngircd-$1"
            ;;
        *)
            echo "Usage: $0 <gnutls|openssl>"
            exit 1
            ;;
    esac

One time only: Create the certificates

    perl ngircd-test-tls-link \
        --x509-populate \
        --x509-dir ../x509-data/ \
        --ngircd <path to any ngircd binary>

Then run this program

For GnuTLS:

    ngircd-test-tls-link \
        --x509-dir ../x509-data/ \
        --ngircd ../ngircd-gnutls

Likewise for OpenSSL:

    (...)
        --ngircd ../ngircd-openssl

For interoperability tests:

    ngircd-test-tls-link \
        --x509-dir ../x509-data/ \
        --ngircd ../ngircd-gnutls:../ngircd-openssl

... also with the two binaries swapped.

=head1 DEPENDENCIES

The following programs, libraries and Perl modules must be installed:

    faketime
    openssl
    libnss-wrapper
    File::Slurp
    Proc::Simple

=head1 BUGS

Hack.

=head1 SEE ALSO

ngircd(8)

=head1 AUTHOR

Christoph Biedl C<< <debian.axhn@manchmal.in-ulm.de> >>

=head1 ACKNOWLEDGEMENTS

Alex Barton for ngircd.

=head1 COPYRIGHT & LICENSE

    Copyright (C) 2014-2024 Christoph Biedl <debian.axhn@manchmal.in-ulm.de>

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License as
    published by the Free Software Foundation; either version 2 of the
    License, or (at your option) any later version.

    This package is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program. If not, see <http://www.gnu.org/licenses/>

    On Debian systems, the complete text of the GNU General Public
    License version 2 can be found in
    "/usr/share/common-licenses/GPL-2".

=cut