File Coverage

blib/lib/Webqq/Encryption.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


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