line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Mailru::Cloud; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
1298
|
use 5.008001; |
|
1
|
|
|
|
|
3
|
|
4
|
1
|
|
|
1
|
|
4
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
19
|
|
5
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
48
|
|
6
|
1
|
|
|
1
|
|
6
|
use utf8; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
6
|
|
7
|
1
|
|
|
1
|
|
34
|
use open qw(:std :utf8); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
8
|
|
8
|
1
|
|
|
1
|
|
150
|
use Carp qw/croak carp/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
57
|
|
9
|
1
|
|
|
1
|
|
6
|
use URI::Escape; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
57
|
|
10
|
1
|
|
|
1
|
|
7
|
use File::Basename; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
56
|
|
11
|
1
|
|
|
1
|
|
5
|
use HTTP::Request; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
33
|
|
12
|
1
|
|
|
1
|
|
6
|
use JSON::XS; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
50
|
|
13
|
1
|
|
|
1
|
|
576
|
use Encode; |
|
1
|
|
|
|
|
14482
|
|
|
1
|
|
|
|
|
91
|
|
14
|
1
|
|
|
1
|
|
862
|
use IO::Socket::SSL; |
|
1
|
|
|
|
|
86963
|
|
|
1
|
|
|
|
|
9
|
|
15
|
1
|
|
|
1
|
|
210
|
use base qw/Mailru::Cloud::Auth/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2384
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
our $VERSION = '0.09'; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my $BUFF_SIZE = 512; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub uploadFile { |
22
|
0
|
|
|
0
|
1
|
|
my ($self, %opt) = @_; |
23
|
0
|
|
0
|
|
|
|
my $upload_file = $opt{'-file'} || croak "You must specify -file param for method uploadFile"; |
24
|
0
|
|
0
|
|
|
|
my $path = $opt{'-path'} || '/'; |
25
|
0
|
|
|
|
|
|
my $rename = $opt{'-rename'}; |
26
|
0
|
|
|
|
|
|
$self->{file_hash} = undef; |
27
|
|
|
|
|
|
|
|
28
|
0
|
|
|
|
|
|
$self->__isLogin(); |
29
|
|
|
|
|
|
|
|
30
|
0
|
0
|
|
|
|
|
my $conflict_mode = $rename ? 'rename' : 'rewrite'; |
31
|
|
|
|
|
|
|
|
32
|
0
|
0
|
|
|
|
|
if (not -f $upload_file) { |
33
|
0
|
|
|
|
|
|
croak "File $upload_file not exist"; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
0
|
0
|
|
|
|
|
if ($path !~ /\/$/) { |
37
|
0
|
|
|
|
|
|
$path .= '/'; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
0
|
|
|
|
|
|
my $request = 'https://cld-upload10.cloud.mail.ru/upload/?' .'cloud_domain=2&x-email=' . uri_escape($self->{email}); |
41
|
|
|
|
|
|
|
|
42
|
0
|
0
|
|
|
|
|
my ($file_hash, $size) = $self->__upload_file($request, $upload_file) or return; |
43
|
0
|
|
|
|
|
|
$self->{file_hash} = $file_hash; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
#Опубликуем файл |
46
|
|
|
|
|
|
|
my %param = ( |
47
|
|
|
|
|
|
|
'api' => '2', |
48
|
|
|
|
|
|
|
'build' => $self->{build}, |
49
|
|
|
|
|
|
|
'conflict' => $conflict_mode, |
50
|
|
|
|
|
|
|
'email' => $self->{email}, |
51
|
|
|
|
|
|
|
'hash' => $file_hash, |
52
|
|
|
|
|
|
|
'home' => $path . basename($upload_file), |
53
|
|
|
|
|
|
|
'size' => $size, |
54
|
|
|
|
|
|
|
'token' => $self->{authToken}, |
55
|
|
|
|
|
|
|
'x-email' => $self->{email}, |
56
|
0
|
|
|
|
|
|
'x-page-id' => $self->{'x-page-id'}, |
57
|
|
|
|
|
|
|
); |
58
|
0
|
|
|
|
|
|
my $res = $self->{ua}->post('https://cloud.mail.ru/api/v2/file/add', \%param); |
59
|
|
|
|
|
|
|
|
60
|
0
|
|
|
|
|
|
my $code = $res->code; |
61
|
0
|
0
|
|
|
|
|
if ($code eq '200') { |
62
|
0
|
|
|
|
|
|
my $json = JSON::XS::decode_json($res->content); |
63
|
0
|
|
|
|
|
|
my $new_fname = $json->{body}; |
64
|
0
|
|
|
|
|
|
return $new_fname; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
0
|
|
|
|
|
|
croak "Cant upload file $upload_file. Code: $code " . $res->decoded_content . "\n"; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub downloadFile { |
71
|
0
|
|
|
0
|
1
|
|
my ($self, %opt) = @_; |
72
|
0
|
|
0
|
|
|
|
my $file = $opt{-file} || croak "You must specify -file param for method downloadFile"; |
73
|
0
|
|
0
|
|
|
|
my $cloud_file = $opt{-cloud_file} || croak "You must specify -cloud_file param for method downloadFile"; |
74
|
|
|
|
|
|
|
|
75
|
0
|
|
|
|
|
|
$self->__isLogin(); |
76
|
|
|
|
|
|
|
|
77
|
0
|
|
|
|
|
|
my $FL; |
78
|
0
|
|
|
|
|
|
my $ua = $self->{ua}; |
79
|
0
|
|
|
|
|
|
my $url = 'https://cloclo5.datacloudmail.ru/get/' . uri_escape($cloud_file) . '?x-email=' . uri_escape($self->{email}); |
80
|
|
|
|
|
|
|
my $res = $ua->get($url, ':read_size_hint' => $BUFF_SIZE, ':content_cb' => sub { |
81
|
0
|
0
|
|
0
|
|
|
if (not $FL) { |
82
|
0
|
0
|
|
|
|
|
open $FL, ">$file" or croak "Cant open $file to write $!"; |
83
|
0
|
|
|
|
|
|
binmode $FL; |
84
|
|
|
|
|
|
|
} |
85
|
0
|
|
|
|
|
|
print $FL $_[0]; |
86
|
0
|
|
|
|
|
|
}); |
87
|
0
|
|
|
|
|
|
my $code = $res->code; |
88
|
0
|
0
|
|
|
|
|
if ($code ne '200') { |
89
|
0
|
|
|
|
|
|
croak "Cant download file $cloud_file to $file. Code: $code"; |
90
|
|
|
|
|
|
|
} |
91
|
0
|
0
|
|
|
|
|
close $FL if $FL; |
92
|
0
|
|
|
|
|
|
return 1; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
sub createFolder { |
96
|
0
|
|
|
0
|
1
|
|
my ($self, %opt) = @_; |
97
|
0
|
|
0
|
|
|
|
my $path = $opt{-path} || croak "You must specify -path param for method createFolder"; |
98
|
|
|
|
|
|
|
|
99
|
0
|
|
|
|
|
|
$self->__isLogin(); |
100
|
|
|
|
|
|
|
|
101
|
0
|
|
|
|
|
|
my $ua = $self->{ua}; |
102
|
|
|
|
|
|
|
my %param = ( |
103
|
|
|
|
|
|
|
'api' => '2', |
104
|
|
|
|
|
|
|
'build' => $self->{build}, |
105
|
|
|
|
|
|
|
'conflict' => 'strict', |
106
|
|
|
|
|
|
|
'email' => $self->{email}, |
107
|
|
|
|
|
|
|
'home' => $path, |
108
|
|
|
|
|
|
|
'token' => $self->{authToken}, |
109
|
|
|
|
|
|
|
'x-email' => $self->{email}, |
110
|
0
|
|
|
|
|
|
'x-page-id' => $self->{'x-page-id'}, |
111
|
|
|
|
|
|
|
); |
112
|
0
|
|
|
|
|
|
my $res = $ua->post('https://cloud.mail.ru/api/v2/folder/add', \%param); |
113
|
|
|
|
|
|
|
|
114
|
0
|
|
|
|
|
|
my $code = $res->code; |
115
|
0
|
0
|
|
|
|
|
if ($code eq '200') { |
116
|
0
|
|
|
|
|
|
return 1; |
117
|
|
|
|
|
|
|
} |
118
|
0
|
0
|
|
|
|
|
if ($code eq '400') { |
119
|
0
|
|
|
|
|
|
carp "Can't create folder $path. Folder exists"; |
120
|
0
|
|
|
|
|
|
return; |
121
|
|
|
|
|
|
|
} |
122
|
0
|
|
|
|
|
|
croak "Cant create folder $path. Code: $code"; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub deleteResource { |
127
|
0
|
|
|
0
|
1
|
|
my ($self, %opt) = @_; |
128
|
0
|
|
0
|
|
|
|
my $path = $opt{-path} || croak "You must specify -path options for method deleteResource"; |
129
|
|
|
|
|
|
|
|
130
|
0
|
|
|
|
|
|
$self->__isLogin(); |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
my %param = ( |
133
|
|
|
|
|
|
|
'api' => '2', |
134
|
|
|
|
|
|
|
'build' => $self->{build}, |
135
|
|
|
|
|
|
|
'email' => $self->{email}, |
136
|
|
|
|
|
|
|
'home' => $path, |
137
|
|
|
|
|
|
|
'token' => $self->{authToken}, |
138
|
|
|
|
|
|
|
'x-email' => $self->{email}, |
139
|
0
|
|
|
|
|
|
'x-page-id' => $self->{'x-page-id'}, |
140
|
|
|
|
|
|
|
); |
141
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
|
my $res = $self->{ua}->post('https://cloud.mail.ru/api/v2/file/remove', \%param); |
143
|
0
|
|
|
|
|
|
my $code = $res->code; |
144
|
|
|
|
|
|
|
|
145
|
0
|
0
|
|
|
|
|
if ($code eq '200') { |
146
|
0
|
|
|
|
|
|
return 1; |
147
|
|
|
|
|
|
|
} |
148
|
0
|
|
|
|
|
|
croak "Cant remove $path. Code: $code"; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub emptyTrash { |
152
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
153
|
|
|
|
|
|
|
|
154
|
0
|
|
|
|
|
|
$self->__isLogin(); |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
my %param = ( |
157
|
|
|
|
|
|
|
'api' => '2', |
158
|
|
|
|
|
|
|
'build' => $self->{build}, |
159
|
|
|
|
|
|
|
'email' => $self->{email}, |
160
|
|
|
|
|
|
|
'token' => $self->{authToken}, |
161
|
|
|
|
|
|
|
'x-email' => $self->{email}, |
162
|
0
|
|
|
|
|
|
'x-page-id' => $self->{'x-page-id'}, |
163
|
|
|
|
|
|
|
); |
164
|
|
|
|
|
|
|
|
165
|
0
|
|
|
|
|
|
my $res = $self->{ua}->post('https://cloud.mail.ru/api/v2/trashbin/empty', \%param); |
166
|
0
|
|
|
|
|
|
my $code = $res->code; |
167
|
|
|
|
|
|
|
|
168
|
0
|
0
|
|
|
|
|
if ($code eq '200') { |
169
|
0
|
|
|
|
|
|
return 1; |
170
|
|
|
|
|
|
|
} |
171
|
0
|
|
|
|
|
|
croak "Cant empty trash. Code: $code"; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub listFiles { |
175
|
0
|
|
|
0
|
1
|
|
my ($self, %opt) = @_; |
176
|
0
|
|
0
|
|
|
|
my $path = $opt{-path} || '/'; |
177
|
0
|
|
|
|
|
|
my $orig_path = $path; |
178
|
|
|
|
|
|
|
|
179
|
0
|
|
|
|
|
|
$self->__isLogin(); |
180
|
0
|
|
|
|
|
|
$path = uri_escape($path); |
181
|
0
|
|
|
|
|
|
my $res = $self->{ua}->get('https://cloud.mail.ru/api/v2/folder' . '?token=' . $self->{authToken} . '&home=' . $path); |
182
|
0
|
|
|
|
|
|
my $code = $res->code; |
183
|
0
|
0
|
|
|
|
|
if ($res->is_success) { |
184
|
0
|
|
|
|
|
|
my $json_parsed = decode_json($res->content); |
185
|
0
|
|
|
|
|
|
my @list_files; |
186
|
|
|
|
|
|
|
|
187
|
0
|
|
|
|
|
|
for my $item (@{$json_parsed->{body}->{list}}) { |
|
0
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
my $h = { |
189
|
|
|
|
|
|
|
'type' => $item->{type}, |
190
|
|
|
|
|
|
|
'name' => $item->{name}, |
191
|
|
|
|
|
|
|
'size' => $item->{size}, |
192
|
0
|
|
|
|
|
|
}; |
193
|
0
|
0
|
|
|
|
|
if ($item->{weblink}) { |
194
|
0
|
|
|
|
|
|
$h->{weblink} = 'https://cloud.mail.ru/public/' . $item->{weblink}; |
195
|
|
|
|
|
|
|
} |
196
|
0
|
|
|
|
|
|
push @list_files, $h; |
197
|
|
|
|
|
|
|
} |
198
|
0
|
|
|
|
|
|
return \@list_files; |
199
|
|
|
|
|
|
|
} |
200
|
0
|
0
|
|
|
|
|
if ($code eq '404') { |
201
|
0
|
|
|
|
|
|
croak "Folder $orig_path not exists"; |
202
|
|
|
|
|
|
|
} |
203
|
0
|
|
|
|
|
|
croak "Cant get file list for path: $orig_path. Code: $code"; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub shareResource { |
207
|
0
|
|
|
0
|
1
|
|
my ($self, %opt) = @_; |
208
|
0
|
|
0
|
|
|
|
my $path = $opt{-path} || croak "You must specify -path param for method shareResource"; |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
#Добавим слеш в начало, если его нет |
211
|
0
|
|
|
|
|
|
$path =~ s/^([^\/])/\/$1/; |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
my %param = ( |
214
|
|
|
|
|
|
|
'api' => '2', |
215
|
|
|
|
|
|
|
'build' => $self->{build}, |
216
|
|
|
|
|
|
|
'email' => $self->{email}, |
217
|
|
|
|
|
|
|
'home' => $path, |
218
|
|
|
|
|
|
|
'token' => $self->{authToken}, |
219
|
|
|
|
|
|
|
'x-email' => $self->{email}, |
220
|
0
|
|
|
|
|
|
'x-page-id' => $self->{'x-page-id'}, |
221
|
|
|
|
|
|
|
); |
222
|
|
|
|
|
|
|
|
223
|
0
|
|
|
|
|
|
my $res = $self->{ua}->post('https://cloud.mail.ru/api/v2/file/publish', \%param); |
224
|
0
|
|
|
|
|
|
my $code = $res->code; |
225
|
0
|
0
|
|
|
|
|
if ($code ne '200') { |
226
|
0
|
|
|
|
|
|
croak "Error on shareResource. Path: $path. Code: $code"; |
227
|
|
|
|
|
|
|
} |
228
|
0
|
|
|
|
|
|
my $json = decode_json($res->decoded_content); |
229
|
0
|
|
|
|
|
|
my $link = 'https://cloud.mail.ru/public/' . $json->{body}; |
230
|
0
|
|
|
|
|
|
return $link; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
sub __upload_file { |
234
|
0
|
|
|
0
|
|
|
my ($self, $url, $file) = @_; |
235
|
|
|
|
|
|
|
|
236
|
0
|
|
|
|
|
|
my $u1 = URI->new($url); |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
# $IO::Socket::SSL::DEBUG = 5; |
239
|
0
|
|
|
|
|
|
my $host = $u1->host; |
240
|
0
|
|
|
|
|
|
my $port = $u1->port; |
241
|
0
|
|
|
|
|
|
my $path = $u1->path; |
242
|
|
|
|
|
|
|
|
243
|
0
|
0
|
|
|
|
|
my $sock = IO::Socket::SSL->new( |
244
|
|
|
|
|
|
|
PeerAddr => $host, |
245
|
|
|
|
|
|
|
PeerPort => $port, |
246
|
|
|
|
|
|
|
Proto => 'tcp', |
247
|
|
|
|
|
|
|
) or croak "Cant connect to $host:$port"; |
248
|
0
|
|
|
|
|
|
binmode $sock; |
249
|
0
|
|
|
|
|
|
$sock->autoflush(1); |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
#Generate boundary |
252
|
0
|
|
|
|
|
|
my $boundary = '5'; |
253
|
0
|
|
|
|
|
|
for (1..20) { |
254
|
0
|
|
|
|
|
|
$boundary .= int(rand(10) + 1); |
255
|
|
|
|
|
|
|
} |
256
|
0
|
|
|
|
|
|
$boundary = '----------------------------' . $boundary; |
257
|
|
|
|
|
|
|
|
258
|
0
|
|
|
|
|
|
my $content_disposition = 'Content-Disposition: form-data; name="file"; filename="' . basename($file) . '"' . "\n"; |
259
|
0
|
|
|
|
|
|
$content_disposition .= "Content-Type: text/plain\n\n"; |
260
|
0
|
|
|
|
|
|
my $length = (stat $file)[7]; |
261
|
|
|
|
|
|
|
|
262
|
0
|
|
|
|
|
|
my @cookie_arr; |
263
|
0
|
|
|
0
|
|
|
$self->{ua}->cookie_jar->scan(sub {push @cookie_arr, "$_[1]=$_[2]"}); |
|
0
|
|
|
|
|
|
|
264
|
0
|
|
|
|
|
|
my $cookie = join('; ', @cookie_arr); |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
|
267
|
0
|
|
|
|
|
|
my @headers = ( "PUT $path HTTP/1.1", |
268
|
|
|
|
|
|
|
"HOST: $host", |
269
|
|
|
|
|
|
|
"User-Agent: Mozilla/5.0 (X11; Ubuntu; Linux x86_64; rv:46.0) Gecko/20100101 Firefox/46.0", |
270
|
|
|
|
|
|
|
"Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8", |
271
|
|
|
|
|
|
|
"Accept-Language: en-US,en;q=0.5", |
272
|
|
|
|
|
|
|
"Accept-Encoding: gzip, deflate, br", |
273
|
|
|
|
|
|
|
"Content-Type: multipart/form-data; boundary=$boundary", |
274
|
|
|
|
|
|
|
"Connection: close", |
275
|
|
|
|
|
|
|
"Referer: https://cloud.mail.ru/home/", |
276
|
|
|
|
|
|
|
"Origin: https://cloud.mail.ru", |
277
|
|
|
|
|
|
|
"Cookie: $cookie", |
278
|
|
|
|
|
|
|
"X-Requested-With: XMLHttpRequest", |
279
|
|
|
|
|
|
|
); |
280
|
|
|
|
|
|
|
|
281
|
0
|
|
|
|
|
|
for my $head (@headers) { |
282
|
0
|
|
|
|
|
|
$sock->print($head . "\n"); |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
0
|
|
|
|
|
|
$sock->print("Content-Length: $length\n"); |
286
|
0
|
|
|
|
|
|
$sock->print("\n"); |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
|
289
|
0
|
0
|
|
|
|
|
open my $FH, "<$file" or croak "Cant open $file $!"; |
290
|
0
|
|
|
|
|
|
binmode $FH; |
291
|
0
|
|
|
|
|
|
my $filebuf; |
292
|
0
|
|
|
|
|
|
while (my $bytes = read($FH, $filebuf, $BUFF_SIZE)) { |
293
|
0
|
|
|
|
|
|
$sock->print($filebuf); |
294
|
|
|
|
|
|
|
} |
295
|
0
|
|
|
|
|
|
$sock->print("\n"); |
296
|
|
|
|
|
|
|
|
297
|
0
|
|
|
|
|
|
my @answer = $sock->getlines(); |
298
|
0
|
|
|
|
|
|
$sock->close(); |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
#Если запрос успешен |
301
|
0
|
0
|
|
|
|
|
if ($answer[0] =~ /201/) { |
302
|
|
|
|
|
|
|
#Возврат хэша файла |
303
|
0
|
|
|
|
|
|
return (pop @answer, $length); |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
0
|
|
|
|
|
|
return; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
################################## ACCESSORS ##########################3 |
310
|
|
|
|
|
|
|
# |
311
|
|
|
|
|
|
|
sub get_last_uploaded_file_hash { |
312
|
0
|
|
|
0
|
0
|
|
return $_[0]->{file_hash}; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
1; |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
__END__ |