File Coverage

blib/lib/Text/Password/CoreCrypt.pm
Criterion Covered Total %
statement 45 45 100.0
branch 12 18 66.6
condition 18 21 85.7
subroutine 10 10 100.0
pod 4 4 100.0
total 89 98 90.8


line stmt bran cond sub pod time code
1             package Text::Password::CoreCrypt;
2             our $VERSION = "0.17";
3              
4             require 5.008_008;
5 5     5   2778 use Carp qw(croak carp);
  5         13  
  5         267  
6              
7 5     5   583 use Moo;
  5         7545  
  5         34  
8 5     5   3418 use strictures 2;
  5         1669  
  5         193  
9              
10 5     5   2244 use Types::Standard qw(Int Bool);
  5         224689  
  5         43  
11 5     5   10707 use constant Min => 4;
  5         14  
  5         769  
12              
13             has default => ( is => 'rw', isa => Int->where('$_ >= 8'), default => sub {8} );
14             has readability => ( is => 'rw', isa => Bool, default => 1 );
15              
16 5     5   41 no Moo::sification;
  5         15  
  5         64  
17              
18             my @w = ( 'a' .. 'z', 'A' .. 'Z', 0 .. 9 );
19             my @seeds = ( @w, '.', '/' );
20             my @ascii = ( @seeds, '#', ',', qw# ! " $ % & ' ( ) * + - : ; < = > ? @ [ \ ] ^ _ ` { | } ~ # );
21              
22             =encoding utf-8
23              
24             =head1 NAME
25              
26             Text::Password::CoreCrypt - generate and verify Password with perl CORE::crypt()
27              
28             =head1 SYNOPSIS
29              
30             my $pwd = Text::Password::CoreCrypt->new();
31             my( $raw, $hash ) = $pwd->genarate(); # list context is required
32             my $input = $req->body_parameters->{passwd};
33             my $data = $pwd->encrypt($input); # you don't have to care about salt
34              
35             my $flag = $pwd->verify( $input, $data );
36              
37             =head1 DESCRIPTION
38              
39             Text::Password::CoreCrypt is a base module for Text::Password::AutoMigration.
40              
41             B<DON'T USE> directly.
42              
43             =head2 Constructor and initialization
44              
45             =head3 new()
46              
47             No arguments are required. But you can set some parameters.
48              
49             =over
50              
51              
52             =item default( I<Int> )
53              
54              
55             You can set default length with param 'default' like below:
56              
57             $pwd = Text::Pasword::AutoMiglation->new( default => 12 );
58              
59              
60             =item readablity( I<Bool> )
61              
62              
63             Or you can set default strength for password with param 'readablity'.
64              
65             It must be a boolean, default is 1.
66              
67             If it was set as 0, you can generate stronger passwords with generate().
68              
69             $pwd = Text::Pasword::AutoMiglation->new( readability => 0 );
70              
71             =back
72              
73             =head2 Methods and Subroutines
74              
75             =head3 verify( $raw, $hash )
76              
77             returns true if the verification succeeds.
78              
79             =cut
80              
81             sub verify {
82 5     5 1 3238 my $self = shift;
83 5         13 my ( $input, $data ) = @_;
84              
85 5 50       21 warn __PACKAGE__, " makes 13 bytes hash strings. Your data must be wrong: ", $data
86             unless $data =~ /^[ !-~]{13}$/;
87 5         100 return $data eq CORE::crypt( $input, $data );
88              
89             }
90              
91             =head3 nonce( I<Int> )
92              
93             generates the random strings with enough strength.
94              
95             the length defaults to 8 || $self->default().
96              
97             =cut
98              
99             sub nonce {
100 38506     38506 1 77500 my $self = shift;
101 38506   66     80579 my $length = shift || $self->default();
102              
103 38506 100 100     144827 croak "Unvalid length for nonce was set" if $length !~ /^\d+$/ or $length < Min;
104              
105 38504         60741 my $n = '';
106              
107 38504   66     50796 do { # redo unless it gets enough strength
      100        
      100        
      100        
108 61989         139633 $n = $w[ rand @w ];
109 61989         800087 $n .= $ascii[ rand @ascii ] while length $n < $length;
110              
111             } while $n =~ /^\w+$/ or $n =~ /^\W+$/ or $n !~ /\d/ or $n !~ /[A-Z]/ or $n !~ /[a-z]/;
112 38504         2287262 return $n;
113             }
114              
115             =head3 encrypt( I<Str> )
116              
117             returns hash with CORE::crypt().
118              
119             salt will be made automatically.
120              
121             =cut
122              
123             sub encrypt {
124 4     4 1 21 my ( $self, $input ) = @_;
125 4 50       16 croak __PACKAGE__, " requires at least ", Min, "length" if length $input < Min;
126 4 50       10 carp __PACKAGE__, " ignores the password with over 8 bytes" if length $input > 8;
127 4 50       11 croak __PACKAGE__, " doesn't allow any Wide Characters or white spaces" if $input =~ /[^ -~]/;
128              
129 4         703 return CORE::crypt( $input, $seeds[ rand @seeds ] . $seeds[ rand @seeds ] );
130             }
131              
132             =head3 generate( I<Int> )
133              
134             genarates pair of new password and it's hash.
135              
136             less readable characters(0Oo1Il|!2Zz5sS$6b9qCcKkUuVvWwXx.,:;~-^'"`) are forbidden
137             unless $self->readability is 0.
138              
139             the length defaults to 8 || $self->default().
140              
141             =cut
142              
143             sub generate {
144 113     113 1 122504 my $self = shift;
145 113   66     2972 my $length = shift || $self->default();
146              
147 113 50       1311 croak "Invalid length was set" unless $length =~ /^\d+$/;
148 113 100       519 croak ref $self, "::generate requires at least ", Min, " length" if $length < Min;
149 112 50       248 croak ref $self, "::generate requires list context" unless wantarray;
150              
151 112         168 my $raw;
152 112         174 do { # redo unless it gets enough readability
153 38084         292643 $raw = $self->nonce($length);
154 38084 100       626884 return $raw, $self->encrypt($raw) unless $self->readability();
155              
156             } while $raw =~ /[0Oo1Il|!2Zz5sS\$6b9qCcKkUuVvWwXx.,:;~\-^'"`]/;
157 111         1116 return $raw, $self->encrypt($raw);
158             }
159              
160             1;
161              
162             __END__
163              
164             =head1 LICENSE
165              
166             Copyright (C) Yuki Yoshida(worthmine).
167              
168             This library is free software; you can redistribute it and/or modify
169             it under the same terms as Perl itself.
170              
171             =head1 AUTHOR
172              
173             Yuki Yoshida E<lt>worthmine@users.noreply.github.comE<gt>