view release on metacpan or  search on metacpan

lib/Crypt/HSXKPasswd.pm  view on Meta::CPAN

package Crypt::HSXKPasswd;

# import required modules
use strict;
use warnings;
use Carp; # for nicer 'exception' handling for users of the module
use Fatal qw( :void open close binmode ); # make builtins throw exceptions on failure
use English qw( -no_match_vars ); # for more readable code
use Scalar::Util qw( blessed ); # for checking if a reference is blessed
use Math::Round; # for round()
use Math::BigInt; # for the massive numbers needed to store the permutations
use Clone qw( clone ); # for cloning nested data structures - exports clone()
use Readonly; # for truly constant constants
use JSON; # for dealing with JSON strings
use List::MoreUtils qw( uniq ); # for array deduplication
use Type::Tiny; # for generating anonymous type constraints when needed
use Type::Params qw( compile multisig ); # for parameter validation with Type::Tiny objects
use Types::Standard qw( slurpy :types ); # for basic type checking (Int Str etc.)
use Crypt::HSXKPasswd::Types qw( :types ); # for custom type checking
use Crypt::HSXKPasswd::Helper; # exports utility functions like _error & _warn
use Crypt::HSXKPasswd::Dictionary::Basic;
use Crypt::HSXKPasswd::RNG::Math_Random_Secure;
use Crypt::HSXKPasswd::RNG::Data_Entropy;
use Crypt::HSXKPasswd::RNG::DevUrandom;
use Crypt::HSXKPasswd::RNG::Basic;

# set things up for using UTF-8
use 5.016; # min Perl for good UTF-8 support, implies feature 'unicode_strings'
use Encode qw( encode decode );
use Text::Unidecode; # for stripping accents from accented characters
use utf8;
binmode STDOUT, ':encoding(UTF-8)';

# import (or not) optional modules
eval{
    # the default dicrionary may not have been geneated using the Util module
    require Crypt::HSXKPasswd::Dictionary::EN;
}or do{
    carp('WARNING - failed to load Crypt::HSXKPasswd::Dictionary::EN');
};

## no critic (ProhibitAutomaticExportation);
use base qw( Exporter );
our @EXPORT = qw( hsxkpasswd );
## use critic

# Copyright (c) 2015, Bart Busschots T/A Bartificer Web Solutions All rights
# reserved.
#
# Code released under the FreeBSD license (included in the POD at the bottom of
# this file)

#==============================================================================
# Code
#==============================================================================

#
# === Constants and Package Variables =========================================#
#

# version info
use version; our $VERSION = qv('3.6');

# entropy control variables
my $_ENTROPY_MIN_BLIND = 78; # 78 bits - equivalent to 12 alpha numeric characters with mixed case and symbols
my $_ENTROPY_MIN_SEEN = 52; # 52 bits - equivalent to 8 alpha numeric characters with mixed case and symbols
my $_ENTROPY_WARNINGS = 'ALL'; # valid values are 'ALL', 'BLIND', or 'NONE' (invalid values treated like 'ALL')

# utility constants
Readonly my $_CLASS => __PACKAGE__;
Readonly my $_TYPES_CLASS => 'Crypt::HSXKPasswd::Types';
Readonly my $_DICTIONARY_BASE_CLASS => 'Crypt::HSXKPasswd::Dictionary';
Readonly my $_RNG_BASE_CLASS => 'Crypt::HSXKPasswd::RNG';

#
# Constructor -----------------------------------------------------------------
#

#####-SUB-######################################################################
# Type       : CONSTRUCTOR (CLASS)
# Purpose    : Instantiate an object of type XKPasswd
# Returns    : An object of type XKPasswd
# Arguments  : This function accepts the following named arguments - all
#              optional:
#              dictionary - an object that inherits from
#                  Crypt::HSXKPasswd::Dictionary
#              dictionary_list - an array ref of words to use as a dictionary.
#              dictionary_file - the path to a dictionary file.

lib/Crypt/HSXKPasswd.pm  view on Meta::CPAN

    
    # calculate and store the entropy stats
    my %stats = $self->_calculate_entropy_stats();
    $self->{_CACHE_ENTROPYSTATS} = \%stats;
    
    # warn if we need to
    unless(uc $_ENTROPY_WARNINGS eq 'NONE'){
        # blind warnings are always needed if the level is not 'NONE'
        if($self->{_CACHE_ENTROPYSTATS}->{entropy_blind_min} < $_ENTROPY_MIN_BLIND){
            _warn('for brute force attacks, the combination of the loaded config and dictionary produces an entropy of '.$self->{_CACHE_ENTROPYSTATS}->{entropy_blind_min}.'bits, below the minimum recommended '.$_ENTROPY_MIN_BLIND.'bits');
        }
        
        # seen warnings if the cut-off is not 'BLIND'
        unless(uc $_ENTROPY_WARNINGS eq 'BLIND'){
            if($self->{_CACHE_ENTROPYSTATS}->{entropy_seen} < $_ENTROPY_MIN_SEEN){
                _warn('for attacks assuming full knowledge, the combination of the loaded config and dictionary produces an entropy of '.$self->{_CACHE_ENTROPYSTATS}->{entropy_seen}.'bits, below the minimum recommended '.$_ENTROPY_MIN_SEEN.'bits');
            }
        }
    }
    
    # to keep perl critic happy
    return 1;
}

#####-SUB-######################################################################
# Type       : CLASS (PRIVATE)
# Purpose    : To nicely print a Math::BigInt object
# Returns    : a string representing the object's value in scientific notation
#              with 1 digit before the decimal and 2 after
# Arguments  : 1. a Math::BigInt object
# Throws     : Croaks on invalid invocation or args
# Notes      :
# See Also   :
sub _render_bigint{
    my @args = @_;
    my $class = shift @args;
    _force_class($class);
    
    # validate args
    state $args_check = compile(InstanceOf['Math::BigInt']);
    my ($bigint) = $args_check->(@args);
    
    # convert the bigint to an array of characters
    my @chars = split //sx, "$bigint";
    
    # render nicely
    if(scalar @chars < 3){
        return q{}.join q{}, @chars;
    }
    # start with the three most signifficant digits (as a decimal)
    my $ans = q{}.$chars[0].q{.}.$chars[1].$chars[2];
    # then add the scientific notation bit
    $ans .= 'x10^'.(scalar @chars - 1);
    
    # return the result
    return $ans;
}

#####-SUB-######################################################################
# Type       : CLASS (PRIVATE)
# Purpose    : Get the so-called 'grapheme length' of a unicode string, that is
#              to say, the length of a word where a letter with an accent counts
#              as a single letter.
# Returns    : An integer
# Arguments  : 1) the string to get the length of
# Throws     : Croaks on invalid invocation and invalid args
# Notes      : Perl, by default, will consider accented letters as having a
#              length of two. This function uses a very common algorythm
#              recommended all over the internet, including in the Perl Unicode
#              cookbook: http://search.cpan.org/~shay/perl-5.20.2/pod/perlunicook.pod
#              Before resorting to this technique, I tried to use the
#              grapheme_length function from Unicode::Util, but it proved
#              unacceptably slow.
# See Also   :
sub _grapheme_length{
    my @args = @_;
    my $class = shift @args;
    _force_class($class);
    
    # validate args
    state $args_check = compile(Str);
    my ($string) = $args_check->(@args);
    
    # do the calculation
    my $grapheme_length = 0;
    while($string =~ /\X/gsx){$grapheme_length++};
    
    # return the result
    return $grapheme_length;
}

1; # because Perl is just a little bit odd :)
__END__

#==============================================================================
# User Documentation
#==============================================================================

=head1 NAME

C<Crypt::HSXKPasswd> - A secure memorable password generator inspired by Steve
Gibson's Passord Haystacks (L<https://www.grc.com/haystack.htm>), and the
famous XKCD password cartoon (L<https://xkcd.com/936/>).

=head1 VERSION

This documentation refers to C<Crypt::HSXKPasswd> version 3.6.

=head1 SYNOPSIS

    use Crypt::HSXKPasswd;

    #
    # Functional Interface - a shortcut for generating single passwords
    #
    
    # generate a single password using the default word source, configuration,
    # and random number generator
    my $password = hsxkpasswd();
    
    # the above call is simply a shortcut for the following