1 |
#============================================================= -*-perl-*- |
2 |
# |
3 |
# BackupPC::CGI::Restore package |
4 |
# |
5 |
# DESCRIPTION |
6 |
# |
7 |
# This module implements the Restore action for the CGI interface. |
8 |
# |
9 |
# AUTHOR |
10 |
# Craig Barratt <cbarratt@users.sourceforge.net> |
11 |
# |
12 |
# COPYRIGHT |
13 |
# Copyright (C) 2003 Craig Barratt |
14 |
# |
15 |
# This program is free software; you can redistribute it and/or modify |
16 |
# it under the terms of the GNU General Public License as published by |
17 |
# the Free Software Foundation; either version 2 of the License, or |
18 |
# (at your option) any later version. |
19 |
# |
20 |
# This program is distributed in the hope that it will be useful, |
21 |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
22 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
23 |
# GNU General Public License for more details. |
24 |
# |
25 |
# You should have received a copy of the GNU General Public License |
26 |
# along with this program; if not, write to the Free Software |
27 |
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
28 |
# |
29 |
#======================================================================== |
30 |
# |
31 |
# Version 2.1.0, released 20 Jun 2004. |
32 |
# |
33 |
# See http://backuppc.sourceforge.net. |
34 |
# |
35 |
#======================================================================== |
36 |
|
37 |
package BackupPC::CGI::Restore; |
38 |
|
39 |
use strict; |
40 |
use BackupPC::CGI::Lib qw(:all); |
41 |
use Data::Dumper; |
42 |
use File::Path; |
43 |
|
44 |
sub action |
45 |
{ |
46 |
my($str, $reply, $content); |
47 |
my $Privileged = CheckPermission($In{host}); |
48 |
if ( !$Privileged ) { |
49 |
ErrorExit(eval("qq{$Lang->{Only_privileged_users_can_restore_backup_files}}")); |
50 |
} |
51 |
my $host = $In{host}; |
52 |
my $num = $In{num}; |
53 |
my $share = $In{share}; |
54 |
my(@fileList, $fileListStr, $hiddenStr, $pathHdr, $badFileCnt); |
55 |
my @Backups = $bpc->BackupInfoRead($host); |
56 |
|
57 |
ServerConnect(); |
58 |
if ( !defined($Hosts->{$host}) ) { |
59 |
ErrorExit(eval("qq{$Lang->{Bad_host_name}}")); |
60 |
} |
61 |
for ( my $i = 0 ; $i < $In{fcbMax} ; $i++ ) { |
62 |
next if ( !defined($In{"fcb$i"}) ); |
63 |
(my $name = $In{"fcb$i"}) =~ s/%([0-9A-F]{2})/chr(hex($1))/eg; |
64 |
$badFileCnt++ if ( $name =~ m{(^|/)\.\.(/|$)} ); |
65 |
if ( @fileList == 0 ) { |
66 |
$pathHdr = substr($name, 0, rindex($name, "/")); |
67 |
} else { |
68 |
while ( substr($name, 0, length($pathHdr)) ne $pathHdr ) { |
69 |
$pathHdr = substr($pathHdr, 0, rindex($pathHdr, "/")); |
70 |
} |
71 |
} |
72 |
push(@fileList, $name); |
73 |
$hiddenStr .= <<EOF; |
74 |
<input type="hidden" name="fcb$i" value="$In{'fcb' . $i}"> |
75 |
EOF |
76 |
$fileListStr .= <<EOF; |
77 |
<li> ${EscHTML($name)} |
78 |
EOF |
79 |
} |
80 |
$hiddenStr .= "<input type=\"hidden\" name=\"fcbMax\" value=\"$In{fcbMax}\">\n"; |
81 |
$hiddenStr .= "<input type=\"hidden\" name=\"share\" value=\"${EscHTML($share)}\">\n"; |
82 |
$badFileCnt++ if ( $In{pathHdr} =~ m{(^|/)\.\.(/|$)} ); |
83 |
$badFileCnt++ if ( $In{num} =~ m{(^|/)\.\.(/|$)} ); |
84 |
if ( @fileList == 0 ) { |
85 |
ErrorExit($Lang->{You_haven_t_selected_any_files__please_go_Back_to}); |
86 |
} |
87 |
if ( $badFileCnt ) { |
88 |
ErrorExit($Lang->{Nice_try__but_you_can_t_put}); |
89 |
} |
90 |
$pathHdr = "/" if ( $pathHdr eq "" ); |
91 |
if ( $In{type} != 0 && @fileList == $In{fcbMax} ) { |
92 |
# |
93 |
# All the files in the list were selected, so just restore the |
94 |
# entire parent directory |
95 |
# |
96 |
@fileList = ( $pathHdr ); |
97 |
} |
98 |
if ( $In{type} == 0 ) { |
99 |
# |
100 |
# Build list of hosts |
101 |
# |
102 |
my $hostDestSel; |
103 |
my @hosts; |
104 |
foreach my $h ( GetUserHosts(1) ) { |
105 |
my $sel = " selected" if ( $h eq $In{host} ); |
106 |
$hostDestSel .= "<option value=\"$h\"$sel>${EscHTML($h)}</option>"; |
107 |
push(@hosts, $h); |
108 |
} |
109 |
|
110 |
# |
111 |
# Tell the user what options they have |
112 |
# |
113 |
$content .= eval("qq{$Lang->{Restore_Options_for__host2}}"); |
114 |
|
115 |
# |
116 |
# If there is a single host, make sure direct restore is enabled |
117 |
# |
118 |
if ( @hosts == 1 ) { |
119 |
# |
120 |
# Pick up the host's config file |
121 |
# |
122 |
$bpc->ConfigRead($hosts[0]); |
123 |
%Conf = $bpc->Conf(); |
124 |
|
125 |
# |
126 |
# Decide if option 1 (direct restore) is available based |
127 |
# on whether the restore command is set. |
128 |
# |
129 |
my $cmd = $Conf{XferMethod} eq "smb" ? $Conf{SmbClientRestoreCmd} |
130 |
: $Conf{XferMethod} eq "tar" ? $Conf{TarClientRestoreCmd} |
131 |
: $Conf{XferMethod} eq "archive" ? undef |
132 |
: $Conf{RsyncRestoreArgs}; |
133 |
if ( defined($cmd) ) { |
134 |
$content .= eval( |
135 |
"qq{$Lang->{Restore_Options_for__host_Option1}}"); |
136 |
} else { |
137 |
my $hostDest = $hosts[0]; |
138 |
$content .= eval( |
139 |
"qq{$Lang->{Restore_Options_for__host_Option1_disabled}}"); |
140 |
} |
141 |
} else { |
142 |
$content .= eval("qq{$Lang->{Restore_Options_for__host_Option1}}"); |
143 |
} |
144 |
|
145 |
# |
146 |
# Verify that Archive::Zip is available before showing the |
147 |
# zip restore option |
148 |
# |
149 |
if ( eval { require Archive::Zip } ) { |
150 |
$content .= eval("qq{$Lang->{Option_2__Download_Zip_archive}}"); |
151 |
} else { |
152 |
$content .= eval("qq{$Lang->{Option_2__Download_Zip_archive2}}"); |
153 |
} |
154 |
$content .= eval("qq{$Lang->{Option_3__Download_Zip_archive}}"); |
155 |
Header(eval("qq{$Lang->{Restore_Options_for__host}}"), $content); |
156 |
Trailer(); |
157 |
} elsif ( $In{type} == 1 ) { |
158 |
# |
159 |
# Provide the selected files via a tar archive. |
160 |
# |
161 |
my @fileListTrim = @fileList; |
162 |
if ( @fileListTrim > 10 ) { |
163 |
@fileListTrim = (@fileListTrim[0..9], '...'); |
164 |
} |
165 |
$bpc->ServerMesg("log User $User downloaded tar archive for $host," |
166 |
. " backup $num; files were: " |
167 |
. join(", ", @fileListTrim)); |
168 |
|
169 |
my @pathOpts; |
170 |
if ( $In{relative} ) { |
171 |
@pathOpts = ("-r", $pathHdr, "-p", ""); |
172 |
} |
173 |
print(STDOUT <<EOF); |
174 |
Content-Type: application/x-gtar |
175 |
Content-Transfer-Encoding: binary |
176 |
Content-Disposition: attachment; filename=\"restore.tar\" |
177 |
|
178 |
EOF |
179 |
# |
180 |
# Fork the child off and manually copy the output to our stdout. |
181 |
# This is necessary to ensure the output gets to the correct place |
182 |
# under mod_perl. |
183 |
# |
184 |
$bpc->cmdSystemOrEvalLong(["$BinDir/BackupPC_tarCreate", |
185 |
"-h", $host, |
186 |
"-n", $num, |
187 |
"-s", $share, |
188 |
@pathOpts, |
189 |
@fileList |
190 |
], |
191 |
sub { print(@_); }, |
192 |
1, # ignore stderr |
193 |
); |
194 |
} elsif ( $In{type} == 2 ) { |
195 |
# |
196 |
# Provide the selected files via a zip archive. |
197 |
# |
198 |
my @fileListTrim = @fileList; |
199 |
if ( @fileListTrim > 10 ) { |
200 |
@fileListTrim = (@fileListTrim[0..9], '...'); |
201 |
} |
202 |
$bpc->ServerMesg("log User $User downloaded zip archive for $host," |
203 |
. " backup $num; files were: " |
204 |
. join(", ", @fileListTrim)); |
205 |
|
206 |
my @pathOpts; |
207 |
if ( $In{relative} ) { |
208 |
@pathOpts = ("-r", $pathHdr, "-p", ""); |
209 |
} |
210 |
print(STDOUT <<EOF); |
211 |
Content-Type: application/zip |
212 |
Content-Transfer-Encoding: binary |
213 |
Content-Disposition: attachment; filename=\"restore.zip\" |
214 |
|
215 |
EOF |
216 |
$In{compressLevel} = 5 if ( $In{compressLevel} !~ /^\d+$/ ); |
217 |
# |
218 |
# Fork the child off and manually copy the output to our stdout. |
219 |
# This is necessary to ensure the output gets to the correct place |
220 |
# under mod_perl. |
221 |
# |
222 |
$bpc->cmdSystemOrEvalLong(["$BinDir/BackupPC_zipCreate", |
223 |
"-h", $host, |
224 |
"-n", $num, |
225 |
"-c", $In{compressLevel}, |
226 |
"-s", $share, |
227 |
@pathOpts, |
228 |
@fileList |
229 |
], |
230 |
sub { print(@_); }, |
231 |
1, # ignore stderr |
232 |
); |
233 |
} elsif ( $In{type} == 3 ) { |
234 |
# |
235 |
# Do restore directly onto host |
236 |
# |
237 |
if ( !defined($Hosts->{$In{hostDest}}) ) { |
238 |
ErrorExit(eval("qq{$Lang->{Host__doesn_t_exist}}")); |
239 |
} |
240 |
if ( !CheckPermission($In{hostDest}) ) { |
241 |
ErrorExit(eval("qq{$Lang->{You_don_t_have_permission_to_restore_onto_host}}")); |
242 |
} |
243 |
# |
244 |
# Pick up the destination host's config file |
245 |
# |
246 |
my $hostDest = $1 if ( $In{hostDest} =~ /(.*)/ ); |
247 |
$bpc->ConfigRead($hostDest); |
248 |
%Conf = $bpc->Conf(); |
249 |
|
250 |
# |
251 |
# Decide if option 1 (direct restore) is available based |
252 |
# on whether the restore command is set. |
253 |
# |
254 |
my $cmd = $Conf{XferMethod} eq "smb" ? $Conf{SmbClientRestoreCmd} |
255 |
: $Conf{XferMethod} eq "tar" ? $Conf{TarClientRestoreCmd} |
256 |
: $Conf{XferMethod} eq "archive" ? undef |
257 |
: $Conf{RsyncRestoreArgs}; |
258 |
if ( !defined($cmd) ) { |
259 |
ErrorExit(eval("qq{$Lang->{Restore_Options_for__host_Option1_disabled}}")); |
260 |
} |
261 |
|
262 |
$fileListStr = ""; |
263 |
foreach my $f ( @fileList ) { |
264 |
my $targetFile = $f; |
265 |
(my $strippedShare = $share) =~ s/^\///; |
266 |
(my $strippedShareDest = $In{shareDest}) =~ s/^\///; |
267 |
substr($targetFile, 0, length($pathHdr)) = "/$In{pathHdr}/"; |
268 |
$targetFile =~ s{//+}{/}g; |
269 |
$fileListStr .= <<EOF; |
270 |
<tr><td>$host:/$strippedShare$f</td><td>$In{hostDest}:/$strippedShareDest$targetFile</td></tr> |
271 |
EOF |
272 |
} |
273 |
my $content = eval("qq{$Lang->{Are_you_sure}}"); |
274 |
Header(eval("qq{$Lang->{Restore_Confirm_on__host}}"), $content); |
275 |
Trailer(); |
276 |
} elsif ( $In{type} == 4 ) { |
277 |
if ( !defined($Hosts->{$In{hostDest}}) ) { |
278 |
ErrorExit(eval("qq{$Lang->{Host__doesn_t_exist}}")); |
279 |
} |
280 |
if ( !CheckPermission($In{hostDest}) ) { |
281 |
ErrorExit(eval("qq{$Lang->{You_don_t_have_permission_to_restore_onto_host}}")); |
282 |
} |
283 |
my $hostDest = $1 if ( $In{hostDest} =~ /(.+)/ ); |
284 |
my $ipAddr = ConfirmIPAddress($hostDest); |
285 |
# |
286 |
# Prepare and send the restore request. We write the request |
287 |
# information using Data::Dumper to a unique file, |
288 |
# $TopDir/pc/$hostDest/restoreReq.$$.n. We use a file |
289 |
# in case the list of files to restore is very long. |
290 |
# |
291 |
my $reqFileName; |
292 |
for ( my $i = 0 ; ; $i++ ) { |
293 |
$reqFileName = "restoreReq.$$.$i"; |
294 |
last if ( !-f "$TopDir/pc/$hostDest/$reqFileName" ); |
295 |
} |
296 |
my $inPathHdr = $In{pathHdr}; |
297 |
$inPathHdr = "/$inPathHdr" if ( $inPathHdr !~ m{^/} ); |
298 |
$inPathHdr = "$inPathHdr/" if ( $inPathHdr !~ m{/$} ); |
299 |
my %restoreReq = ( |
300 |
# source of restore is hostSrc, #num, path shareSrc/pathHdrSrc |
301 |
num => $In{num}, |
302 |
hostSrc => $host, |
303 |
shareSrc => $share, |
304 |
pathHdrSrc => $pathHdr, |
305 |
|
306 |
# destination of restore is hostDest:shareDest/pathHdrDest |
307 |
hostDest => $hostDest, |
308 |
shareDest => $In{shareDest}, |
309 |
pathHdrDest => $inPathHdr, |
310 |
|
311 |
# list of files to restore |
312 |
fileList => \@fileList, |
313 |
|
314 |
# other info |
315 |
user => $User, |
316 |
reqTime => time, |
317 |
); |
318 |
my($dump) = Data::Dumper->new( |
319 |
[ \%restoreReq], |
320 |
[qw(*RestoreReq)]); |
321 |
$dump->Indent(1); |
322 |
mkpath("$TopDir/pc/$hostDest", 0, 0777) |
323 |
if ( !-d "$TopDir/pc/$hostDest" ); |
324 |
if ( open(REQ, ">$TopDir/pc/$hostDest/$reqFileName") ) { |
325 |
binmode(REQ); |
326 |
print(REQ $dump->Dump); |
327 |
close(REQ); |
328 |
} else { |
329 |
ErrorExit(eval("qq{$Lang->{Can_t_open_create}}")); |
330 |
} |
331 |
$reply = $bpc->ServerMesg("restore ${EscURI($ipAddr)}" |
332 |
. " ${EscURI($hostDest)} $User $reqFileName"); |
333 |
$str = eval("qq{$Lang->{Restore_requested_to_host__hostDest__backup___num}}"); |
334 |
my $content = eval("qq{$Lang->{Reply_from_server_was___reply}}"); |
335 |
Header(eval("qq{$Lang->{Restore_Requested_on__hostDest}}"), $content); |
336 |
Trailer(); |
337 |
} |
338 |
} |
339 |
|
340 |
1; |