tests/tools/wordlist-t

   1 #!/usr/bin/perl
   2 #
   3 # Test suite for krb5-strength-wordlist filtering functions.
   4 #
   5 # Written by Russ Allbery <eagle@eyrie.org>
   6 # Copyright 2016 Russ Allbery <eagle@eyrie.org>
   7 # Copyright 2014
   8 #     The Board of Trustees of the Leland Stanford Junior University
   9 #
  10 # See LICENSE for licensing terms.
  11
  12 use 5.006;
  13 use strict;
  14 use warnings;
  15
  16 use lib "$ENV{SOURCE}/tap/perl";
  17
  18 use Encode qw(encode);
  19 use Test::More;
  20 use Test::RRA qw(use_prereq);
  21 use Test::RRA::Automake qw(automake_setup test_file_path test_tmpdir);
  22
  23 # Load prerequisite modules.
  24 use_prereq('IPC::Run',     'run');
  25 use_prereq('Perl6::Slurp', 'slurp');
  26
  27 # Set up for testing of an Automake project.
  28 automake_setup();
  29
  30 # Declare the plan.
  31 plan tests => 5;
  32
  33 # Run krb5-strength-wordlist with the given arguments and verify that it exits
  34 # successfully with no output.  For planning purposes, this function will
  35 # report three tests.
  36 #
  37 # @args - Arguments to krb5-strength-wordlist
  38 #
  39 # Returns: undef
  40 sub run_wordlist {
  41     my (@args) = @_;
  42
  43     # Find the krb5-strength-wordlist program in the distribution.
  44     my $wordlist = test_file_path('../tools/krb5-strength-wordlist');
  45
  46     # Run the program, capturing its output and status.
  47     my ($out, $err);
  48     run([$wordlist, @args], \undef, \$out, \$err);
  49     my $status = ($? >> 8);
  50
  51     # Check the results.
  52     is($status, 0,   "krb5-strength-wordlist @args");
  53     is($out,    q{}, '...with no output');
  54     is($err,    q{}, '...and no errors');
  55     return;
  56 }
  57
  58 # Read the word list that we'll use for testing.
  59 my @wordlist = slurp(test_file_path('data/wordlist'));
  60
  61 # Generate a filtered version that should match the eventual output of
  62 # krb5-strength-wordlist, removing words containing the letter d and any
  63 # shorter than 8 characters.
  64 my @filtered = grep { !m{d}xms && length >= 8 } @wordlist;
  65
  66 # Add a non-ASCII word to test non-ASCII filtering.
  67 push(@wordlist, encode('UTF-8', "\N{U+0639}\N{U+0631}\N{U+0628}\N{U+649}"));
  68
  69 # Write the new wordlist, including the non-ASCII word, to a new file.
  70 my $tmpdir = test_tmpdir();
  71 open(my $wordlist_fh, q{>}, "$tmpdir/wordlist")
  72   or BAIL_OUT("cannot create to $tmpdir/wordlist: $!");
  73 print {$wordlist_fh} join("\n", @wordlist), "\n"
  74   or BAIL_OUT("cannot write to $tmpdir/wordlist: $!");
  75 close($wordlist_fh)
  76   or BAIL_OUT("cannot flush $tmpdir/wordlist: $!");
  77
  78 # Generate a new, filtered word list.  Remove non-ASCII, words containing the
  79 # letter d, and words shorter than eight characters.
  80 my @options = qw(-a -x .*d -l 8);
  81 run_wordlist(@options, '-o', "$tmpdir/wordlist.new", "$tmpdir/wordlist");
  82
  83 # Verify that the new filtered list exists and has the correct content.
  84 my @got = eval { slurp("$tmpdir/wordlist.new") };
  85 is($@, q{}, 'New word list exists');
  86 is_deeply(\@got, \@filtered, '...with correct contents');
  87
  88 # Remove the files created by the test.
  89 unlink("$tmpdir/wordlist", "$tmpdir/wordlist.new");