view release on metacpan or  search on metacpan

script/bcrypt  view on Meta::CPAN

=item * https://github.com/shoenig/bcrypt-tool, a Golang tool

=back

=head1 SOURCE AVAILABILITY

This source is in Github:

	http://github.com/briandfoy/app-bcrypt

=head1 AUTHOR

brian d foy, C<< <brian d foy> >>

=head1 COPYRIGHT AND LICENSE

Copyright © 2023, brian d foy, All Rights Reserved.

You may redistribute this under the terms of the Artistic License 2.0.

=cut

package App::bcrypt;

sub VERSION { '1.001' }

exit run( @ARGV ) unless caller;

sub EX_SUCCESS  () { 0 }
sub EX_NO_MATCH () { 1 }
sub EX_USAGE    () { 2 }

sub run ( @args ) {
	return _update_modules() if grep { $_ eq '--update-modules' } @args;

	my $processed_args = _process_args(\@args);
	exit EX_USAGE unless defined $processed_args;

	return _show_version($processed_args->{'debug'}) if $processed_args->{'version'};
	return _show_help() if $processed_args->{'help'};

	if( $processed_args->{quiet} ) {
		no warnings qw(redefine);
		*_message = sub { 1 }
		}

	my $errors = _validate_args( $processed_args );

	if( $errors->@* > 0 ) {
		foreach ( $errors->@* ) {
			_message( $_ );
			}
		return EX_USAGE;
		}

	if( ! defined $processed_args->{'password'} ) {
		$processed_args->{'password'} = _read_password();
		}

	if( defined $processed_args->{compare} ) {
		state $rc = require Crypt::Bcrypt;
		my $r = Crypt::Bcrypt::bcrypt_check( $processed_args->@{qw(password compare)} );

		return do {
			if( $r ) {
				_message("Match");
				EX_SUCCESS;
				}
			else {
				_message("Does not match");
				EX_NO_MATCH;
				}
			};
		}

	if( $processed_args->{'debug'} ) {
		say _dumper($processed_args);
		}

	state $rc = require Crypt::Bcrypt;
	my $hashed = Crypt::Bcrypt::bcrypt( $processed_args->@{qw(password type cost salt)} );

	local $\ = do {
		if( $processed_args->{'no-eol'} ) { undef }
		elsif( $processed_args->{'eol'} ) { $processed_args->{'eol'} }
		else                              { "\n" }
		};

	print $hashed;

	return EX_SUCCESS;
	}

sub _defaults () {
	my %hash = (
		'no-eol'  => $ENV{BCRYPT_NO_EOL}   // 0,
		cost      => $ENV{BCRYPT_COST}     // 12,
		debug     => $ENV{BCRYPT_DEBUG}    // 0,
		eol       => $ENV{BCRYPT_EOL}      // "\n",
		quiet     => $ENV{BCRYPT_QUIET}    // 0,
		salt      => _default_salt(),
		type      => lc( $ENV{BCRYPT_TYPE} // '2b' ),
		);

	return \%hash;
	}

sub _default_salt () {
	my $unencoded_salt = do {
		if( exists $ENV{BCRYPT_SALT} ) {
			state $rc = require Encode;
			Encode::encode( 'UTF-8', $ENV{BCRYPT_SALT} )
			}
		else {
			state $rc = require Crypt::URandom;
			Crypt::URandom::urandom(16)
			}
		};
	}

sub _dumper {
	state $rc = require Data::Dumper;
	Data::Dumper->new([@_])->Indent(1)->Sortkeys(1)->Terse(1)->Useqq(1)->Dump
	}

sub _message ($m) {
	chomp $m;
	say { _message_fh() } $m;
	}

sub _message_fh () {
	$App::bcrypt::fh // *STDOUT
	}

sub _modules () {
	qw(Crypt::Bcrypt Crypt::URandom Encode);
	}

sub _process_args ($args) {
	state $c = require Getopt::Long;

	my %opts = _defaults()->%*;
	my %opts_description = (
		'compare=s'      => \ $opts{'compare'},
		'cost|c=i'       => \ $opts{'cost'},
		'debug|d'        => \ $opts{'debug'},
		'eol|e=s'        => \ $opts{'eol'},
		'help|h'         => \ $opts{'help'},
		'no-eol|n'       => \ $opts{'no-eol'},
		'password|p=s'   => \ $opts{'password'},
		'quiet|q'        => \ $opts{'quiet'},
		'salt|s=s'       => \ $opts{'salt'},
		'type|t=s'       => \ $opts{'type'},
		'update-modules' => \ $opts{'update-modules'},
		'version|v'      => \ $opts{'version'},
		);

	my $ret = Getopt::Long::GetOptionsFromArray( $args, %opts_description );
	return unless $ret;

	return \%opts;
	}

sub _read_password () {
	_message( 'Reading password on standard input...' );
	my $password = <STDIN>;
	chomp $password;
	$password;
	}

sub _show_help () {
	state $rc = require Pod::Usage;
	print Pod::Usage::pod2usage(
		-verbose => 2,
		-exitval => 'NOEXIT',
		);
	return EX_SUCCESS;
	}

sub _show_version ($debug = 0) {
	_message( "$0 " . __PACKAGE__->VERSION );
	return EX_SUCCESS unless $debug;

	_message( "\tperl $^V at $^X" );

	my $width = ( sort { $a <=> $b } map { length } _modules() )[-1];

	foreach my $module ( sort { $a cmp $b} _modules() ) {
		my $rc = eval "require $module";
		my $rel_path = $module =~ s|::|/|gr . '.pm';
		_message( sprintf "\t%-*s\n\t\t%f\n\t\t%s", $width, $module, $module->VERSION, $INC{$rel_path} )
		}

	return EX_SUCCESS;
	}

sub _types () { qw( 2a 2b 2x 2y ) }

sub _update_modules () {
	state $rc = require App::Cpan;
	App::Cpan->run( _modules() )
	}

sub _validate_args ( $processed_args ) {
	my( $c, $t, $s, $p ) = $processed_args->@{qw(cost type salt password)};

	my @errors;

	push @errors, qq(The cost must be a whole number between 5 and 31, inclusively, but got "$c")
		unless( int($c) == $c and ( 4 < $c && $c < 32 ) );
	push @errors, qq(The type must be one of @{[ _types ]}, but got "$t")
		unless grep { $t eq $_ } _types();
	push @errors, sprintf "The salt must be 16 octets, but got %s", _dumper($s) =~ s/\R+\z//r
		unless 16 == length $s;

	return \@errors;
	}

1;