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