(Perl) generate some random passwords

new_password

#!/Users/brian/bin/perl -CASD
use v5.30;
use open qw(:std :utf8);

use Math::Random::Secure qw(irand rand);

=encoding utf8

=head1 NAME

new_password - generate some new passwords

=head1 SYNOPSIS

	# generate 10 passwords of length 10
	$ new_password

	# generate 5 passwords of length 12
	$ new_password -n 5 -l 12

	# exclude special characters
	$ new_password -S

	# exclude special characters
	$ new_password -S

	# use a format (like macOS suggests)
	$ new_password -f '%5s-%5s-%5s' -S

	# exclude some characters
	$ new_password -A l1O0

=head1 DESCRIPTION

This program generates a bunch of passwords. You can choose the length,
format, and characters that go into it. By default, this creates 10
passwords of 12 characters using the printable ASCII characters (excluding
whitespace).

=head2 Options

=head3 Basic operation

=over 4

=item * --number, -n - number of passwords to generate (default is 10)

=item * --debug, -x - extra output, where appropriate (default is off)

=item * --length, -m - password length (default is 10)

=item * --format, -f - sprintf like format (only simple %Ns useful) - resets length to right thing

=item * --macos, --fm - use the format '%5s-%5s-%5s' with only lowercase letters and digits

=back

=head3 Password characters

You can exclude groups of characters, or use C<--disallow> to exclude
specific characters. For example, you can disallow the characters that
might confuse people, such as the letter lowercase L and the digit 1:

	$ new_password --disallow 1l0O

Use C<-allow> to include characters. For example, you may want to exclude
all digits, but add back C<1>, C<2>, and C<3>:

	$ new_password -D -a 123

=over 4

=item * --no-upper, -U - do not use uppercase letters (default: do use them)

=item * --no-lower, -L - do not use lowercase letters (default: do use them)

=item * --no-special, -S - do not use special chars (!@#$%^&*_+=-)  (default: do use them)

=item * --no-digit, -D - do not use digits  (default: do use them)

=item * --allow, -a CHARS - add these characters to the possible characters

=item * --disallow, -A CHARS - disallow these characters

=back

=head3 Password restrictions

=over 4

=item * --upper, -u - password must have uppercase characters

=item * --lower, -l - password must have lowercase characters

=item * --digit, -d - password must have digits

=item * --special, -s - password must have special

=back

=head1 SEE ALSO

L<String::Random>

=head1 COPYRIGHT AND LICENSE

Copyright 2020, brian d foy, All rights reserved.

You can use or distribute this program under the terms of the Artistic
License 2.

=head1 AUTHOR

brian d foy, C<< <[email protected]> >>
=cut

my $length      = 12;
my $number      = 10;
my $debug       = 0;

my @options = (
	"number|n=i"    => \   $number,
	"debug|x"       => \   $debug,
	"length|m=i"    => \   $length,
	"format|f=s"    => \my $format,

	"macos|fm"      => \my $macos,

	"no-upper|U"    => \my $no_upper,
	"no-lower|L"    => \my $no_lower,
	"no-special|S"  => \my $no_special,
	"no-digit|D"    => \my $no_digit,

	"allow|a=s"     => \my $allow,
	"disallow|A=s"  => \my $disallow,

	"upper|u"       => \my $must_have_upper,
	"lower|l"       => \my $must_have_lower,
	"digit|d"       => \my $must_have_digit,
	"special|s"     => \my $must_have_special,
	);

use Getopt::Long qw(:config no_ignore_case);
GetOptions( @options );

$format //= "%${length}s";
if( $macos ) {
	$format     = '%5s-%5s-%5s';
	$no_upper   = 1;
	$no_special = 1;
	$no_lower   = 0;
	$no_digit   = 0;
	$allow      = '';
	}

my @widths;
if( $format ) {
	@widths = $format =~ m/%(\d*)s/g;
	$length = 0;
	foreach my $n ( @widths ) {
		$n = 1 unless length $n;
		$length += $n;
		}
	}

# ##################################################################
# derived internal settings
my $long_length = $length * 10;

say "Format: $format Length: $length Long length: $long_length"
	if $debug;

# ##################################################################
# All settings should be set by this point. Figure out the chars
# we are allowed to use
my @characters;
push @characters, 'a' .. 'z' unless $no_lower;
push @characters, 'A' .. 'Z' unless $no_upper;
push @characters, '0' .. '9' unless $no_digit;

my @special_set = grep {
	  /\p{Print}/ && ! /\p{L}/ &&
	! /\p{Digit}/ && ! /\p{Space}/
	} map { chr } 0 .. 127;

my $special_set = join '', @special_set;
say "Specials: ", $special_set if $debug;

push @characters, @special_set unless $no_special;
push @characters, split //, $allow if defined $allow;
if( defined $disallow ) {
	my %disallow = map { $_, 1 } split //, $disallow;
	@characters = grep { ! exists $disallow{$_} } @characters;
	}

say "CHARS: ", join '', @characters if $debug;

@characters = shuffle( @characters );

# ##################################################################
# now generate a bunch of passwords
my @passwords;
my $tries = 0;
while( @passwords < $number and $tries++ < $number * 10 ) {
	my @chars = map { $characters[irand @characters] } 0 .. $long_length;

	my $offset = irand( @characters - $length );

	my $substring = join '', @chars[ $offset .. $offset + $length ];
	my @parts = map { substr $substring, 0, $_, '' } @widths;
	my $password = sprintf $format, @parts;
	say "Candidate password $password" if $debug;

	next if
		( $must_have_digit   && $password !~ /\p{Digit}/          ) ||
		( $must_have_upper   && $password !~ /\p{Lu}/             ) ||
	   	( $must_have_lower   && $password !~ /\p{Ll}/             );
	    ( $must_have_special && $password !~ /[\Q$special_set\E]/ );
	say "Passed password <$password>" if $debug;

	push @passwords, $password;
	}

say "Tries was $tries" if $debug;

say join "\n", @passwords;

# stolen from List::Util::PP, but now I can use Math::Random::Secure's
# rand()
sub shuffle (@) {
	my @a=\(@_);
	my $n;
	my $i=@_;
	map {
		$n = rand($i--);
		(${$a[$n]}, $a[$n] = $a[$i])[0];
		} @_;
	}
__END__