#!/usr/bin/perl
#
# Test suite for basic Heimdal external strength checking functionality.
#
# Written by Russ Allbery <eagle@eyrie.org>
# Copyright 2016, 2017, 2020 Russ Allbery <eagle@eyrie.org>
# Copyright 2009, 2012, 2013, 2014
#     The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.

use 5.006;
use strict;
use warnings;

use lib "$ENV{SOURCE}/tap/perl";

use File::Copy qw(copy);
use Test::RRA qw(use_prereq);
use Test::RRA::Automake qw(test_file_path);

use_prereq('IPC::Run', 'run');
use_prereq('JSON');
use_prereq('Perl6::Slurp', 'slurp');
use_prereq('Test::More',   '0.87_01');

# Data directory to use for dictionaries.
my $DATADIR = $ENV{BUILD} ? "$ENV{BUILD}/data" : 'tests/data';

# This data structure drives most of our tests.  Each list element is a block
# of tests to run together with a specific Kerberos configuration.  The keys
# are:
#
# title  - Title of the tests for test output
# config - Hash of Kerberos configuration to use
# needs  - Dictionary type name we have to have to run this test
# tests  - List of classes of tests to run (JSON files in tests/data/passwords)
my @TESTS = (
    {
        title  => 'Generic tests',
        config => {},
        tests  => [qw(principal)],
    },
    {
        title  => 'CrackLib tests',
        config => { password_dictionary => "$DATADIR/dictionary" },
        needs  => 'CrackLib',
        tests  => [qw(cracklib principal)],
    },
    {
        title  => 'Password length tests',
        config => { minimum_length => 12 },
        tests  => [qw(length)],
    },
    {
        title  => 'Password length tests with cracklib_maxlen',
        config => {
            password_dictionary => "$DATADIR/dictionary",
            minimum_length      => 12,
            cracklib_maxlen     => 11,
        },
        needs => 'CrackLib',
        tests => [qw(length)],
    },
    {
        title  => 'Simple password character class tests',
        config => {
            minimum_different       => 8,
            require_ascii_printable => 'true',
            require_non_letter      => 'true',
        },
        tests => [qw(letter)],
    },
    {
        title  => 'Complex password character class tests',
        config => {
            require_classes =>
              '8-19:lower,upper 8-15:digit 8-11:symbol 24-24:3',
        },
        tests => [qw(classes)],
    },
    {
        title => 'CDB tests',
        config =>
          { password_dictionary_cdb => test_file_path('data/wordlist.cdb') },
        tests => [qw(cdb principal)],
    },
    {
        title  => 'SQLite tests',
        config => {
            password_dictionary_sqlite =>
              test_file_path('data/wordlist.sqlite'),
        },
        tests => [qw(sqlite principal)],
    },
);

# Run the newly-built heimdal-strength command and return the status, output,
# and error output as a list.  If told to expect an immediate error, does not
# pass input to the process.
#
# $principal - Principal to pass to the command
# $password  - Password to pass to the command
# $error     - Whether to expect an immediate error
#
# Returns: The exit status, standard output, and standard error as a list
#  Throws: Text exception on failure to run the test program
sub run_heimdal_strength {
    my ($principal, $password, $error) = @_;

    # Build the input to the strength checking program.
    my $in = q{};
    if (!$error) {
        $in .= "principal: $principal\n";
        $in .= "new-password: $password\n";
        $in .= "end\n";
    }

    # Find the newly-built password checking program.
    my $program = test_file_path('../tools/heimdal-strength');

    # Run the password strength checker.
    my ($out, $err);
    my $harness = run([$program, $principal], \$in, \$out, \$err);
    my $status  = $? >> 8;

    # Return the results.
    return ($status, $out, $err);
}

# Run the newly-built heimdal-strength command to check a password and reports
# the results using Test::More.  This uses the standard protocol for Heimdal
# external password strength checking programs.
#
# $test_ref - Reference to hash of test parameters
#   name      - The name of the test case
#   principal - The principal changing its password
#   password  - The new password
#   status    - If present, the exit status (otherwise, it should be 0)
#   error     - If present, the expected rejection error
#
# Returns: undef
#  Throws: Text exception on failure to run the test program
sub check_password {
    my ($test_ref) = @_;
    my $principal  = $test_ref->{principal};
    my $password   = $test_ref->{password};

    # Run the heimdal-strength command.
    my ($status, $out, $err) = run_heimdal_strength($principal, $password);
    chomp($out, $err);

    # Check the results.  If there is an error in the password, it should come
    # on standard error; otherwise, standard output should be APPROVED.  If
    # there is a non-zero exit status, we expect the error on standard error
    # and use that field to check for system errors.
    is($status, $test_ref->{status} || 0, "$test_ref->{name} (status)");
    if (defined($test_ref->{error})) {
        is($err, $test_ref->{error}, '...error message');
        is($out, q{},                '...no output');
    } else {
        is($err, q{},        '...no errors');
        is($out, 'APPROVED', '...approved');
    }
    return;
}

# Create a new krb5.conf file that includes arbitrary settings passed in via
# a hash reference.
#
# $settings_ref - Hash of keys and values to put into [appdefaults]
#
# Returns: Path to the new krb5.conf file
#  Throws: Text exception if the new krb5.conf file cannot be created
sub create_krb5_conf {
    my ($settings_ref) = @_;

    # Paths for krb5.conf creation.
    my $old    = test_file_path('data/krb5.conf');
    my $tmpdir = $ENV{BUILD} ? "$ENV{BUILD}/tmp" : 'tests/tmp';
    my $new    = "$tmpdir/krb5.conf";

    # Create a temporary directory for the new file.
    if (!-d $tmpdir) {
        mkdir($tmpdir, 0777) or die "Cannot create $tmpdir: $!\n";
    }

    # Start with the testing krb5.conf file shipped in the package.
    copy($old, $new) or die "Cannot copy $old to $new: $!\n";

    # Append the local configuration.
    open(my $config, '>>', $new) or die "Cannot append to $new: $!\n";
    print {$config} "\n[appdefaults]\n    krb5-strength = {\n"
      or die "Cannot append to $new: $!\n";
    for my $key (keys %{$settings_ref}) {
        print {$config} q{ } x 8, $key, ' = ', $settings_ref->{$key}, "\n"
          or die "Cannot append to $new: $!\n";
    }
    print {$config} "    }\n"
      or die "Cannot append to $new: $!\n";
    close($config) or die "Cannot append to $new: $!\n";

    # Return the path to the new file.
    return $new;
}

# Load a set of password test cases and return them as a list.  The given file
# name is relative to data/passwords in the test suite.
#
# $file - The file name containing the test data in JSON
#
# Returns: List of anonymous hashes representing password test cases
#  Throws: Text exception on failure to load the test data
sub load_password_tests {
    my ($file) = @_;
    my $path = test_file_path("data/passwords/$file");

    # Load the test file data into memory.
    my $testdata = slurp($path);

    # Decode the JSON into Perl objects and return them.
    my $json = JSON->new->utf8;
    return $json->decode($testdata);
}

# Run a block of password tests, handling krb5.conf setup and skipping tests
# if required dictionary support isn't available.
#
# $spec_ref  - Test specification (from @TESTS)
# $tests_ref - Hash structure containing all loaded password tests
#
# Returns: undef
sub run_password_tests {
    my ($spec_ref, $tests_ref) = @_;
    my $krb5_conf = create_krb5_conf($spec_ref->{config});
    local $ENV{KRB5_CONFIG} = $krb5_conf;
    note($spec_ref->{title});

    # If we need support for a type of dictionary, check for that and skip the
    # tests if that dictionary wasn't supported.
  SKIP: {
        if ($spec_ref->{needs}) {
            my $type = $spec_ref->{needs};
            my ($status, undef, $err) = run_heimdal_strength('test', 'pass');
            my $err_regex = qr{ not [ ] built [ ] with [ ] \Q$type\E }xms;
            if ($status == 1 && $err =~ $err_regex) {
                my $total = 0;
                for my $block (@{ $spec_ref->{tests} }) {
                    $total += scalar(@{ $tests_ref->{$block} });
                }
                skip("not built with $type support", $total * 3);
            }
        }

        # Run the tests.
        for my $block (@{ $spec_ref->{tests} }) {
            if (scalar(@{ $spec_ref->{tests} }) > 1) {
                note('... ', $block);
            }
            for my $test (@{ $tests_ref->{$block} }) {
                check_password($test);
            }
        }
    }
    return;
}

# Test a required_classes syntax error.  Takes the string for required_classes
# and verifies that the appropriate error message is returned.
#
# $bad_class - Bad class specification
#
# Returns: undef
sub test_require_classes_syntax {
    my ($bad_class)  = @_;
    my $error_prefix = 'Cannot initialize strength checking';
    my $bad_message  = 'bad character class requirement in configuration';
    my $bad_minimum  = 'bad character class minimum in configuration';

    # Run heimdal-strength.
    my $krb5_conf = create_krb5_conf({ require_classes => $bad_class });
    local $ENV{KRB5_CONFIG} = $krb5_conf;
    my ($status, $output, $err) = run_heimdal_strength('test', 'password', 1);

    # Check the results.
    is($status, 1,   "Bad class specification '$bad_class' (status)");
    is($output, q{}, '...no output');
    my $expected;
    if ($bad_class =~ m{ \A (\d+ [^-]*) \z | : (\d+) \z }xms) {
        my $minimum = $1 || $2;
        $expected = "$error_prefix: $bad_minimum: $minimum\n";
    } else {
        $expected = "$error_prefix: $bad_message: $bad_class\n";
    }
    is($err, $expected, '...correct error');
    return;
}

# Load the password tests from JSON.
my %tests;
for my $type (qw(cdb classes cracklib length letter principal sqlite)) {
    my $tests = load_password_tests("$type.json");
    $tests{$type} = $tests;
}

# Determine our plan based on the test blocks we run (there are three test
# results for each password test), plus 27 additional tests for error
# handling.
my $count = 0;
for my $spec_ref (@TESTS) {
    for my $block (@{ $spec_ref->{tests} }) {
        $count += scalar(@{ $tests{$block} });
    }
}
plan(tests => $count * 3 + 27);

# Run all the tests.
for my $spec_ref (@TESTS) {
    run_password_tests($spec_ref, \%tests);
}

# Test error for an unknown character class.
my $krb5_conf = create_krb5_conf({ require_classes => 'bogus' });
local $ENV{KRB5_CONFIG} = $krb5_conf;
my $error_prefix = 'Cannot initialize strength checking';
my ($status, $output, $err) = run_heimdal_strength('test', 'password', 1);
is($status, 1,   'Bad character class (status)');
is($output, q{}, '...no output');
is($err, "$error_prefix: unknown character class bogus\n", '...correct error');

# Test a variety of configuration syntax errors in require_classes.
my @bad_classes = qw(
  8 8bogus 8:bogus 4-:bogus 4-bogus 4-8bogus 10:3 10-11:5
);
for my $bad_class (@bad_classes) {
    test_require_classes_syntax($bad_class);
}

# Clean up our temporary krb5.conf file on any exit.
END {
    my $tmpdir = $ENV{BUILD} ? "$ENV{BUILD}/tmp" : 'tests/tmp';
    my $config = "$tmpdir/krb5.conf";
    if (-f $config) {
        unlink($config) or warn "Cannot remove $config\n";
        rmdir($tmpdir);
    }
}