17 |
17 |
18 use constant KiB => 1024; |
18 use constant KiB => 1024; |
19 use constant MiB => 1024 * KiB; |
19 use constant MiB => 1024 * KiB; |
20 use constant GiB => 1024 * MiB; |
20 use constant GiB => 1024 * MiB; |
21 use constant NOW => time(); |
21 use constant NOW => time(); |
22 use constant BS => 4 * MiB; |
22 use constant BS => 4 * MiB; |
23 use constant DATETIME => strftime("%Y-%m-%dT%H:%M:%SZ" => gmtime(NOW)); |
23 use constant DATETIME => strftime("%Y-%m-%dT%H:%M:%SZ" => gmtime(NOW)); |
24 use constant CIPHER => "aes-128-cbc"; |
24 use constant CIPHER => "aes-128-cbc"; |
25 |
25 |
26 sub get_devsize; |
26 sub get_devsize; |
27 sub get_devname; |
27 sub get_devname; |
48 -verbose => 2, |
48 -verbose => 2, |
49 exit => 0, |
49 exit => 0, |
50 -noperldoc => system("perldoc -V >/dev/null 2>&1") |
50 -noperldoc => system("perldoc -V >/dev/null 2>&1") |
51 ); |
51 ); |
52 }, |
52 }, |
53 "c|comment=s" => \$o{comment}, |
53 "c|comment=s" => \$o{comment}, |
54 "z|compress:i" => sub { $o{compress} = $_[1] ? $_[1] : Z_BEST_SPEED }, |
54 "z|compress:i" => sub { $o{compress} = $_[1] ? $_[1] : Z_BEST_SPEED }, |
55 "p|pass=s" => \$o{pass}, |
55 "p|pass=s" => \$o{pass}, |
56 "b|blocksize=s" => sub { |
56 "b|blocksize=s" => sub { |
57 given ($_[1]) { |
57 given ($_[1]) { |
58 when (/(\d+)G/i) { $o{blocksize} = $1 * GiB }; |
58 when (/(\d+)G/i) { $o{blocksize} = $1 * GiB }; |
59 when (/(\d+)M/i) { $o{blocksize} = $1 * MiB }; |
59 when (/(\d+)M/i) { $o{blocksize} = $1 * MiB }; |
60 when (/(\d+)K/i) { $o{blocksize} = $1 * KiB }; |
60 when (/(\d+)K/i) { $o{blocksize} = $1 * KiB }; |
89 my $idx = "{DIR}/idx/{HOSTNAME}/{DEVICE}/"; |
89 my $idx = "{DIR}/idx/{HOSTNAME}/{DEVICE}/"; |
90 my $data = "{DIR}/data"; |
90 my $data = "{DIR}/data"; |
91 my $info = "{DIR}/data/info"; |
91 my $info = "{DIR}/data/info"; |
92 my $size; |
92 my $size; |
93 |
93 |
94 |
|
95 foreach ($idx, $data, $info) { |
94 foreach ($idx, $data, $info) { |
96 s/{DIR}/$dst/g; |
95 s/{DIR}/$dst/g; |
97 s/{HOSTNAME}/hostname/eg; |
96 s/{HOSTNAME}/hostname/eg; |
98 s/{DEVICE}/get_devname($src)/eg; |
97 s/{DEVICE}/get_devname($src)/eg; |
99 } |
98 } |
145 |
144 |
146 while (my $buffer = <$in>) { |
145 while (my $buffer = <$in>) { |
147 my ($file, $ext, $cs); |
146 my ($file, $ext, $cs); |
148 $file = $cs = md5_hex($buffer); |
147 $file = $cs = md5_hex($buffer); |
149 $file =~ s/(?<fn>(?<prefix>...).*)/$+{prefix}\/$+{fn}/g; |
148 $file =~ s/(?<fn>(?<prefix>...).*)/$+{prefix}\/$+{fn}/g; |
150 $ext = ""; |
149 $ext = ""; |
151 $ext .= $o{compress} ? ".gz" : ""; |
150 $ext .= $o{compress} ? ".gz" : ""; |
152 $ext .= $o{pass} ? ".x" : ""; |
151 $ext .= $o{pass} ? ".x" : ""; |
153 |
152 |
154 # the extension we do not put into the index |
153 # the extension we do not put into the index |
155 my $log = sprintf "%12d %s %s" => ($. - 1), $cs, $file; |
154 my $log = sprintf "%12d %s %s" => ($. - 1), $cs, $file; |
156 |
155 |
157 if (not(-e "$data/$file" |
156 if ( |
158 or -e "$data/$file.gz" |
157 not( -e "$data/$file" |
159 or -e "$data/$file.x" |
158 or -e "$data/$file.gz" |
160 or -e "$data/$file.gz.x" |
159 or -e "$data/$file.x" |
161 or -e "$data/$file.x.gz")) { |
160 or -e "$data/$file.gz.x" |
|
161 or -e "$data/$file.x.gz") |
|
162 ) |
|
163 { |
162 mkpath dirname("$data/$file"); |
164 mkpath dirname("$data/$file"); |
163 my $out = File::Temp->new( |
165 my $out = File::Temp->new( |
164 TEMPLATE => ".XXXXXXX", |
166 TEMPLATE => ".XXXXXXX", |
165 DIR => dirname("$data/$file") |
167 DIR => dirname("$data/$file") |
166 ); |
168 ); |
167 |
169 |
168 if ($o{pass}) { |
170 if ($o{pass}) { |
169 open($out, "|openssl @{[CIPHER]} -pass $o{pass} -out $out"); |
171 open($out, "|openssl @{[CIPHER]} -pass $o{pass} -out $out"); |
170 } |
172 } |
171 binmode($out); |
173 binmode($out); |
172 if ($o{compress}) { |
174 if ($o{compress}) { |
173 gzip( |
175 gzip( |
174 \$buffer => $out, |
176 \$buffer => $out, |
175 -Minimal => 1, |
177 -Minimal => 1, |