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, 2020, 2023 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(automake_setup test_file_path test_tmpdir);
  20
  21 use Encode qw(encode);
  22 use Test::More;
  23
  24 # Load prerequisite modules.
  25 use_prereq('IPC::Run', 'run');
  26 use_prereq('Perl6::Slurp', 'slurp');
  27
  28 # Set up for testing of an Automake project.
  29 automake_setup();
  30
  31 # Declare the plan.
  32 plan tests => 5;
  33
  34 # Run krb5-strength-wordlist with the given arguments and verify that it exits
  35 # successfully with no output.  For planning purposes, this function will
  36 # report three tests.
  37 #
  38 # @args - Arguments to krb5-strength-wordlist
  39 #
  40 # Returns: undef
  41 sub run_wordlist {
  42     my (@args) = @_;
  43
  44     # Find the krb5-strength-wordlist program in the distribution.
  45     my $wordlist = test_file_path('../tools/krb5-strength-wordlist');
  46
  47     # Run the program, capturing its output and status.
  48     my ($out, $err);
  49     run([$wordlist, @args], \undef, \$out, \$err);
  50     my $status = ($? >> 8);
  51
  52     # Check the results.
  53     is($status, 0, "krb5-strength-wordlist @args");
  54     is($out, q{}, '...with no output');
  55     is($err, q{}, '...and no errors');
  56     return;
  57 }
  58
  59 # Read the word list that we'll use for testing.
  60 my @wordlist = slurp(test_file_path('data/wordlist'));
  61
  62 # Generate a filtered version that should match the eventual output of
  63 # krb5-strength-wordlist, removing words containing the letter d and any
  64 # shorter than 8 characters.
  65 my @filtered = grep { !m{d}xms && length >= 8 } @wordlist;
  66
  67 # Add a non-ASCII word to test non-ASCII filtering.
  68 ## no critic (ValuesAndExpressions::ProhibitEscapedCharacters)
  69 push(@wordlist, encode('UTF-8', "\x{0639}\x{0631}\x{0628}\x{0649}"));
  70 ## use critic
  71
  72 # Write the new wordlist, including the non-ASCII word, to a new file.
  73 my $tmpdir = test_tmpdir();
  74 open(my $wordlist_fh, q{>}, "$tmpdir/wordlist")
  75   or BAIL_OUT("cannot create to $tmpdir/wordlist: $!");
  76 print {$wordlist_fh} join("\n", @wordlist), "\n"
  77   or BAIL_OUT("cannot write to $tmpdir/wordlist: $!");
  78 close($wordlist_fh)
  79   or BAIL_OUT("cannot flush $tmpdir/wordlist: $!");
  80
  81 # Generate a new, filtered word list.  Remove non-ASCII, words containing the
  82 # letter d, and words shorter than eight characters.
  83 my @options = qw(-a -x .*d -l 8);
  84 run_wordlist(@options, '-o', "$tmpdir/wordlist.new", "$tmpdir/wordlist");
  85
  86 # Verify that the new filtered list exists and has the correct content.
  87 my @got = eval { slurp("$tmpdir/wordlist.new") };
  88 is($@, q{}, 'New word list exists');
  89 is_deeply(\@got, \@filtered, '...with correct contents');
  90
  91 # Remove the files created by the test.
  92 unlink("$tmpdir/wordlist", "$tmpdir/wordlist.new");