"Fossies" - the Fresh Open Source Software Archive 
Member "BackupPC-4.4.0/bin/BackupPC_Admin_SCGI" (20 Jun 2020, 16476 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.
See also the latest
Fossies "Diffs" side-by-side code changes report for "BackupPC_Admin_SCGI":
4.3.2_vs_4.4.0.
1 #!/usr/bin/perl
2 #============================================================= -*-perl-*-
3 #
4 # BackupPC_Admin_SCGI: An SCGI implementation of the BackupPC
5 # admin interface.
6 #
7 # DESCRIPTION
8 #
9 # BackupPC_Admin_SCGI runs as the BackupPC user, and spawns one
10 # or more children to hangle requests from apache. Apache needs
11 # the mod_scgi plugin, and communicates with BackupPC_Admin_SCGI
12 # over a designated TCP port.
13 #
14 # IMPORTANT SECURITY WARNING: the scgi protocol doesn't support any
15 # mutual authentication between apache and BackupPC_Admin_SCGI
16 # (ie: the SCGI server). Since apache handles access control,
17 # the SCGI server assumes that every request is valid.
18 #
19 # So *anyone* who can connect TCP port $Conf{SCGIServerPort} that
20 # BackupPC_Admin_SCGI is listening on has full access to all the
21 # BackupPC backups by spoofing SCGI requests. So if you use
22 # BackupPC_Admin_SCGI, you must block the $Conf{SCGIServerPort}
23 # TCP port from any remote machines, and only allow trusted users
24 # to access the machine that BackupPC_Admin_SCGI is running on.
25 #
26 # BackupPC_Admin_SCGI should refuse connections from non-localhost
27 # machines, but it is still recommended you configure your BackupPC
28 # host to block port $Conf{SCGIServerPort}.
29 #
30 # AUTHOR
31 # Craig Barratt <cbarratt@users.sourceforge.net>
32 #
33 # COPYRIGHT
34 # Copyright (C) 2013 Craig Barratt
35 #
36 # This program is free software: you can redistribute it and/or modify
37 # it under the terms of the GNU General Public License as published by
38 # the Free Software Foundation, either version 3 of the License, or
39 # (at your option) any later version.
40 #
41 # This program is distributed in the hope that it will be useful,
42 # but WITHOUT ANY WARRANTY; without even the implied warranty of
43 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
44 # GNU General Public License for more details.
45 #
46 # You should have received a copy of the GNU General Public License
47 # along with this program. If not, see <http://www.gnu.org/licenses/>.
48 #
49 #========================================================================
50 #
51 # Version 4.4.0, released 20 Jun 2020.
52 #
53 # See http://backuppc.sourceforge.net.
54 #
55 #========================================================================
56
57 use strict;
58 no utf8;
59
60 use lib "__INSTALLDIR__/lib";
61
62 use IO::Socket;
63 use Data::Dumper;
64 use POSIX ":sys_wait_h";
65 use CGI;
66
67 use BackupPC::Lib;
68 use BackupPC::XS;
69 use BackupPC::CGI::Lib qw(:all);
70 use BackupPC::CGI::AdminOptions;
71 use BackupPC::CGI::Archive;
72 use BackupPC::CGI::ArchiveInfo;
73 use BackupPC::CGI::Browse;
74 use BackupPC::CGI::DeleteBackup;
75 use BackupPC::CGI::DirHistory;
76 use BackupPC::CGI::EditConfig;
77 use BackupPC::CGI::EmailSummary;
78 use BackupPC::CGI::GeneralInfo;
79 use BackupPC::CGI::HostInfo;
80 use BackupPC::CGI::LOGlist;
81 use BackupPC::CGI::Metrics;
82 use BackupPC::CGI::Queue;
83 use BackupPC::CGI::ReloadServer;
84 use BackupPC::CGI::Restore;
85 use BackupPC::CGI::RestoreFile;
86 use BackupPC::CGI::RestoreInfo;
87 use BackupPC::CGI::StartServer;
88 use BackupPC::CGI::StartStopBackup;
89 use BackupPC::CGI::StopServer;
90 use BackupPC::CGI::Summary;
91 use BackupPC::CGI::View;
92
93 my %ActionDispatch = (
94 "summary" => "Summary",
95 "Start_Incr_Backup" => "StartStopBackup",
96 "Start_Full_Backup" => "StartStopBackup",
97 "Stop_Dequeue_Backup" => "StartStopBackup",
98 "Stop_Dequeue_Archive" => "StartStopBackup",
99 "queue" => "Queue",
100 "view" => "View",
101 "LOGlist" => "LOGlist",
102 "emailSummary" => "EmailSummary",
103 "browse" => "Browse",
104 "dirHistory" => "DirHistory",
105 "Restore" => "Restore",
106 "RestoreFile" => "RestoreFile",
107 "hostInfo" => "HostInfo",
108 "generalInfo" => "GeneralInfo",
109 "restoreInfo" => "RestoreInfo",
110 "archiveInfo" => "ArchiveInfo",
111 "Start_Archive" => "Archive",
112 "Archive" => "Archive",
113 "Reload" => "ReloadServer",
114 "startServer" => "StartServer",
115 "Stop" => "StopServer",
116 "adminOpts" => "AdminOptions",
117 "editConfig" => "EditConfig",
118 "deleteBackup" => "DeleteBackup",
119 "keepBackup" => "HostInfo",
120 "rss" => "Metrics",
121 "metrics" => "Metrics",
122 );
123 my %ChildPid2Num;
124
125 BEGIN {
126 eval "use SCGI;";
127 if ( $@ ) {
128 print("BackupPC_Admin_SCGI: can't load perl SCGI module - install via CPAN; exiting in 60 seconds\n");
129 #
130 # if we exit immediately, BackupPC will restart us immediately
131 #
132 sleep(60);
133 exit(1);
134 }
135 }
136
137 #
138 # Edit this if you want to get more information about each request
139 #
140 my $LogLevel = 0;
141
142 $Cgi = new CGI;
143
144 die("BackupPC::Lib->new failed\n") if ( !($bpc = BackupPC::Lib->new) );
145 $TopDir = $bpc->TopDir();
146 $LogDir = $bpc->LogDir();
147 $BinDir = $bpc->BinDir();
148 %Conf = $bpc->Conf();
149 $Lang = $bpc->Lang();
150 $ConfigMTime = $bpc->ConfigMTime();
151 umask($Conf{UmaskMode});
152
153 my $LockFile = "$LogDir/scgi_lock";
154 my $LockFileSz = 2048;
155 my $ChildExited = 0;
156
157 $SIG{INT} = \&childKill;
158 $SIG{CHLD} = \&childCleanup;
159 my $socket = IO::Socket::INET->new(
160 Listen => 5,
161 ReuseAddr => 1,
162 LocalAddr => 'localhost',
163 LocalPort => $Conf{SCGIServerPort} || 8199
164 ) or die "cannot bind to port $Conf{SCGIServerPort}: $!";
165
166 my $scgi = SCGI->new($socket, blocking => 1);
167
168 #
169 # Clean up %ENV for taint checking
170 #
171 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
172 $ENV{PATH} = $Conf{MyPath};
173
174 #
175 # We use a lock file with $MaxChild + 1 number of bytes to serialize the multiple
176 # children responding to requests, and to allow the parent to detect when all the
177 # children are busy (meaning we need more). We create a dummy file with $LockFileSz
178 # bytes. The bytes are used as follows:
179 #
180 # - Bytes 1..$MaxChild are locked by each child to indicate they are idle
181 # (which generally means they are blocking on locking byte #0).
182 #
183 # - Byte #0 is used to serialize the child's accepts(). Each child tries to lock
184 # byte #0. After one gets the lock, it does an accept(). Once the accept()
185 # returns, it unlocks byte #0, and also unlocks byte #child to indicate it is
186 # busy processing the request.
187 #
188 # - the parent blocks trying to lock bytes 1..$MaxChild. If it succeeds, it means
189 # all the children are busy, so it forks a new child.
190 #
191 my $LockFd;
192 if ( !open($LockFd, ">", $LockFile) ) {
193 print("BackupPC_Admin_SCGI: can't open/create $LockFile; exiting in 60 seconds\n");
194 sleep(60);
195 exit(1);
196 }
197 if ( syswrite($LockFd, chr(0) x $LockFileSz) != $LockFileSz ) {
198 print("BackupPC_Admin_SCGI: can't write $LockFileSz bytes to $LockFile; exiting in 60 seconds\n");
199 sleep(60);
200 exit(1);
201 }
202 close($LockFd);
203
204 my $MaxChild = 1;
205 for ( my $i = 0 ; $i < $MaxChild ; $i++ ) {
206 childRun($i);
207 }
208
209 #
210 # This is the parent. We try to get an exclusive lock on bytes 1..$MaxChild of the
211 # lock file. If we succeed in getting the lock, it means all the children are busy
212 # servicing requests, so we need to spawn another child to service new requests.
213 #
214 if ( !open($LockFd, "+<", $LockFile) ) {
215 print("BackupPC_Admin_SCGI: can't open $LockFile; exiting in 60 seconds\n");
216 sleep(60);
217 exit(1);
218 }
219 my $LockFdNum = fileno($LockFd);
220 while ( 1 ) {
221 if ( BackupPC::XS::DirOps::lockRangeFd($LockFdNum, 1, $MaxChild, 1) ) {
222 if ( $ChildExited ) {
223 $ChildExited = 0;
224 #
225 # If a second child dies while in the signal handler caused by the
226 # first death, we won't get another signal. So we must do a non-blocking
227 # loop here else we will leave the unreaped child as a zombie. And
228 # the next time two children die we get another zombie. And so on.
229 #
230 # As we reap each child, we start another one in the same slot.
231 #
232 while ( (my $child = waitpid(-1, WNOHANG)) > 0 ) {
233 print("BackupPC_Admin_SCGI: child $child exited ($!)\n")
234 if ( $LogLevel >= 3 );
235 if ( defined($ChildPid2Num{$child}) ) {
236 childRun($ChildPid2Num{$child});
237 }
238 }
239 next;
240 }
241 print("BackupPC_Admin_SCGI: parent lock failed ($!)... continuing\n")
242 if ( $LogLevel >= 3 );
243 sleep(1);
244 next;
245 }
246 BackupPC::XS::DirOps::unlockRangeFd($LockFdNum, 1, $MaxChild);
247 print("BackupPC_Admin_SCGI: all children busy... starting a new child $MaxChild\n")
248 if ( $LogLevel >= 5 );
249 if ( $MaxChild >= $LockFileSz - 2 ) {
250 #
251 # Need to extend the lock file size, since we need a lock byte for
252 # every child, plus one.
253 #
254 $LockFileSz *= 2;
255 print("BackupPC_Admin_SCGI: extending $LockFile to length $LockFileSz\n");
256 sysseek($LockFd, 0, 0);
257 if ( syswrite($LockFd, chr(0) x $LockFileSz) != $LockFileSz ) {
258 print(
259 "BackupPC_Admin_SCGI: can't write $LockFileSz bytes to $LockFile; terminating children and exiting...\n"
260 );
261 kill 2, keys(%ChildPid2Num);
262 sleep(1);
263 kill 9, keys(%ChildPid2Num);
264 exit(1);
265 }
266 sysseek($LockFd, 0, 0);
267 }
268 childRun($MaxChild++);
269 }
270
271 sub childRun
272 {
273 my($childNum) = @_;
274 my($pid, $fhRead, $fhWrite);
275
276 #
277 # There is a race condition that we have to avoid when we fork a new child.
278 # If the parent returns quickly before the child has secured its idle lock,
279 # then the parent will immediately think all children are busy, and will
280 # start another child.
281 #
282 # So we create a pipe. The parent waits for the child to close the pipe,
283 # which it does after it has secured its idle lock. The parent can then
284 # continue, trying to lock bytes 1..$MaxChild, which will initially block
285 # due to the new child being idle.
286 #
287 pipe($fhRead, $fhWrite);
288 $pid = fork();
289 if ( $pid ) {
290 #
291 # Parent remembers the child's pid, and waits for the child
292 # to grab its idle lock. Then we're done.
293 #
294 $ChildPid2Num{$pid} = $childNum;
295 print("BackupPC_Admin_SCGI: Parent about to read pipe\n") if ( $LogLevel >= 5 );
296 close($fhWrite);
297 sysread($fhRead, my $dummy, 1);
298 close($fhRead);
299 print("BackupPC_Admin_SCGI: Parent closing pipe\n") if ( $LogLevel >= 5 );
300 return;
301 }
302 #
303 # This is the child.
304 #
305 $SIG{INT} = "DEFAULT";
306 close($fhRead);
307 close($LockFd);
308 print("BackupPC_Admin_SCGI: child $childNum starting (pid $$)\n") if ( $LogLevel >= 3 );
309 if ( !open($LockFd, "+<", $LockFile) ) {
310 print("BackupPC_Admin_SCGI: child $childNum can't open $LockFile; exiting\n");
311 exit(1);
312 }
313 $LockFdNum = fileno($LockFd);
314 while ( 1 ) {
315 #
316 # Grab a lock on byte #$childNum to indicate we are idle.
317 #
318 if ( BackupPC::XS::DirOps::lockRangeFd($LockFdNum, 1 + $childNum, 1, 1) ) {
319 print("BackupPC_Admin_SCGI: child $childNum failed to get idle lock ($!)\n")
320 if ( $LogLevel >= 3 );
321 sleep(1);
322 next;
323 }
324 print("BackupPC_Admin_SCGI: child $childNum got idle lock\n")
325 if ( $LogLevel >= 5 );
326
327 if ( defined($fhWrite) ) {
328 #
329 # Now close the pipe write side, so the parent can safely continue.
330 #
331 close($fhWrite);
332 $fhWrite = undef;
333 }
334
335 #
336 # We use an exclusive lock on byte 0 of the lock file to make sure
337 # only one child does an accept at a time. As we process the
338 # request, another child will get the lock on byte 0 and will accept
339 # the next request.
340 #
341 if ( BackupPC::XS::DirOps::lockRangeFd($LockFdNum, 0, 1, 1) ) {
342 print("BackupPC_Admin_SCGI: child $childNum lock failed ($!)... continuing\n")
343 if ( $LogLevel >= 3 );
344 sleep(1);
345 next;
346 }
347 print("BackupPC_Admin_SCGI: child $childNum got accept lock\n")
348 if ( $LogLevel >= 5 );
349 my $request = $scgi->accept;
350 BackupPC::XS::DirOps::unlockRangeFd($LockFdNum, 0, 1);
351 BackupPC::XS::DirOps::unlockRangeFd($LockFdNum, 1 + $childNum, 1);
352
353 my $iaddr = $request->connection->peeraddr();
354 if ( ord($iaddr) != 127 ) {
355 #
356 # peer is not a localhost address (ie: 127.0.0.1/8); ignore it
357 #
358 my $addrStr = join(".", unpack("C*", $iaddr));
359 printf("BackupPC_Admin_SCGI: unexpected connection from $addrStr (%s) ignored\n",
360 gethostbyaddr($iaddr, AF_INET));
361 $request = undef;
362 next;
363 }
364 print("BackupPC_Admin_SCGI: child $childNum processing request\n")
365 if ( $LogLevel >= 5 );
366 handleRequest($request);
367 $request = undef;
368 select(STDOUT);
369 print("BackupPC_Admin_SCGI: child $childNum finished request\n")
370 if ( $LogLevel >= 5 );
371 }
372 }
373
374 sub handleRequest
375 {
376 my($request) = @_;
377
378 $request->read_env;
379 my $con = $request->connection;
380 read($con, my $body, $request->env->{CONTENT_LENGTH});
381
382 select($con);
383 NewRequest($request, $body);
384
385 if ( $LogLevel >= 4 ) {
386 my $fdDebug;
387 open($fdDebug, ">", "$LogDir/request.txt");
388 print $fdDebug "Environment: ", Dumper($request->env), "\n\n";
389 print $fdDebug "Body: ", $body, "\n\n";
390 print $fdDebug "Other: ", "User = $User, MyURL = $MyURL, PID = $$, In = ", Dumper(\%In), "Conf = ",
391 Dumper(\%Conf), "\n\n";
392 close($fdDebug);
393 }
394 if ( !defined($ActionDispatch{$In{action}}) ) {
395 $In{action} = defined($In{host}) ? "hostInfo" : "generalInfo";
396 }
397 my $action = $ActionDispatch{$In{action}};
398 $BackupPC::CGI::{"${action}::"}{action}();
399 }
400
401 sub NewRequest
402 {
403 my($request, $body) = @_;
404 my($queryStr);
405
406 %In = ();
407 if ( $request->env->{REQUEST_METHOD} eq "POST" ) {
408 $queryStr = $body;
409 } else {
410 $queryStr = $request->env->{QUERY_STRING};
411 }
412 foreach my $p ( split(/&/, $queryStr) ) {
413 next if ( $p !~ /^([^=]*)=(.*)/ );
414 my $name = $1;
415 $In{$name} = $2;
416 $In{$name} =~ s/\+/ /g;
417 $In{$name} =~ s{%(..)}{chr(hex($1))}eg;
418 }
419 $ENV{SCRIPT_NAME} = $request->env->{SCRIPT_NAME};
420 $ENV{REMOTE_USER} = $request->env->{REMOTE_USER};
421 $ENV{REQUEST_URI} = $request->env->{REQUEST_URI};
422
423 if ( $bpc->ConfigMTime() != $ConfigMTime ) {
424 $bpc->ConfigRead();
425 $TopDir = $bpc->TopDir();
426 $LogDir = $bpc->LogDir();
427 $BinDir = $bpc->BinDir();
428 %Conf = $bpc->Conf();
429 $Lang = $bpc->Lang();
430 $ConfigMTime = $bpc->ConfigMTime();
431 umask($Conf{UmaskMode});
432 }
433
434 #
435 # Default REMOTE_USER so in a miminal installation the user
436 # has a sensible default.
437 #
438 $ENV{REMOTE_USER} = $Conf{BackupPCUser} if ( $ENV{REMOTE_USER} eq "" );
439
440 #
441 # We require that Apache pass in $ENV{SCRIPT_NAME} and $ENV{REMOTE_USER}.
442 # The latter requires .ht_access style authentication. Replace this
443 # code if you are using some other type of authentication, and have
444 # a different way of getting the user name.
445 #
446 $MyURL = $ENV{SCRIPT_NAME};
447 $User = $ENV{REMOTE_USER};
448
449 #
450 # Handle LDAP uid=user when using mod_authz_ldap and otherwise untaint
451 #
452 $User = $1 if ( $User =~ /uid=([^,]+)/i || $User =~ /(.*)/ );
453
454 if ( !defined($Hosts) || $bpc->HostsMTime() != $HostsMTime ) {
455 $HostsMTime = $bpc->HostsMTime();
456 $Hosts = $bpc->HostInfoRead();
457
458 # turn moreUsers list into a hash for quick lookups
459 foreach my $host ( keys %$Hosts ) {
460 $Hosts->{$host}{moreUsers} =
461 {map { $_, 1 } split(",", $Hosts->{$host}{moreUsers})};
462 }
463 }
464
465 #
466 # Untaint the host name
467 #
468 if ( $In{host} =~ /^([\w.\s-]+)$/ ) {
469 $In{host} = $1;
470 } else {
471 delete($In{host});
472 }
473 }
474
475 sub childCleanup
476 {
477 $ChildExited = 1;
478 $SIG{CHLD} = \&childCleanup;
479 }
480
481 sub childKill
482 {
483 #print("childKill: ", join(",", keys(%ChildPid2Num)), "\n");
484 kill 2, keys(%ChildPid2Num);
485 sleep(1);
486 kill 9, keys(%ChildPid2Num);
487 exit(0);
488 }