line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# mt-aws-glacier - AWS Glacier sync client |
2
|
|
|
|
|
|
|
# Copyright (C) 2012 Victor Efimov |
3
|
|
|
|
|
|
|
# vs@vs-dev.com http://vs-dev.com |
4
|
|
|
|
|
|
|
# License: GPLv3 |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# This file is part of "mt-aws-glacier" |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# mt-aws-glacier is free software: you can redistribute it and/or modify |
9
|
|
|
|
|
|
|
# it under the terms of the GNU General Public License as published by |
10
|
|
|
|
|
|
|
# the Free Software Foundation, either version 3 of the License, or |
11
|
|
|
|
|
|
|
# (at your option) any later version. |
12
|
|
|
|
|
|
|
# |
13
|
|
|
|
|
|
|
# mt-aws-glacier is distributed in the hope that it will be useful, |
14
|
|
|
|
|
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
15
|
|
|
|
|
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
16
|
|
|
|
|
|
|
# GNU General Public License for more details. |
17
|
|
|
|
|
|
|
# |
18
|
|
|
|
|
|
|
# You should have received a copy of the GNU General Public License |
19
|
|
|
|
|
|
|
# along with this program. If not, see . |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
package Net::Amazon::TreeHash; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
|
26
|
1
|
|
|
1
|
|
31189
|
use strict; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
50
|
|
27
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
41
|
|
28
|
1
|
|
|
1
|
|
1357
|
use Digest::SHA qw/sha256/; |
|
1
|
|
|
|
|
4426
|
|
|
1
|
|
|
|
|
654
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 NAME |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Net::Amazon::TreeHash - An implementation of the Amazon AWS TreeHash checksum algorithm |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 VERSION |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
Version 0.71 |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=cut |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
our $VERSION = '0.71'; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head1 SYNOPSIS |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
This module implements TreeHash algorithm for Amazon AWS Glacier API (version 2012-06-01) |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
Usage: |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
use Net::Amazon::TreeHash; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
my $th = Net::Amazon::TreeHash->new(); |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
$th->eat_data(\$mydata); |
53
|
|
|
|
|
|
|
... |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
$th->calc_tree(); |
56
|
|
|
|
|
|
|
my $hash = $th->get_final_hash(); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=head1 NOT IMPLEMENTED |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
A function to get hash of the part of data (such function would be usefull for Glacier multipart upload) |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head1 SEE ALSO |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
An application for AWS Glacier synchronization. It is available at L. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=head1 AUTHOR |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
Victor Efimov C<< >> |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
https://github.com/vsespb/mt-aws-glacier |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head1 BUGS |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
Does not work for 0-length files (however it's useless for Glacier). |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=cut |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub new |
80
|
|
|
|
|
|
|
{ |
81
|
229
|
|
|
229
|
0
|
12102481
|
my ($class, %args) = @_; |
82
|
229
|
|
|
|
|
385
|
my $self = \%args; |
83
|
229
|
|
|
|
|
487
|
$self->{tree} = []; |
84
|
229
|
|
|
|
|
388
|
$self->{pending} = {}; |
85
|
229
|
|
100
|
|
|
787
|
$self->{unit} ||= 1048576; |
86
|
229
|
|
|
|
|
344
|
$self->{processed_size} = 0; # MB |
87
|
229
|
|
|
|
|
496
|
bless $self, $class; |
88
|
229
|
|
|
|
|
524
|
return $self; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub eat_file |
93
|
|
|
|
|
|
|
{ |
94
|
0
|
|
|
0
|
0
|
0
|
my ($self, $fh) = @_; |
95
|
0
|
|
|
|
|
0
|
while (1) { |
96
|
0
|
|
|
|
|
0
|
my $r = sysread($fh, my $data, $self->{unit}); |
97
|
0
|
0
|
|
|
|
0
|
if (!defined($r)) { |
|
|
0
|
|
|
|
|
|
98
|
0
|
|
|
|
|
0
|
die; |
99
|
|
|
|
|
|
|
} elsif ($r > 0) { |
100
|
0
|
|
|
|
|
0
|
$self->_eat_data_one_mb(\$data); |
101
|
|
|
|
|
|
|
} else { |
102
|
0
|
|
|
|
|
0
|
return; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub eat_data |
108
|
|
|
|
|
|
|
{ |
109
|
229
|
|
|
229
|
0
|
777
|
my ($self, $dataref) = @_; |
110
|
229
|
|
|
|
|
379
|
my $mb = $self->{unit}; |
111
|
229
|
|
|
|
|
334
|
my $n = length($$dataref); |
112
|
229
|
|
|
|
|
232
|
my $i = 0; |
113
|
229
|
|
|
|
|
482
|
while ($i < $n) { |
114
|
3599
|
|
|
|
|
26658
|
my $part = substr($$dataref, $i, $mb); |
115
|
3599
|
|
|
|
|
7088
|
$self->_eat_data_one_mb(\$part); |
116
|
3599
|
|
|
|
|
8067
|
$i += $mb |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub _eat_data_one_mb |
122
|
|
|
|
|
|
|
{ |
123
|
3599
|
|
|
3599
|
|
4353
|
my ($self, $dataref) = @_; |
124
|
3599
|
|
100
|
|
|
7947
|
$self->{tree}->[0] ||= []; |
125
|
3599
|
|
|
|
|
3378
|
push @{ $self->{tree}->[0] }, { joined => 0, start => $self->{processed_size}, finish => $self->{processed_size}, hash => sha256($$dataref) }; |
|
3599
|
|
|
|
|
318168
|
|
126
|
3599
|
|
|
|
|
6827
|
$self->{processed_size}++; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub calc_tree |
130
|
|
|
|
|
|
|
{ |
131
|
229
|
|
|
229
|
0
|
726
|
my ($self) = @_; |
132
|
229
|
|
|
|
|
266
|
my $prev_level = 0; |
133
|
229
|
|
|
|
|
254
|
while (scalar @{ $self->{tree}->[$prev_level] } > 1) { |
|
1130
|
|
|
|
|
2916
|
|
134
|
901
|
|
|
|
|
1095
|
my $curr_level = $prev_level+1; |
135
|
901
|
|
|
|
|
1535
|
$self->{tree}->[$curr_level] = []; |
136
|
|
|
|
|
|
|
|
137
|
901
|
|
|
|
|
1204
|
my $prev_tree = $self->{tree}->[$prev_level]; |
138
|
901
|
|
|
|
|
1115
|
my $curr_tree = $self->{tree}->[$curr_level]; |
139
|
901
|
|
|
|
|
910
|
my $len = scalar @$prev_tree; |
140
|
901
|
|
|
|
|
1686
|
for (my $i = 0; $i < $len; $i += 2) { |
141
|
3718
|
100
|
|
|
|
6621
|
if ($len - $i > 1) { |
142
|
3370
|
|
|
|
|
3714
|
my $a = $prev_tree->[$i]; |
143
|
3370
|
|
|
|
|
3747
|
my $b = $prev_tree->[$i+1]; |
144
|
3370
|
|
|
|
|
33631
|
push @$curr_tree, { joined => 0, start => $a->{start}, finish => $b->{finish}, hash => sha256( $a->{hash}.$b->{hash} ) }; |
145
|
|
|
|
|
|
|
} else { |
146
|
348
|
|
|
|
|
956
|
push @$curr_tree, $prev_tree->[$i]; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
901
|
|
|
|
|
1300
|
$prev_level = $curr_level; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
sub get_final_hash |
156
|
|
|
|
|
|
|
{ |
157
|
229
|
|
|
229
|
0
|
775
|
my ($self) = @_; |
158
|
229
|
|
|
|
|
303
|
return unpack('H*', $self->{tree}->[ $#{$self->{tree}} ]->[0]->{hash} ); |
|
229
|
|
|
|
|
1609
|
|
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
1; |