# Declarations and configuration
##############################################################################
-require 5.006;
+require 5.010;
+use autodie;
use strict;
use warnings;
# Utility functions
##############################################################################
-# print with error checking and an explicit file handle.
+# say with error checking and an explicit file handle.
#
# $fh - Output file handle
# @args - Remaining arguments to print
#
# Returns: undef
# Throws: Text exception on output failure
-sub print_fh {
+sub say_fh {
my ($fh, @args) = @_;
- print {$fh} @args or croak('print failed');
+ say {$fh} @args or croak("say failed: $!");
return;
}
my ($in_fh, $output, $filter) = @_;
# Check that the output CDB file doesn't exist.
- if (-f $output) {
+ if (-e $output) {
die "$0: output file $output already exists\n";
}
# Create a temporary file to write the CDB input into.
my $tmp = $output . '.data';
- if (-f $tmp) {
+ if (-e $tmp) {
die "$0: temporary output file $tmp already exists\n";
}
- open(my $tmp_fh, '>', $tmp)
- or die "$0: cannot create output file $tmp: $!\n";
+ open(my $tmp_fh, '>', $tmp);
# Walk through the input word list and write each word that passes the
# filter to the output file handle as CDB data.
chomp($word);
next if !$filter->($word);
my $length = length($word);
- print_fh($tmp_fh, "+$length,1:$word->1\n");
+ say_fh($tmp_fh, "+$length,1:$word->1");
}
# Add a trailing newline, required by the CDB data format, and close.
- print_fh($tmp_fh, "\n");
- close($tmp_fh) or die "$0: cannot write to temporary file $tmp: $!\n";
+ say_fh($tmp_fh, q{});
+ close($tmp_fh);
# Run cdb to turn the result into a CDB database. Ignore duplicate keys.
system($CDB, '-c', '-u', $output, $tmp) == 0
or die "$0: cdb -c failed\n";
# Remove the temporary file and return.
- unlink($tmp) or die "$0: cannot remove temporary file $tmp: $!\n";
+ unlink($tmp);
return;
}
my ($in_fh, $output, $filter) = @_;
# Check that the output SQLite file doesn't exist.
- if (-f $output) {
+ if (-e $output) {
die "$0: output file $output already exists\n";
}
require DBD::SQLite;
# Open and create the database.
- my $options = { PrintError => 0, RaiseError => 1, AutoCommit => 0 };
+ my $options = { PrintError => 0, RaiseError => 1, AutoCommit => 1 };
my $dbh = DBI->connect("dbi:SQLite:dbname=$output", q{}, q{}, $options);
$dbh->do($SQLITE_CREATE);
- # Prepare the insert statement for each word.
+ # Tune SQLite to improve the speed of bulk inserts. Use unsafe insert
+ # processing and increase the index cache to 500MB.
+ $dbh->do('PRAGMA synchronous = 0');
+ $dbh->do('PRAGMA cache_size = 500000');
+
+ # Start a transaction and prepare the insert statement for each word.
+ $dbh->begin_work();
my $sth = $dbh->prepare($SQLITE_INSERT);
# Walk through the input word list and add each word that passes the
# Throws: Text exception on output failure
sub write_wordlist {
my ($in_fh, $output, $filter) = @_;
- open(my $out_fh, '>', $output)
- or die "$0: cannot create output file $output: $!\n";
+ open(my $out_fh, '>', $output);
# Walk through the input word list and write each word that passes the
# filter to the output file handle.
while (defined(my $word = <$in_fh>)) {
chomp($word);
next if !$filter->($word);
- print_fh($out_fh, "$word\n");
+ say_fh($out_fh, $word);
}
# All done.
- close($out_fh) or die "$0: cannot write to output file $output: $!\n";
+ close($out_fh);
return;
}
# Build a filter from our command-line parameters. This is an anonymous
# sub that returns true to keep a word and false otherwise.
my $filter = sub {
- my ($word) = @_;
- my $length = length($word);
+ my ($word) = @_;
+ my $length = length($word);
my $min_length = $config_ref->{'min-length'};
my $max_length = $config_ref->{'max-length'};
# Parse the argument list.
my %config;
my @options = (
- 'ascii|a', 'cdb|c=s', 'max-length|L=i', 'min-length|l=i',
- 'manual|man|m', 'output|o=s', 'sqlite|s=s', 'exclude|x=s@',
+ 'ascii|a', 'cdb|c=s', 'max-length|L=i', 'min-length|l=i',
+ 'manual|man|m', 'output|o=s', 'sqlite|s=s', 'exclude|x=s@',
);
Getopt::Long::config('bundling', 'no_ignore_case');
GetOptions(\%config, @options);
if ($config{manual}) {
- print_fh(\*STDOUT, "Feeding myself to perldoc, please wait...\n");
+ say_fh(\*STDOUT, 'Feeding myself to perldoc, please wait...');
exec('perldoc', '-t', $fullpath);
}
if (@ARGV != 1) {
my $filter = build_filter(\%config);
# Process the input file into either wordlist output or a CDB file.
-open(my $in_fh, '<', $input)
- or die "$0: cannot open input file $input: $!\n";
+open(my $in_fh, '<', $input);
if ($config{output}) {
write_wordlist($in_fh, $config{output}, $filter);
} elsif ($config{cdb}) {
} elsif ($config{sqlite}) {
write_sqlite($in_fh, $config{sqlite}, $filter);
}
-close($in_fh) or die "$0: cannot read all of input file $input: $!\n";
+close($in_fh);
# All done.
exit(0);
krb5-strength-wordlist krb5-strength cdb whitespace lookups lookup
sublicense MERCHANTABILITY NONINFRINGEMENT krb5-strength --ascii Allbery
regexes output-wordlist heimdal-strength SQLite output-wordlist
-output-sqlite DBI wordlist
+output-sqlite DBI wordlist SPDX-License-Identifier MIT
=head1 NAME
=head1 COPYRIGHT AND LICENSE
-Copyright 2013, 2014 The Board of Trustees of the Leland Stanford Junior
+Copyright 2016, 2020, 2023 Russ Allbery <eagle@eyrie.org>
+
+Copyright 2013-2014 The Board of Trustees of the Leland Stanford Junior
University
Permission is hereby granted, free of charge, to any person obtaining a
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
DEALINGS IN THE SOFTWARE.
+SPDX-License-Identifier: MIT
+
=head1 SEE ALSO
cdb(1), L<DBI>, L<DBD::SQLite>
The cdb file format is defined at L<http://cr.yp.to/cdb.html>.
The current version of this program is available from its web page at
-L<http://www.eyrie.org/~eagle/software/krb5-strength/> as part of the
+L<https://www.eyrie.org/~eagle/software/krb5-strength/> as part of the
krb5-strength package.
=cut
+
+# Local Variables:
+# copyright-at-end-flag: t
+# End:
projects / kerberos / krb5-strength.git / blobdiff