3 # Test suite for Heimdal per-principal history.
5 # Written by Russ Allbery <eagle@eyrie.org>
6 # Copyright 2020 Russ Allbery <eagle@eyrie.org>
8 # The Board of Trustees of the Leland Stanford Junior University
10 # SPDX-License-Identifier: MIT
16 use lib "$ENV{SOURCE}/tap/perl";
18 use Test::RRA qw(use_prereq);
19 use Test::RRA::Automake qw(test_file_path test_tmpdir);
21 use Fcntl qw(O_CREAT O_RDWR);
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');
31 use_prereq('Perl6::Slurp', 'slurp');
32 use_prereq('Readonly');
34 # The most convenient interface to Berkeley DB files is ties.
35 ## no critic (Miscellanea::ProhibitTies)
37 # Run the heimdal-history command and return the status, output, and error
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
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) = @_;
49 # Build the input to the strength checking program.
50 my $in = "principal: $principal\n";
51 $in .= "new-password: $password\n";
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');
58 # Get a temporary directory for statistics and history databases.
59 my $tmpdir = test_tmpdir();
61 # Assemble the standard options.
64 '-d' => "$tmpdir/history.db",
65 '-S' => "$tmpdir/lengths.db",
68 push(@options, @extra);
70 # Run the password strength checker.
72 run([$history, @options, $principal], \$in, \$out, \$err);
73 my $status = ($? >> 8);
76 return ($status, $out, $err);
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.
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
91 # Throws: Text exception on failure to run the test program
94 my $principal = $test_ref->{principal};
95 my $password = $test_ref->{password};
97 # Run the heimdal-strength command.
98 my ($status, $out, $err) = run_heimdal_history($principal, $password);
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');
110 is($err, q{}, '...no errors');
111 is($out, 'APPROVED', '...approved');
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.
119 # $file - The file name containing the test data in JSON
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 {
125 my $path = test_file_path("data/passwords/$file");
127 # Load the test file data into memory.
128 my $testdata = slurp($path);
130 # Decode the JSON into Perl objects and return them.
131 my $json = JSON->new->utf8;
132 return $json->decode($testdata);
135 # Load our tests from JSON source.
136 my $tests = load_password_tests('history.json');
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);
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');
146 # Run the basic history tests and accumulate the length statistics.
148 for my $test_ref (@{$tests}) {
149 check_password($test_ref);
150 if (!defined($test_ref->{error})) {
151 $lengths{ length($test_ref->{password}) }++;
155 # Open the length database and check that it is correct.
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');
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');
176 # Clean up the databases and lock files on any exit.
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";