File Coverage

blib/lib/Webqq/Encryption.pm
Criterion Covered Total %
statement 18 54 33.3
branch 1 18 5.5
condition 0 3 0.0
subroutine 6 8 75.0
pod 0 2 0.0
total 25 85 29.4


line stmt bran cond sub pod time code
1             package Webqq::Encryption;
2 1     1   6 use Carp;
  1         1  
  1         70  
3 1     1   15 use Exporter 'import';
  1         2  
  1         43  
4 1     1   6 use Digest::MD5 qw(md5_hex);
  1         1  
  1         62  
5 1     1   444 use Webqq::Encryption::TEA;
  1         2  
  1         24  
6 1     1   393 use Webqq::Encryption::RSA;
  1         2  
  1         43  
7             our @EXPORT_OK = qw(pwd_encrypt pwd_encrypt_js);
8              
9             BEGIN{
10 1     1   1 eval{require JE;};
  1         3  
11 1 50       281 $Webqq::Encryption::has_je = 1 unless $@;
12             }
13              
14             sub pwd_encrypt{
15 0     0 0   my ($pwd,$md5_salt,$verifycode,$is_md5_pwd) = @_;
16 0 0         $is_md5_pwd = 1 unless defined $is_md5_pwd;
17 0 0         $pwd = md5_hex($pwd) if $is_md5_pwd == 0;
18              
19 0           $md5_salt = eval qq{"$md5_salt"};
20 0           my $h1 = pack "H*",lc $pwd;
21 0           my $s2 = md5_hex($h1 . $md5_salt) ;
22 0           my $rsaH1= Webqq::Encryption::RSA::encrypt($h1);
23 0           my $rsaH1Len = sprintf "%x",length($rsaH1)/2;
24 0           my $hexVcode = Webqq::Encryption::TEA::strToBytes(uc $verifycode);
25 0           my $vcodeLen = "000" . sprintf("%x",length($verifycode));
26 0           while(length($rsaH1Len) < 4){
27 0           $rsaH1Len = "0" . $rsaH1Len;
28             }
29            
30 0           my $saltPwd = Webqq::Encryption::TEA::encrypt($s2,$rsaH1Len . $rsaH1 . Webqq::Encryption::TEA::strToBytes($md5_salt) . $vcodeLen . $hexVcode);
31 0           $saltPwd =~ tr/\/\+=/-*_/;
32 0           return $saltPwd;
33             }
34              
35             sub pwd_encrypt_js {
36 0 0   0 0   croak "The JE module is not found, You must install it first\n" unless $Webqq::Encryption::has_je;
37 0           my ($pwd,$md5_salt,$verifycode,$is_md5_pwd) = @_;
38 0 0         $is_md5_pwd = 1 unless defined $is_md5_pwd;
39 0           my $je;
40 0 0         if(defined $Webqq::Encryption::_je ){
41 0           $je = $Webqq::Encryption::_je ;
42             }
43             else{
44 0           my $javascript;
45 0 0         if(defined $Webqq::Encryption::_javascript){
46 0           $javascript = $Webqq::Encryption::_javascript;
47             }
48             else{
49 0           local $/ = undef;
50 0           $javascript = ;
51 0           $Webqq::Encryption::_javascript = $javascript;
52 0           close DATA;
53             }
54 0           $je = JE->new;
55 0           $je->eval($javascript);
56 0 0         croak "load javascript error: $@\n" if $@;
57 0           $Webqq::Encryption::_je = $je;
58             }
59            
60 0           my $p = $je->eval(qq#
61             var p = '$pwd';
62             var salt = '$md5_salt';
63             var verifycode = '$verifycode';
64             var r = \$.Encryption.getEncryption(p,salt,verifycode,$is_md5_pwd);
65             return(r);
66             #);
67            
68 0 0 0       if($p and !$@){
69 0           return $p;
70             }
71             else{
72 0           croak "pwd_encrypt_js error $@\n";
73             }
74             }
75              
76             1;
77             __DATA__