"Fossies" - the Fresh Open Source Software Archive 
Member "BackupPC-4.4.0/lib/BackupPC/CGI/Archive.pm" (20 Jun 2020, 9180 Bytes) of package /linux/privat/BackupPC-4.4.0.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
For more information about "Archive.pm" see the
Fossies "Dox" file reference documentation and the latest
Fossies "Diffs" side-by-side code changes report:
4.3.2_vs_4.4.0.
1 #============================================================= -*-perl-*-
2 #
3 # BackupPC::CGI::Archive package
4 #
5 # DESCRIPTION
6 #
7 # This module implements the Archive action for the CGI interface.
8 #
9 # AUTHOR
10 # Craig Barratt <cbarratt@users.sourceforge.net>
11 #
12 # COPYRIGHT
13 # Copyright (C) 2003-2020 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 3 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, see <http://www.gnu.org/licenses/>.
27 #
28 #========================================================================
29 #
30 # Version 4.4.0, released 20 Jun 2020.
31 #
32 # See http://backuppc.sourceforge.net.
33 #
34 #========================================================================
35
36 package BackupPC::CGI::Archive;
37
38 use strict;
39 use BackupPC::CGI::Lib qw(:all);
40 use Data::Dumper;
41 use File::Path;
42
43 sub action
44 {
45 my $archHost = $In{host};
46 my $Privileged = CheckPermission();
47
48 if ( !$Privileged ) {
49 ErrorExit($Lang->{Only_privileged_users_can_archive});
50 }
51 if ( $In{type} == 0 ) {
52 my(
53 $fullTot, $fullSizeTot, $incrTot, $incrSizeTot, $str, $strNone,
54 $strGood, $hostCntGood, $hostCntNone, $checkBoxCnt, $backupnumber
55 );
56
57 $hostCntGood = $hostCntNone = $checkBoxCnt = $fullSizeTot = 0;
58 GetStatusInfo("hosts");
59
60 foreach my $host ( sort(keys(%Status)) ) {
61 my($fullDur, $incrCnt, $fullSize, $fullRate);
62 my @Backups = $bpc->BackupInfoRead($host);
63 my $fullCnt = $incrCnt = 0;
64 for ( my $i = 0 ; $i < @Backups ; $i++ ) {
65 if ( $Backups[$i]{type} eq "full" ) {
66 $fullSize = $Backups[$i]{size} / (1024 * 1024);
67 $incrSizeTot = 0;
68 } else {
69 $incrSizeTot = $Backups[$i]{size} / (1024 * 1024);
70 }
71 $backupnumber = $Backups[$i]{num};
72 }
73 $fullSizeTot += $fullSize + $incrSizeTot;
74 $fullSize = sprintf("%.2f", ($fullSize + $incrSizeTot) / 1024);
75 $str = <<EOF;
76 <tr>
77 <td class="border"><input type="hidden" name="backup$checkBoxCnt" value="$backupnumber"><input type="checkbox" name="fcb$checkBoxCnt" value="$host"> ${HostLink($host)} </td>
78 <td align="center" class="border"> ${UserLink($Hosts->{$host}{user})} </td>
79 <td align="center" class="border"> $fullSize </td>
80 EOF
81 $checkBoxCnt++;
82 if ( @Backups == 0 ) {
83 $hostCntNone++;
84 $strNone .= $str;
85 } else {
86 $hostCntGood++;
87 $strGood .= $str;
88 }
89 }
90 $fullSizeTot = sprintf("%.2f", $fullSizeTot / 1024);
91 my $now = timeStamp2(time);
92 my $checkAllHosts = $Lang->{checkAllHosts};
93 $strGood .= <<EOF;
94 <input type="hidden" name="archivehost" value="$In{'archivehost'}">
95 EOF
96 my $content = eval("qq{$Lang->{BackupPC_Archive}}");
97 Header(eval("qq{$Lang->{BackupPC__Archive}}"), $content, 1);
98 Trailer();
99 } else {
100 my(@HostList, @BackupList, $HostListStr, $hiddenStr, $pathHdr, $badFileCnt, $reply, $str);
101
102 #
103 # Pick up the archive host's config file
104 #
105 $bpc->ConfigRead($archHost);
106 %Conf = $bpc->Conf();
107
108 my $args = {
109 SplitPath => $Conf{SplitPath},
110 ParPath => $Conf{ParPath},
111 CatPath => $Conf{CatPath},
112 GzipPath => $Conf{GzipPath},
113 Bzip2Path => $Conf{Bzip2Path},
114 ArchiveDest => $Conf{ArchiveDest},
115 ArchiveComp => $Conf{ArchiveComp},
116 ArchivePar => $Conf{ArchivePar},
117 ArchiveSplit => $Conf{ArchiveSplit},
118 topDir => $bpc->{TopDir},
119 };
120
121 ServerConnect();
122
123 for ( my $i = 0 ; $i < $In{fcbMax} ; $i++ ) {
124 next if ( !defined($In{"fcb$i"}) );
125 my $name = $In{"fcb$i"};
126 my $backupno = $In{"backup$i"};
127 push(@HostList, $name);
128 push(@BackupList, $backupno);
129 $hiddenStr .= <<EOF;
130 <input type="hidden" name="fcb$i" value="$In{'fcb' . $i}">
131 <input type="hidden" name="backup$i" value="$In{'backup' . $i}">
132 EOF
133 $HostListStr .= <<EOF;
134 <li> ${EscHTML($name)}
135 EOF
136 }
137 $hiddenStr .= <<EOF;
138 <input type="hidden" name="archivehost" value="$In{'archivehost'}">
139 EOF
140 $hiddenStr .= "<input type=\"hidden\" name=\"fcbMax\" value=\"$In{fcbMax}\">\n";
141 if ( @HostList == 0 ) {
142 ErrorExit($Lang->{You_haven_t_selected_any_hosts});
143 }
144 my($ArchiveDest, $ArchiveCompNone, $ArchiveCompGzip, $ArchiveCompBzip2, $ArchivePar, $ArchiveSplit);
145 $ArchiveDest = $Conf{ArchiveDest};
146 if ( $Conf{ArchiveComp} eq "none" ) {
147 $ArchiveCompNone = "checked";
148 } else {
149 $ArchiveCompNone = "";
150 }
151 if ( $Conf{ArchiveComp} eq "gzip" ) {
152 $ArchiveCompGzip = "checked";
153 } else {
154 $ArchiveCompGzip = "";
155 }
156 if ( $Conf{ArchiveComp} eq "bzip2" ) {
157 $ArchiveCompBzip2 = "checked";
158 } else {
159 $ArchiveCompBzip2 = "";
160 }
161 $ArchivePar = $Conf{ArchivePar};
162 $ArchiveSplit = $Conf{ArchiveSplit};
163
164 if ( $In{type} == 1 ) {
165 #
166 # Tell the user what options they have
167 #
168 my $paramStr = "";
169 if ( $Conf{ArchiveClientCmd} =~ /\$archiveloc\b/ ) {
170 $paramStr .= eval("qq{$Lang->{BackupPC_Archive2_location}}");
171 }
172 if ( $Conf{ArchiveClientCmd} =~ /\$compression\b/ ) {
173 $paramStr .= eval("qq{$Lang->{BackupPC_Archive2_compression}}");
174 }
175 if ( $Conf{ArchiveClientCmd} =~ /\$parfile\b/ && -x $Conf{ParPath} ) {
176 $paramStr .= eval("qq{$Lang->{BackupPC_Archive2_parity}}");
177 }
178 if ( $Conf{ArchiveClientCmd} =~ /\$splitsize\b/ && -x $Conf{SplitPath} ) {
179 $paramStr .= eval("qq{$Lang->{BackupPC_Archive2_split}}");
180 }
181 my $content = eval("qq{$Lang->{BackupPC_Archive2}}");
182 Header(eval("qq{$Lang->{BackupPC__Archive}}"), $content, 1);
183 Trailer();
184 } elsif ( $In{type} == 2 ) {
185 my $reqFileName;
186 my $archivehost = $1 if ( $In{archivehost} =~ /(.+)/ );
187 for ( my $i = 0 ; ; $i++ ) {
188 $reqFileName = "archiveReq.$$.$i";
189 last if ( !-f "$TopDir/pc/$archivehost/$reqFileName" );
190 }
191 my($compname, $compext);
192 if ( $In{compression} == 2 ) { # bzip2 compression
193 $compname = $Conf{Bzip2Path};
194 $compext = '.bz2';
195 } elsif ( $In{compression} == 1 ) { # gzip compression
196 $compname = $Conf{GzipPath};
197 $compext = '.gz';
198 } else { # No Compression
199 $compname = $Conf{CatPath};
200 $compext = '.raw';
201 }
202 my $fullsplitsize = $In{splitsize} . '000000';
203 my %ArchiveReq = (
204
205 # parameters for the archive
206 archiveloc => $In{archive_device},
207 archtype => $In{archive_type},
208 compression => $compname,
209 compext => $compext,
210 parfile => $In{par},
211 splitsize => $fullsplitsize,
212 host => $archivehost,
213
214 # list of hosts to restore
215 HostList => \@HostList,
216 BackupList => \@BackupList,
217
218 # other info
219 user => $User,
220 reqTime => time,
221 );
222 my($archive) = Data::Dumper->new([\%ArchiveReq], [qw(*ArchiveReq)]);
223 $archive->Indent(1);
224 eval { mkpath("$TopDir/pc/$archivehost", 0, 0777) }
225 if ( !-d "$TopDir/pc/$archivehost" );
226 my $openPath = "$TopDir/pc/$archivehost/$reqFileName";
227 if ( open(REQ, ">", $openPath) ) {
228 binmode(REQ);
229 print(REQ $archive->Dump);
230 close(REQ);
231 } else {
232 ErrorExit(eval("qq{$Lang->{Can_t_open_create__openPath}}"));
233 }
234 $reply = $bpc->ServerMesg("archive $User $archivehost $reqFileName");
235 $str = eval("qq{$Lang->{Archive_requested}}");
236
237 my $content = eval("qq{$Lang->{BackupPC_Archive_Reply_from_server}}");
238 Header(eval("qq{$Lang->{BackupPC__Archive}}"), $content, 1);
239 Trailer();
240 }
241 }
242 }
243
244 1;