File Coverage

lib/Mailru/Cloud/Auth.pm
Criterion Covered Total %
statement 99 109 90.8
branch 24 46 52.1
condition 0 6 0.0
subroutine 16 16 100.0
pod 1 3 33.3
total 140 180 77.7


line stmt bran cond sub pod time code
1             package Mailru::Cloud::Auth;
2              
3 1     1   73121 use 5.008001;
  1         14  
4 1     1   7 use strict;
  1         2  
  1         37  
5 1     1   7 use warnings;
  1         3  
  1         25  
6 1     1   672 use utf8;
  1         15  
  1         5  
7 1     1   496 use open qw(:std :utf8);
  1         1223  
  1         6  
8 1     1   865 use LWP::UserAgent;
  1         50983  
  1         37  
9 1     1   9 use HTTP::Request;
  1         2  
  1         26  
10 1     1   745 use JSON::XS;
  1         5263  
  1         58  
11 1     1   8 use URI::Escape;
  1         3  
  1         58  
12 1     1   11 use Carp qw/carp croak/;
  1         2  
  1         1398  
13            
14             our $VERSION = '0.06';
15              
16             sub new {
17 1     1 0 700 my ($class, %opt) = @_;
18 1         2 my $self = {};
19 1         3 $self->{debug} = $opt{-debug};
20 1         10 my $ua = LWP::UserAgent->new (
21             agent => 'Mozilla/5.0 (X11; Linux x86_64; rv:45.0) Gecko/20100101 Firefox/45.0',
22             cookie_jar => {},
23             );
24 1         11035 $self->{ua} = $ua;
25 1         6 return bless $self, $class;
26             }
27              
28             sub login {
29 1     1 1 440 my ($self, %opt) = @_;
30 1   0     9 $self->{login} = $opt{-login} || $self->{login} || croak "You must specify -login opt for 'login' method";
31 1   0     4 $self->{password} = $opt{-password} || $self->{password} || croak "You must specify -password opt for 'login' method";
32 1         2 my $ua = $self->{ua};
33 1         2 my ($res, $code);
34              
35             #Get login token
36 1         6 $res = $ua->get('https://mail.ru');
37 1         788080 $code = $res->code;
38 1 50       16 if ($code ne '200') {
39 0         0 croak "Can't get start mail.ru page. Code: $code";
40             }
41 1         11 my ($login_token) = $res->decoded_content =~ /CSRF\s*[:=]\s*"([0-9A-Za-z]+?)"/;
42 1 50       2311 if (not $login_token) {
43 0         0 croak "Can't found login token";
44             }
45              
46             #Login
47             my %param = (
48             'login' => $self->{login},
49             'password' => $self->{password},
50 1         10 'saveauth' => 1,
51             'project' => 'e.mail.ru',
52             'token' => $login_token,
53             );
54 1         11 my %headers = (
55             'Content-type' => 'application/x-www-form-urlencoded',
56             'Accept' => '*/*',
57             'Accept-Encoding' => 'gzip, deflate, br',
58             'Accept-Language' => 'ru-RU,ru;q=0.9,en-US;q=0.8,en;q=0.7',
59             'Referer' => 'https://mail.ru/?from=logout',
60             'Origin' => 'https://mail.ru',
61             );
62              
63 1         10 $res = $ua->post('https://auth.mail.ru/jsapi/auth', \%param, %headers);
64 1         626591 $code = $res->code;
65 1 50       16 if ($code ne '200') {
66 0         0 croak "Wrong response code from login form: $code";
67             }
68              
69 1         10 my $json = decode_json($res->decoded_content);
70 1 50       199 if ($json->{status} eq 'fail') {
71 0         0 croak "Fail login: $json->{code}";
72             }
73              
74 1 50       15 $self->__getToken() or return;
75 1         46 return $self->{authToken};
76 0         0 return;
77             }
78              
79             sub __getToken {
80 1     1   2 my $self = shift;
81              
82 1         3 my $ua = $self->{ua};
83 1         6 my $res = $ua->get('https://cloud.mail.ru/?from=promo&from=authpopup');
84              
85 1 50       2159498 if ($res->is_success) {
86 1         23 my $content = $res->decoded_content;
87 1 50       2778 if ($content =~ /"csrf"\s*:\s*"([a-zA-Z0-9]+?)"/) {
88 1         7 $self->{authToken} = $1;
89 1 50       10 carp "Found authToken: $self->{authToken}" if $self->{debug};
90              
91 1 50       15 if ($content =~ /"email"\s*:\s*"(.+?)"/) {
92 1         5 $self->{email} = $1;
93 1 50       5 carp "Found email: $self->{email}" if $self->{debug};
94            
95             #Get BUILD
96 1         4 $self->{build} = 'hotfix_CLOUDWEB-7726_50-0-3.201710311503';
97 1 50       129 if ($content =~ /"BUILD"\s*:\s*"(.+?)"/) {
98 1         5 $self->{build} = $1;
99 1 50       4 carp "Found and use new build $self->{build}" if $self->{debug};
100             }
101            
102             #Get x-page-id
103 1         5 $self->{'x-page-id'} = 'f9jfLFeHA5';
104 1 50       117 if ($content =~ /"x-page-id"\s*:\s*"(.+?)"/) {
105 1         5 $self->{'x-page-id'} = $1;
106 1 50       5 carp "Found and use new x-page_id $self->{build}" if $self->{debug};
107             }
108              
109             #Parse free space info
110 1         6 $self->{info} = __parseInfo(\$content);
111 1         159 return 1;
112             }
113              
114             }
115             }
116 0         0 return;
117             }
118              
119             sub info {
120 1     1 0 4 my $self = shift;
121 1 50       5 if ($self->{info}) {
122 1         3 my %info = map {$_, $self->{info}->{$_}} keys %{$self->{info}};
  3         11  
  1         6  
123 1         6 return \%info;
124             }
125 0         0 return;
126             }
127              
128             sub __parseInfo {
129 1     1   2 my $content = shift;
130 1         6 my %info = (
131             'used_space' => '',
132             'total_space' => '',
133             'file_size_limit' => '',
134             );
135            
136 1 50       17 if (my ($size_block) = $$content =~ /"space":\s*{([^}]*)}/s) {
137 1         11 while ($size_block =~ /"([^"]+)":\s*(\w+?)\b/gm) {
138 3 100       16 if ($1 eq 'bytes_total') {
    100          
139 1         9 $info{total_space} = $2;
140             }
141             elsif ($1 eq 'bytes_used') {
142 1         5 $info{used_space} = $2;
143             }
144             }
145             }
146              
147 1 50       13 if ($$content =~ /"file_size_limit":\s*(.+?)[,\s]/) {
148 1         5 $info{file_size_limit} = $1;
149             }
150 1         6 return \%info;
151             }
152              
153             sub __isLogin {
154 14     14   72 my $self = shift;
155 14 50       74 if ($self->{authToken}) {
156 14         40 my $ua = $self->{ua};
157 14         110 my $res = $ua->get('https://auth.mail.ru/cgi-bin/auth?mac=1&Login=' . uri_escape($self->{login}));
158 14         4172742 my $code = $res->code;
159 14 50       220 if ($code ne '200') {
160 0         0 croak "Can't get status about login";
161             }
162 14         92 my $json_res = decode_json($res->content);
163 14 50       2351 $json_res->{status} eq 'ok' and return 1;
164 0 0         $self->login() and return 1;
165             }
166              
167 0           croak "Not logined";
168             }
169              
170             1;
171              
172              
173             __END__