/[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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

1 dpavlin 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