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