tests/tools/heimdal-history-t

   1 #!/usr/bin/perl
   2 #
   3 # Test suite for Heimdal per-principal history.
   4 #
   5 # Written by Russ Allbery <eagle@eyrie.org>
   6 # Copyright 2020 Russ Allbery <eagle@eyrie.org>
   7 # Copyright 2014
   8 #     The Board of Trustees of the Leland Stanford Junior University
   9 #
  10 # SPDX-License-Identifier: MIT
  11
  12 use 5.006;
  13 use strict;
  14 use warnings;
  15
  16 use lib "$ENV{SOURCE}/tap/perl";
  17
  18 use Test::RRA qw(use_prereq);
  19 use Test::RRA::Automake qw(test_file_path test_tmpdir);
  20
  21 use Fcntl qw(O_CREAT O_RDWR);
  22 use Test::More;
  23
  24 # Not all of these are used by the test suite, but the rest are required to
  25 # run the program we're testing, so make sure they can all be loaded.
  26 use_prereq('DB_File::Lock');
  27 use_prereq('Crypt::PBKDF2');
  28 use_prereq('Getopt::Long::Descriptive');
  29 use_prereq('IPC::Run', 'run');
  30 use_prereq('JSON');
  31 use_prereq('Perl6::Slurp', 'slurp');
  32 use_prereq('Readonly');
  33
  34 # The most convenient interface to Berkeley DB files is ties.
  35 ## no critic (Miscellanea::ProhibitTies)
  36
  37 # Run the heimdal-history command and return the status, output, and error
  38 # output as a list.
  39 #
  40 # $principal - Principal to pass to the command
  41 # $password  - Password to pass to the command
  42 # @extra     - Additional options to pass to heimdal-history
  43 #
  44 # Returns: The exit status, standard output, and standard error as a list
  45 #  Throws: Text exception on failure to run the test program
  46 sub run_heimdal_history {
  47     my ($principal, $password, @extra) = @_;
  48
  49     # Build the input to the strength checking program.
  50     my $in = "principal: $principal\n";
  51     $in .= "new-password: $password\n";
  52     $in .= "end\n";
  53
  54     # Find the newly-built history and strengty programs.
  55     my $history  = test_file_path('../tools/heimdal-history');
  56     my $strength = test_file_path('../tools/heimdal-strength');
  57
  58     # Get a temporary directory for statistics and history databases.
  59     my $tmpdir = test_tmpdir();
  60
  61     # Assemble the standard options.
  62     my @options = (
  63         '-q',
  64         '-d' => "$tmpdir/history.db",
  65         '-S' => "$tmpdir/lengths.db",
  66         '-s' => $strength,
  67     );
  68     push(@options, @extra);
  69
  70     # Run the password strength checker.
  71     my ($out, $err);
  72     run([$history, @options, $principal], \$in, \$out, \$err);
  73     my $status = ($? >> 8);
  74
  75     # Return the results.
  76     return ($status, $out, $err);
  77 }
  78
  79 # Run the heimdal-history command to check a password and reports the results
  80 # using Test::More.  This uses the standard protocol for Heimdal external
  81 # password strength checking programs.
  82 #
  83 # $test_ref - Reference to hash of test parameters
  84 #   name      - The name of the test case
  85 #   principal - The principal changing its password
  86 #   password  - The new password
  87 #   status    - If present, the exit status (otherwise, it should be 0)
  88 #   error     - If present, the expected rejection error
  89 #
  90 # Returns: undef
  91 #  Throws: Text exception on failure to run the test program
  92 sub check_password {
  93     my ($test_ref) = @_;
  94     my $principal  = $test_ref->{principal};
  95     my $password   = $test_ref->{password};
  96
  97     # Run the heimdal-strength command.
  98     my ($status, $out, $err) = run_heimdal_history($principal, $password);
  99     chomp($out, $err);
 100
 101     # Check the results.  If there is an error in the password, it should come
 102     # on standard error; otherwise, standard output should be APPROVED.  If
 103     # there is a non-zero exit status, we expect the error on standard error
 104     # and use that field to check for system errors.
 105     is($status, $test_ref->{status} || 0, "$test_ref->{name} (status)");
 106     if (defined($test_ref->{error})) {
 107         is($err, $test_ref->{error}, '...error message');
 108         is($out, q{},                '...no output');
 109     } else {
 110         is($err, q{},        '...no errors');
 111         is($out, 'APPROVED', '...approved');
 112     }
 113     return;
 114 }
 115
 116 # Load a set of password test cases and return them as a list.  The given file
 117 # name is relative to data/passwords in the test suite.
 118 #
 119 # $file - The file name containing the test data in JSON
 120 #
 121 # Returns: List of anonymous hashes representing password test cases
 122 #  Throws: Text exception on failure to load the test data
 123 sub load_password_tests {
 124     my ($file) = @_;
 125     my $path = test_file_path("data/passwords/$file");
 126
 127     # Load the test file data into memory.
 128     my $testdata = slurp($path);
 129
 130     # Decode the JSON into Perl objects and return them.
 131     my $json = JSON->new->utf8;
 132     return $json->decode($testdata);
 133 }
 134
 135 # Load our tests from JSON source.
 136 my $tests = load_password_tests('history.json');
 137
 138 # Calculate and declare the plan.  We run three tests for each password test,
 139 # and then do some additional testing of the length statistics.
 140 plan(tests => scalar(@{$tests}) * 3 + 8);
 141
 142 # Point to a generic krb5.conf file.  This ensures that the heimdal-strength
 143 # program will only do principal-based strength checks.
 144 local $ENV{KRB5_CONFIG} = test_file_path('data/krb5.conf');
 145
 146 # Run the basic history tests and accumulate the length statistics.
 147 my %lengths;
 148 for my $test_ref (@{$tests}) {
 149     check_password($test_ref);
 150     if (!defined($test_ref->{error})) {
 151         $lengths{ length($test_ref->{password}) }++;
 152     }
 153 }
 154
 155 # Open the length database and check that it is correct.
 156 my %lengthdb;
 157 my $mode = O_CREAT | O_RDWR;
 158 my $path = test_tmpdir() . '/lengths.db';
 159 ok(tie(%lengthdb, 'DB_File::Lock', [$path, $mode, oct(600)], 'write'),
 160     'Length database exists');
 161 is_deeply(\%lengthdb, \%lengths, '...and contents are correct');
 162
 163 # Check the same password twice in a row with the -c option.  It should be
 164 # accepted both times, instead of rejected the second time as a duplicate.
 165 my ($status, $out, $err)
 166   = run_heimdal_history('test@EXAMPLE.ORG', 'somepass', '-c');
 167 is($status, 0,            'First password check succeeds');
 168 is($out,    "APPROVED\n", '...with correct output');
 169 is($err,    q{},          '...and no error');
 170 ($status, $out, $err)
 171   = run_heimdal_history('test@EXAMPLE.ORG', 'somepass', '-c');
 172 is($status, 0,            'Second password check still succeeds');
 173 is($out,    "APPROVED\n", '...with correct output');
 174 is($err,    q{},          '...and no error');
 175
 176 # Clean up the databases and lock files on any exit.
 177 END {
 178     my $tmpdir = test_tmpdir();
 179     for my $file (qw(history.db lengths.db)) {
 180         unlink("$tmpdir/$file", "$tmpdir/$file.lock")
 181           or warn "cannot unlink $tmpdir/$file: $!\n";
 182     }
 183 }