File Coverage

blib/lib/POE/Component/Server/IRC/Common.pm
Criterion Covered Total %
statement 63 63 100.0
branch 31 42 73.8
condition 6 12 50.0
subroutine 9 9 100.0
pod 2 2 100.0
total 111 128 86.7


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