#!/usr/bin/perl -w
#
# __copy1__
# __copy2__
#
use strict qw(vars);

my $Cmd		= $0; $Cmd =~ s/.*\///;
my $CmdVer	= "1.3";
my $CmdStr	= "$Cmd v$CmdVer (2025-03-23)";


# we avoid chars that are prone to be confused:
#
#	l (lower L), upper I, and 1 (one)
#	O (upper o) and 0 (zero)
#
my @base	= qw/ a b c d e f g h j k m n o p q r s t u v w x z /;
my @upper	= qw/ A B C D E F G H J K L M N P Q R S T U V W X Y Z /;
my @numbers	= qw/ 2 3 4 5 6 7 8 9 /;

# for specials, we use only common symbols, avoiding:
#     - chars that are difficult to find on international keyboards,
#	eg: | (pipes), #, ~
#     - chars that usually have special meaning in web forms, eg: @, :
#     - chars that are often exchanged in the mind of users: / and \
#
my @specials	= qw/ + . - = ; /;

### 2025-03-23
### avoid commas, often seen as dot and viceversa
### push( @specials, ',' );	# can't put commas in quote below, need this to avoid warnings


my $len			= 12;
my $minlen		= 12;
my $maxlen		= 64;

my $percent_numbers	= 10;
my $percent_upper	= 10;
my $percent_specials	= 5;

my $Debug		= 0;

while (@ARGV) {
  	my $arg = shift(@ARGV);

	if ($arg =~ /^\d+$/) {
		$len	= $arg;
		next;
	}
	if ($arg eq "--rfc") {
		$percent_upper		= 50;
		$percent_numbers	= 10;
		$percent_specials	= 5;
		$len			= 10;
		$minlen			= 8;
		next;
	}
	if ($arg eq "--simple") {
		$percent_specials	= 0;
		$percent_upper		= 0;
		$len			= 12;
		$minlen			= 11;
		next;
	}
	if ($arg eq "--debug" || $arg eq "-D") {
		$Debug			= 1;
		next;
	}

	usage();
}



if ($len < $minlen) {
	usage( "length $len too short (min=$minlen)" );
}
if ($len > $maxlen) {
	usage( "length $len too big (max=$maxlen)" );
}

my $out = "";
my $kk = $len;

# first char, always from base charset
#
$out .= $base[ rand(scalar(@base)) ];
$kk--;

# last char, the same (see at end)
$kk--;

while ($kk--) {

	if (hit($percent_upper, "upper")) {
		$out .= $upper[ rand(scalar(@upper)) ];
		pdebug( " add upper: %s\n", $out );
		next;
	}
	if (hit($percent_numbers, "number")) {
		$out .= $numbers[ rand(scalar(@numbers)) ];
		pdebug( " add number: %s\n", $out );
		next;
	}
	if (hit($percent_specials, "special")) {
		$out .= $specials[ rand(scalar(@specials)) ];
		pdebug( " add special: %s\n", $out );
		next;
	}

	$out .= $base[ rand(scalar(@base)) ];
	pdebug( " add base: %s\n", $out );
}

# last char, lower or upper letter
#
if (hit($percent_upper, "upper")) {
	$out .= $upper[ rand(scalar(@upper)) ];
	pdebug( " last char, add upper: %s\n", $out );
} else {
	$out .= $base[ rand(scalar(@base)) ];
	pdebug( " last char, add base: %s\n", $out );
}


# requisites
#
if ($percent_upper > 0 && !contains( $out, @upper )) {
	# place almost 1 uppercase in a random position
	my @tmp = split( "", $out );
	my $pos = rand($len);
	$pos = $len - 1		if (hit(50,""));
	$pos = 0		if (hit(50,""));
	@tmp[$pos] = $upper[ rand(scalar(@upper)) ];
	$out = join( "", @tmp );
	pdebug( " upper required, add at pos %d: %s\n", $pos, $out );
}
if ($percent_specials > 0 && !contains( $out, @specials )) {
	# place almost 1 special char in a random position (avoiding first and last pos)
	my @tmp = split( "", $out );
	my $pos = 1 + rand($len-2);
	@tmp[$pos] = $specials[ rand(scalar(@specials)) ];
	$out = join( "", @tmp );
	pdebug( " special required, add at pos %d: %s\n", $pos, $out );
}
if ($percent_numbers > 0 && !contains( $out, @numbers )) {
	# place almost 1 special char in a random position
	my @tmp = split( "", $out );
	my $pos = rand($len);
	@tmp[$pos] = $numbers[ rand(scalar(@numbers)) ];
	$out = join( "", @tmp );
	pdebug( " number required, add at pos %d: %s\n", $pos, $out );
}


print "$out\n";
exit( 0 );



sub usage
{
	printf( STDERR "
== $CmdStr - generate safe, quasi-random password ==

usage: $Cmd [options]

defaults:
  uppercase	yes
  special	yes

options:
  len		a positive number, min %d, max %d, default %d

  --simple	only lowercase, no special chars

  --rfc		output a rfc-compliant, password, using lowercase, uppercase,
  		special symbols; note that in modern days this kind of passwords are not
		more secure that a password made only by, eg, lowercase chars; len is
		the way to have a secure password, use 12 or more chars if possible;
		--rfc option changes the min and defaul len
",
		$minlen, $maxlen, $len );
	printf( STDERR "\n%s\n", $_[0] ) if (defined $_[0]);
	die( "\n" );
}


sub contains
{
	my $string = shift( @_ );
	my @tmp = split( "", $string );
	my $ss;
	my $kk;

	foreach $ss (@tmp) {
		foreach $kk (@_) {
			if ($kk eq $ss) {
				return 1;
			}
		}
	}
	return 0;
}


sub hit
{
	my ($max,$desc) = @_;
	my $r = rand(100);
	pdebug( "%s: hit(%d), rand=%d\n", $desc, $max, $r );
	return 1	if ($r <= $max);
	return 0;
}


sub pdebug
{
	my $fmt	= shift;
	$fmt	= "D# $fmt";

	printf( STDERR $fmt, @_ )	if ($Debug);
}
