/[BackupPC]/upstream/2.1.0/lib/BackupPC/CGI/Lib.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /upstream/2.1.0/lib/BackupPC/CGI/Lib.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Wed Jun 22 19:12:04 2005 UTC (16 years, 11 months ago) by dpavlin
File size: 16689 byte(s)
import of version 2.1.0

1 #============================================================= -*-perl-*-
2 #
3 # BackupPC::CGI::Lib package
4 #
5 # DESCRIPTION
6 #
7 # This library defines a BackupPC::Lib class and a variety of utility
8 # functions used by BackupPC.
9 #
10 # AUTHOR
11 # Craig Barratt <cbarratt@users.sourceforge.net>
12 #
13 # COPYRIGHT
14 # Copyright (C) 2003 Craig Barratt
15 #
16 # This program is free software; you can redistribute it and/or modify
17 # it under the terms of the GNU General Public License as published by
18 # the Free Software Foundation; either version 2 of the License, or
19 # (at your option) any later version.
20 #
21 # This program is distributed in the hope that it will be useful,
22 # but WITHOUT ANY WARRANTY; without even the implied warranty of
23 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 # GNU General Public License for more details.
25 #
26 # You should have received a copy of the GNU General Public License
27 # along with this program; if not, write to the Free Software
28 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
29 #
30 #========================================================================
31 #
32 # Version 2.1.0, released 20 Jun 2004.
33 #
34 # See http://backuppc.sourceforge.net.
35 #
36 #========================================================================
37
38 package BackupPC::CGI::Lib;
39
40 use strict;
41 use BackupPC::Lib;
42
43 require Exporter;
44
45 use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS );
46
47 use vars qw($Cgi %In $MyURL $User %Conf $TopDir $BinDir $bpc);
48 use vars qw(%Status %Info %Jobs @BgQueue @UserQueue @CmdQueue
49 %QueueLen %StatusHost);
50 use vars qw($Hosts $HostsMTime $ConfigMTime $PrivAdmin);
51 use vars qw(%UserEmailInfo $UserEmailInfoMTime %RestoreReq %ArchiveReq);
52 use vars qw($Lang);
53
54 @ISA = qw(Exporter);
55
56 @EXPORT = qw( );
57
58 @EXPORT_OK = qw(
59 timeStamp2
60 HostLink
61 UserLink
62 EscHTML
63 EscURI
64 ErrorExit
65 ServerConnect
66 GetStatusInfo
67 ReadUserEmailInfo
68 CheckPermission
69 GetUserHosts
70 ConfirmIPAddress
71 Header
72 Trailer
73 NavSectionTitle
74 NavSectionStart
75 NavSectionEnd
76 NavLink
77 h1
78 h2
79 $Cgi %In $MyURL $User %Conf $TopDir $BinDir $bpc
80 %Status %Info %Jobs @BgQueue @UserQueue @CmdQueue
81 %QueueLen %StatusHost
82 $Hosts $HostsMTime $ConfigMTime $PrivAdmin
83 %UserEmailInfo $UserEmailInfoMTime %RestoreReq %ArchiveReq
84 $Lang
85 );
86
87 %EXPORT_TAGS = (
88 'all' => [ @EXPORT_OK ],
89 );
90
91 sub NewRequest
92 {
93 $Cgi = new CGI;
94 %In = $Cgi->Vars;
95
96 if ( !defined($bpc) ) {
97 ErrorExit($Lang->{BackupPC__Lib__new_failed__check_apache_error_log})
98 if ( !($bpc = BackupPC::Lib->new(undef, undef, 1)) );
99 $TopDir = $bpc->TopDir();
100 $BinDir = $bpc->BinDir();
101 %Conf = $bpc->Conf();
102 $Lang = $bpc->Lang();
103 $ConfigMTime = $bpc->ConfigMTime();
104 } elsif ( $bpc->ConfigMTime() != $ConfigMTime ) {
105 $bpc->ServerMesg("log Re-read config file because mtime changed");
106 $bpc->ServerMesg("server reload");
107 }
108
109 #
110 # Default REMOTE_USER so in a miminal installation the user
111 # has a sensible default.
112 #
113 $ENV{REMOTE_USER} = $Conf{BackupPCUser} if ( $ENV{REMOTE_USER} eq "" );
114
115 #
116 # We require that Apache pass in $ENV{SCRIPT_NAME} and $ENV{REMOTE_USER}.
117 # The latter requires .ht_access style authentication. Replace this
118 # code if you are using some other type of authentication, and have
119 # a different way of getting the user name.
120 #
121 $MyURL = $ENV{SCRIPT_NAME};
122 $User = $ENV{REMOTE_USER};
123
124 #
125 # Clean up %ENV for taint checking
126 #
127 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
128 $ENV{PATH} = $Conf{MyPath};
129
130 #
131 # Verify we are running as the correct user
132 #
133 if ( $Conf{BackupPCUserVerify}
134 && $> != (my $uid = (getpwnam($Conf{BackupPCUser}))[2]) ) {
135 ErrorExit(eval("qq{$Lang->{Wrong_user__my_userid_is___}}"), <<EOF);
136 This script needs to run as the user specified in \$Conf{BackupPCUser},
137 which is set to $Conf{BackupPCUser}.
138 <p>
139 This is an installation problem. If you are using mod_perl then
140 it appears that Apache is not running as user $Conf{BackupPCUser}.
141 If you are not using mod_perl, then most like setuid is not working
142 properly on BackupPC_Admin. Check the permissions on
143 $Conf{CgiDir}/BackupPC_Admin and look at the documentation.
144 EOF
145 }
146
147 if ( !defined($Hosts) || $bpc->HostsMTime() != $HostsMTime ) {
148 $HostsMTime = $bpc->HostsMTime();
149 $Hosts = $bpc->HostInfoRead();
150
151 # turn moreUsers list into a hash for quick lookups
152 foreach my $host (keys %$Hosts) {
153 $Hosts->{$host}{moreUsers} =
154 {map {$_, 1} split(",", $Hosts->{$host}{moreUsers}) }
155 }
156 }
157 }
158
159 sub timeStamp2
160 {
161 my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
162 = localtime($_[0] == 0 ? time : $_[0] );
163 $mon++;
164 if ( $Conf{CgiDateFormatMMDD} ) {
165 return sprintf("$mon/$mday %02d:%02d", $hour, $min);
166 } else {
167 return sprintf("$mday/$mon %02d:%02d", $hour, $min);
168 }
169 }
170
171 sub HostLink
172 {
173 my($host) = @_;
174 my($s);
175 if ( defined($Hosts->{$host}) || defined($Status{$host}) ) {
176 $s = "<a href=\"$MyURL?host=${EscURI($host)}\">$host</a>";
177 } else {
178 $s = $host;
179 }
180 return \$s;
181 }
182
183 sub UserLink
184 {
185 my($user) = @_;
186 my($s);
187
188 return \$user if ( $user eq ""
189 || $Conf{CgiUserUrlCreate} eq "" );
190 if ( $Conf{CgiUserHomePageCheck} eq ""
191 || -f sprintf($Conf{CgiUserHomePageCheck}, $user, $user, $user) ) {
192 $s = "<a href=\""
193 . sprintf($Conf{CgiUserUrlCreate}, $user, $user, $user)
194 . "\">$user</a>";
195 } else {
196 $s = $user;
197 }
198 return \$s;
199 }
200
201 sub EscHTML
202 {
203 my($s) = @_;
204 $s =~ s/&/&amp;/g;
205 $s =~ s/\"/&quot;/g;
206 $s =~ s/>/&gt;/g;
207 $s =~ s/</&lt;/g;
208 $s =~ s{([^[:print:]])}{sprintf("&\#x%02X;", ord($1));}eg;
209 return \$s;
210 }
211
212 sub EscURI
213 {
214 my($s) = @_;
215 $s =~ s{([^\w.\/-])}{sprintf("%%%02X", ord($1));}eg;
216 return \$s;
217 }
218
219 sub ErrorExit
220 {
221 my(@mesg) = @_;
222 my($head) = shift(@mesg);
223 my($mesg) = join("</p>\n<p>", @mesg);
224
225 if ( !defined($ENV{REMOTE_USER}) ) {
226 $mesg .= <<EOF;
227 <p>
228 Note: \$ENV{REMOTE_USER} is not set, which could mean there is an
229 installation problem. BackupPC_Admin expects Apache to authenticate
230 the user and pass their user name into this script as the REMOTE_USER
231 environment variable. See the documentation.
232 EOF
233 }
234
235 $bpc->ServerMesg("log User $User (host=$In{host}) got CGI error: $head")
236 if ( defined($bpc) );
237 if ( !defined($Lang->{Error}) ) {
238 $mesg = <<EOF if ( !defined($mesg) );
239 There is some problem with the BackupPC installation.
240 Please check the permissions on BackupPC_Admin.
241 EOF
242 my $content = <<EOF;
243 ${h1("Error: Unable to read config.pl or language strings!!")}
244 <p>$mesg</p>
245 EOF
246 Header("BackupPC: Error", $content);
247 Trailer();
248 } else {
249 my $content = eval("qq{$Lang->{Error____head}}");
250 Header(eval("qq{$Lang->{Error}}"), $content);
251 Trailer();
252 }
253 exit(1);
254 }
255
256 sub ServerConnect
257 {
258 #
259 # Verify that the server connection is ok
260 #
261 return if ( $bpc->ServerOK() );
262 $bpc->ServerDisconnect();
263 if ( my $err = $bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort}) ) {
264 if ( CheckPermission()
265 && -f $Conf{ServerInitdPath}
266 && $Conf{ServerInitdStartCmd} ne "" ) {
267 my $content = eval("qq{$Lang->{Admin_Start_Server}}");
268 Header(eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}"), $content);
269 Trailer();
270 exit(1);
271 } else {
272 ErrorExit(eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}"));
273 }
274 }
275 }
276
277 sub GetStatusInfo
278 {
279 my($status) = @_;
280 ServerConnect();
281 my $reply = $bpc->ServerMesg("status $status");
282 $reply = $1 if ( $reply =~ /(.*)/s );
283 eval($reply);
284 # ignore status related to admin and trashClean jobs
285 if ( $status =~ /\bhosts\b/ ) {
286 foreach my $host ( grep(/admin/, keys(%Status)) ) {
287 delete($Status{$host}) if ( $bpc->isAdminJob($host) );
288 }
289 delete($Status{$bpc->trashJob});
290 }
291 }
292
293 sub ReadUserEmailInfo
294 {
295 if ( (stat("$TopDir/log/UserEmailInfo.pl"))[9] != $UserEmailInfoMTime ) {
296 do "$TopDir/log/UserEmailInfo.pl";
297 $UserEmailInfoMTime = (stat("$TopDir/log/UserEmailInfo.pl"))[9];
298 }
299 }
300
301 #
302 # Check if the user is privileged. A privileged user can access
303 # any information (backup files, logs, status pages etc).
304 #
305 # A user is privileged if they belong to the group
306 # $Conf{CgiAdminUserGroup}, or they are in $Conf{CgiAdminUsers}
307 # or they are the user assigned to a host in the host file.
308 #
309 sub CheckPermission
310 {
311 my($host) = @_;
312 my $Privileged = 0;
313
314 return 0 if ( $User eq "" && $Conf{CgiAdminUsers} ne "*"
315 || $host ne "" && !defined($Hosts->{$host}) );
316 if ( $Conf{CgiAdminUserGroup} ne "" ) {
317 my($n,$p,$gid,$mem) = getgrnam($Conf{CgiAdminUserGroup});
318 $Privileged ||= ($mem =~ /\b$User\b/);
319 }
320 if ( $Conf{CgiAdminUsers} ne "" ) {
321 $Privileged ||= ($Conf{CgiAdminUsers} =~ /\b$User\b/);
322 $Privileged ||= $Conf{CgiAdminUsers} eq "*";
323 }
324 $PrivAdmin = $Privileged;
325 return $Privileged if ( !defined($host) );
326
327 $Privileged ||= $User eq $Hosts->{$host}{user};
328 $Privileged ||= defined($Hosts->{$host}{moreUsers}{$User});
329 return $Privileged;
330 }
331
332 #
333 # Returns the list of hosts that should appear in the navigation bar
334 # for this user. If $getAll is set, the admin gets all the hosts.
335 # Otherwise, regular users get hosts for which they are the user or
336 # are listed in the moreUsers column in the hosts file.
337 #
338 sub GetUserHosts
339 {
340 my($getAll) = @_;
341 my @hosts;
342
343 if ( $getAll && CheckPermission() ) {
344 @hosts = sort keys %$Hosts;
345 } else {
346 @hosts = sort grep { $Hosts->{$_}{user} eq $User ||
347 defined($Hosts->{$_}{moreUsers}{$User}) } keys(%$Hosts);
348 }
349 return @hosts;
350 }
351
352 #
353 # Given a host name tries to find the IP address. For non-dhcp hosts
354 # we just return the host name. For dhcp hosts we check the address
355 # the user is using ($ENV{REMOTE_ADDR}) and also the last-known IP
356 # address for $host. (Later we should replace this with a broadcast
357 # nmblookup.)
358 #
359 sub ConfirmIPAddress
360 {
361 my($host) = @_;
362 my $ipAddr = $host;
363
364 if ( defined($Hosts->{$host}) && $Hosts->{$host}{dhcp}
365 && $ENV{REMOTE_ADDR} =~ /^(\d+[\.\d]*)$/ ) {
366 $ipAddr = $1;
367 my($netBiosHost, $netBiosUser) = $bpc->NetBiosInfoGet($ipAddr);
368 if ( $netBiosHost ne $host ) {
369 my($tryIP);
370 GetStatusInfo("host(${EscURI($host)})");
371 if ( defined($StatusHost{dhcpHostIP})
372 && $StatusHost{dhcpHostIP} ne $ipAddr ) {
373 $tryIP = eval("qq{$Lang->{tryIP}}");
374 ($netBiosHost, $netBiosUser)
375 = $bpc->NetBiosInfoGet($StatusHost{dhcpHostIP});
376 }
377 if ( $netBiosHost ne $host ) {
378 ErrorExit(eval("qq{$Lang->{Can_t_find_IP_address_for}}"),
379 eval("qq{$Lang->{host_is_a_DHCP_host}}"));
380 }
381 $ipAddr = $StatusHost{dhcpHostIP};
382 }
383 }
384 return $ipAddr;
385 }
386
387 ###########################################################################
388 # HTML layout subroutines
389 ###########################################################################
390
391 sub Header
392 {
393 my($title, $content, $noBrowse, $contentSub, $contentPost) = @_;
394 my @adminLinks = (
395 { link => "", name => $Lang->{Status}},
396 { link => "?action=adminOpts", name => $Lang->{Admin_Options},
397 priv => 1},
398 { link => "?action=summary", name => $Lang->{PC_Summary}},
399 { link => "?action=view&type=LOG", name => $Lang->{LOG_file},
400 priv => 1},
401 { link => "?action=LOGlist", name => $Lang->{Old_LOGs},
402 priv => 1},
403 { link => "?action=emailSummary", name => $Lang->{Email_summary},
404 priv => 1},
405 { link => "?action=view&type=config", name => $Lang->{Config_file},
406 priv => 1},
407 { link => "?action=view&type=hosts", name => $Lang->{Hosts_file},
408 priv => 1},
409 { link => "?action=queue", name => $Lang->{Current_queues},
410 priv => 1},
411 @{$Conf{CgiNavBarLinks} || []},
412 );
413 my $host = $In{host};
414
415 print $Cgi->header();
416 print <<EOF;
417 <!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
418 <html><head>
419 <title>$title</title>
420 <link rel=stylesheet type="text/css" href="$Conf{CgiImageDirURL}/$Conf{CgiCSSFile}" title="CSSFile">
421 $Conf{CgiHeaders}
422 </head><body onLoad="document.getElementById('NavMenu').style.height=document.body.scrollHeight">
423 <a href="http://backuppc.sourceforge.net"><img src="$Conf{CgiImageDirURL}/logo.gif" hspace="5" vspace="7" border="0"></a><br>
424 EOF
425
426 if ( defined($Hosts) && defined($host) && defined($Hosts->{$host}) ) {
427 print "<div class=\"NavMenu\">";
428 NavSectionTitle("${EscHTML($host)}");
429 print <<EOF;
430 </div>
431 <div class="NavMenu">
432 EOF
433 NavLink("?host=${EscURI($host)}",
434 "$host $Lang->{Home}", " class=\"navbar\"");
435 NavLink("?action=browse&host=${EscURI($host)}",
436 $Lang->{Browse}, " class=\"navbar\"") if ( !$noBrowse );
437 NavLink("?action=view&type=LOG&host=${EscURI($host)}",
438 $Lang->{LOG_file}, " class=\"navbar\"");
439 NavLink("?action=LOGlist&host=${EscURI($host)}",
440 $Lang->{LOG_files}, " class=\"navbar\"");
441 if ( -f "$TopDir/pc/$host/SmbLOG.bad"
442 || -f "$TopDir/pc/$host/SmbLOG.bad.z"
443 || -f "$TopDir/pc/$host/XferLOG.bad"
444 || -f "$TopDir/pc/$host/XferLOG.bad.z" ) {
445 NavLink("?action=view&type=XferLOGbad&host=${EscURI($host)}",
446 $Lang->{Last_bad_XferLOG}, " class=\"navbar\"");
447 NavLink("?action=view&type=XferErrbad&host=${EscURI($host)}",
448 $Lang->{Last_bad_XferLOG_errors_only},
449 " class=\"navbar\"");
450 }
451 if ( -f "$TopDir/pc/$host/config.pl" ) {
452 NavLink("?action=view&type=config&host=${EscURI($host)}",
453 $Lang->{Config_file}, " class=\"navbar\"");
454 }
455 print "</div>\n";
456 }
457 print("<div id=\"Content\">\n$content\n");
458 if ( defined($contentSub) && ref($contentSub) eq "CODE" ) {
459 while ( (my $s = &$contentSub()) ne "" ) {
460 print($s);
461 }
462 }
463 print($contentPost) if ( defined($contentPost) );
464 print <<EOF;
465 <br><br><br>
466 </div>
467 <div class="NavMenu" id="NavMenu" style="height:100%">
468 EOF
469 my $hostSelectbox = "<option value=\"#\">$Lang->{Select_a_host}</option>";
470 my @hosts = GetUserHosts($Conf{CgiNavBarAdminAllHosts});
471 if ( defined($Hosts) && %$Hosts > 0 && @hosts ) {
472 NavSectionTitle($Lang->{Hosts});
473 foreach my $host ( @hosts ) {
474 NavLink("?host=${EscURI($host)}", $host)
475 if ( @hosts < $Conf{CgiNavBarAdminAllHosts} );
476 my $sel = " selected" if ( $host eq $In{host} );
477 $hostSelectbox .= "<option value=\"?host=${EscURI($host)}\"$sel>"
478 . "$host</option>";
479 }
480 }
481 if ( @hosts >= $Conf{CgiNavBarAdminAllHosts} ) {
482 print <<EOF;
483 <br>
484 <select onChange="document.location=this.value">
485 $hostSelectbox
486 </select>
487 <br><br>
488 EOF
489 }
490 if ( $Conf{CgiSearchBoxEnable} ) {
491 print <<EOF;
492 <form action="$MyURL" method="get">
493 <input type="text" name="host" size="14" maxlength="64">
494 <input type="hidden" name="action" value="hostInfo"><input type="submit" value="$Lang->{Go}" name="ignore">
495 </form>
496 EOF
497 }
498 NavSectionTitle($Lang->{NavSectionTitle_});
499 foreach my $l ( @adminLinks ) {
500 if ( $PrivAdmin || !$l->{priv} ) {
501 my $txt = defined($l->{lname}) ? $Lang->{$l->{lname}} : $l->{name};
502 NavLink($l->{link}, $txt);
503 }
504 }
505
506 print <<EOF;
507 <br><br><br>
508 </div>
509 EOF
510 }
511
512 sub Trailer
513 {
514 print <<EOF;
515 </body></html>
516 EOF
517 }
518
519
520 sub NavSectionTitle
521 {
522 my($head) = @_;
523 print <<EOF;
524 <div class="NavTitle">$head</div>
525 EOF
526 }
527
528 sub NavSectionStart
529 {
530 }
531
532 sub NavSectionEnd
533 {
534 }
535
536 sub NavLink
537 {
538 my($link, $text) = @_;
539 if ( defined($link) ) {
540 my($class);
541 $class = " class=\"NavCurrent\""
542 if ( length($link) && $ENV{REQUEST_URI} =~ /\Q$link\E$/
543 || $link eq "" && $ENV{REQUEST_URI} !~ /\?/ );
544 $link = "$MyURL$link" if ( $link eq "" || $link =~ /^\?/ );
545 print <<EOF;
546 <a href="$link"$class>$text</a>
547 EOF
548 } else {
549 print <<EOF;
550 $text<br>
551 EOF
552 }
553 }
554
555 sub h1
556 {
557 my($str) = @_;
558 return \<<EOF;
559 <div class="h1">$str</div>
560 EOF
561 }
562
563 sub h2
564 {
565 my($str) = @_;
566 return \<<EOF;
567 <div class="h2">$str</div>
568 EOF
569 }

  ViewVC Help
Powered by ViewVC 1.1.26