line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package POE::Component::Server::IRC::Common; |
2
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:BINGOS'; |
3
|
|
|
|
|
|
|
$POE::Component::Server::IRC::Common::VERSION = '1.60'; # TRIAL |
4
|
184
|
|
|
184
|
|
212588
|
use strict; |
|
184
|
|
|
|
|
450
|
|
|
184
|
|
|
|
|
6197
|
|
5
|
184
|
|
|
184
|
|
1087
|
use warnings FATAL => 'all'; |
|
184
|
|
|
|
|
441
|
|
|
184
|
|
|
|
|
7029
|
|
6
|
184
|
|
|
184
|
|
86545
|
use Crypt::PasswdMD5; |
|
184
|
|
|
|
|
193848
|
|
|
184
|
|
|
|
|
10211
|
|
7
|
184
|
|
|
184
|
|
86694
|
use Crypt::Eksblowfish::Bcrypt (); |
|
184
|
|
|
|
|
680547
|
|
|
184
|
|
|
|
|
6269
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
require Exporter; |
10
|
184
|
|
|
184
|
|
1477
|
use base qw(Exporter); |
|
184
|
|
|
|
|
477
|
|
|
184
|
|
|
|
|
155826
|
|
11
|
|
|
|
|
|
|
our @EXPORT_OK = qw(mkpasswd chkpasswd); |
12
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( ALL => [@EXPORT_OK] ); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub mkpasswd { |
15
|
210
|
|
|
210
|
1
|
1976166
|
my ($plain, %opts) = @_; |
16
|
210
|
50
|
33
|
|
|
1076
|
return if !defined $plain || !length $plain; |
17
|
210
|
|
|
|
|
989
|
$opts{lc $_} = delete $opts{$_} for keys %opts; |
18
|
|
|
|
|
|
|
|
19
|
210
|
100
|
|
|
|
682
|
return _bcrypt($plain) if $opts{bcrypt}; |
20
|
153
|
100
|
|
|
|
468
|
return unix_md5_crypt($plain) if $opts{md5}; |
21
|
102
|
100
|
|
|
|
405
|
return apache_md5_crypt($plain) if $opts{apache}; |
22
|
51
|
|
|
|
|
416
|
my $salt = join '', ('.','/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]; |
23
|
51
|
|
|
|
|
130
|
my $alg = ''; |
24
|
51
|
50
|
|
|
|
2628
|
$alg = '$5$' if !defined(crypt("ab", $alg."cd")); |
25
|
51
|
50
|
|
|
|
531
|
$alg = '$2b$12$FPWWO2RJ3CK4FINTw0Hi' if !defined(crypt("ab", $alg."cd")); |
26
|
51
|
50
|
|
|
|
426
|
$alg = '' if !defined(crypt("ab", $alg."cd")); |
27
|
51
|
|
|
|
|
1461
|
return crypt($plain, $alg.$salt); |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub chkpasswd { |
31
|
753
|
|
|
753
|
1
|
13882255
|
my ($pass, $chk) = @_; |
32
|
753
|
50
|
33
|
|
|
8733
|
return if !defined $pass || !length $pass; |
33
|
753
|
50
|
33
|
|
|
6233
|
return if !defined $chk || !length $chk; |
34
|
|
|
|
|
|
|
|
35
|
753
|
|
|
|
|
3103
|
my $md5 = '$1$'; my $apr = '$apr1$'; my $bcr = '$2a$'; |
|
753
|
|
|
|
|
1695
|
|
|
753
|
|
|
|
|
1676
|
|
36
|
753
|
100
|
|
|
|
5848
|
if (index($chk,$apr) == 0) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
37
|
101
|
|
|
|
|
690
|
my $salt = $chk; |
38
|
101
|
|
|
|
|
3442
|
$salt =~ s/^\Q$apr//; |
39
|
101
|
|
|
|
|
2008
|
$salt =~ s/^(.*)\$/$1/; |
40
|
101
|
|
|
|
|
461
|
$salt = substr( $salt, 0, 8 ); |
41
|
101
|
50
|
|
|
|
1178
|
return 1 if apache_md5_crypt($pass, $salt) eq $chk; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
elsif ( index($chk,$md5) == 0 ) { |
44
|
101
|
|
|
|
|
585
|
my $salt = $chk; |
45
|
101
|
|
|
|
|
3672
|
$salt =~ s/^\Q$md5//; |
46
|
101
|
|
|
|
|
2226
|
$salt =~ s/^(.*)\$/$1/; |
47
|
101
|
|
|
|
|
730
|
$salt = substr( $salt, 0, 8 ); |
48
|
101
|
50
|
|
|
|
1807
|
return 1 if unix_md5_crypt($pass, $salt) eq $chk; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
elsif ( index($chk,$bcr) == 0 ) { |
51
|
144
|
100
|
|
|
|
778
|
return 1 if _bcrypt( $pass, $chk ) eq $chk; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
415
|
|
|
|
|
149867
|
my $crypt = crypt( $pass, $chk ); |
55
|
415
|
100
|
100
|
|
|
5893
|
return 1 if $crypt && $crypt eq $chk; |
56
|
314
|
100
|
|
|
|
2613
|
return 1 if $pass eq $chk; |
57
|
8
|
|
|
|
|
50
|
return; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub _bcrypt { |
61
|
201
|
|
|
201
|
|
791
|
my $plain = shift; |
62
|
201
|
|
|
|
|
583
|
my $salt = shift; |
63
|
201
|
100
|
|
|
|
872
|
if ( !defined $salt ) { |
64
|
57
|
|
|
|
|
164
|
my $cost = sprintf('%02d', 6); |
65
|
57
|
|
|
|
|
113
|
my $alg = ''; |
66
|
57
|
50
|
|
|
|
2222
|
$alg = '$5$' if !defined(crypt("ab", $alg."cd")); |
67
|
57
|
50
|
|
|
|
511
|
$alg = '$2b$12$FPWWO2RJ3CK4FINTw0Hi' if !defined(crypt("ab", $alg."cd")); |
68
|
57
|
50
|
|
|
|
479
|
$alg = '' if !defined(crypt("ab", $alg."cd")); |
69
|
|
|
|
|
|
|
my $salty = sub { |
70
|
57
|
|
|
57
|
|
124
|
my $num = 999999; |
71
|
57
|
|
|
|
|
3998
|
my $cr = crypt( rand($num), $alg.rand($num) ) . crypt( rand($num), $alg.rand($num) ); |
72
|
57
|
|
|
|
|
349
|
Crypt::Eksblowfish::Bcrypt::en_base64(substr( $cr, 4, 16 )); |
73
|
57
|
|
|
|
|
490
|
}; |
74
|
57
|
|
|
|
|
233
|
$salt = join( '$', '$2a', $cost, $salty->() ); |
75
|
|
|
|
|
|
|
} |
76
|
201
|
|
|
|
|
2834
|
return Crypt::Eksblowfish::Bcrypt::bcrypt($plain,$salt); |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
1; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=encoding utf8 |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=head1 NAME |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
POE::Component::Server::IRC::Common - provides a set of common functions for the POE::Component::Server::IRC suite. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head1 SYNOPSIS |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
use strict; |
90
|
|
|
|
|
|
|
use warnings; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
use POE::Component::Server::IRC::Common qw( :ALL ); |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
my $passwd = mkpasswd( 'moocow' ); |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=head1 DESCRIPTION |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
POE::Component::IRC::Common provides a set of common functions for the |
100
|
|
|
|
|
|
|
L suite. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=head1 FUNCTIONS |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=head2 C |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
Takes one mandatory argument a plain string to 'encrypt'. If no further |
107
|
|
|
|
|
|
|
options are specified it uses C to generate the password. Specifying |
108
|
|
|
|
|
|
|
'md5' option uses L's C |
109
|
|
|
|
|
|
|
function to generate the password. Specifying 'apache' uses |
110
|
|
|
|
|
|
|
Crypt::PasswdMD5 C function to generate the password. |
111
|
|
|
|
|
|
|
Specifying 'bcrypt' option uses L to generate |
112
|
|
|
|
|
|
|
the password (recommended). |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
my $passwd = mkpasswd( 'moocow' ); # vanilla crypt() |
115
|
|
|
|
|
|
|
my $passwd = mkpasswd( 'moocow', md5 => 1 ) # unix_md5_crypt() |
116
|
|
|
|
|
|
|
my $passwd = mkpasswd( 'moocow', apache => 1 ) # apache_md5_crypt() |
117
|
|
|
|
|
|
|
my $passwd = mkpasswd( 'moocow', bcrypt => 1 ) # bcrypt() # recommended |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=head2 C |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
Takes two mandatory arguments, a password string and something to check that |
122
|
|
|
|
|
|
|
password against. The function first tries md5 comparisons (UNIX and Apache) |
123
|
|
|
|
|
|
|
and bcrypt, then C and finally plain-text password check. |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=head1 AUTHOR |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
Chris 'BinGOs' Williams |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=head1 LICENSE |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
Copyright E Chris Williams |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
This module may be used, modified, and distributed under the same terms as |
134
|
|
|
|
|
|
|
Perl itself. Please see the license that came with your Perl distribution |
135
|
|
|
|
|
|
|
for details. |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=head1 SEE ALSO |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
L |
140
|
|
|
|
|
|
|
L |
141
|
|
|
|
|
|
|
L |
142
|
|
|
|
|
|
|
L |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=cut |