/[BackupPC]/trunk/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 /trunk/lib/BackupPC/CGI/Lib.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 316 - (hide annotations)
Mon Jan 30 13:37:17 2006 UTC (18 years, 4 months ago) by dpavlin
File size: 17381 byte(s)
 r9152@llin:  dpavlin | 2006-01-30 14:11:45 +0100
 update to upstream 2.1.2

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 dpavlin 316 # Version 2.1.2, released 5 Sep 2005.
33 dpavlin 1 #
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 dpavlin 316 $bpc->ConfigRead();
106     %Conf = $bpc->Conf();
107     $Lang = $bpc->Lang();
108     $ConfigMTime = $bpc->ConfigMTime();
109 dpavlin 1 }
110    
111     #
112     # Default REMOTE_USER so in a miminal installation the user
113     # has a sensible default.
114     #
115     $ENV{REMOTE_USER} = $Conf{BackupPCUser} if ( $ENV{REMOTE_USER} eq "" );
116    
117     #
118     # We require that Apache pass in $ENV{SCRIPT_NAME} and $ENV{REMOTE_USER}.
119     # The latter requires .ht_access style authentication. Replace this
120     # code if you are using some other type of authentication, and have
121     # a different way of getting the user name.
122     #
123     $MyURL = $ENV{SCRIPT_NAME};
124     $User = $ENV{REMOTE_USER};
125    
126     #
127     # Clean up %ENV for taint checking
128     #
129     delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
130     $ENV{PATH} = $Conf{MyPath};
131    
132     #
133     # Verify we are running as the correct user
134     #
135     if ( $Conf{BackupPCUserVerify}
136     && $> != (my $uid = (getpwnam($Conf{BackupPCUser}))[2]) ) {
137     ErrorExit(eval("qq{$Lang->{Wrong_user__my_userid_is___}}"), <<EOF);
138     This script needs to run as the user specified in \$Conf{BackupPCUser},
139     which is set to $Conf{BackupPCUser}.
140     <p>
141     This is an installation problem. If you are using mod_perl then
142     it appears that Apache is not running as user $Conf{BackupPCUser}.
143     If you are not using mod_perl, then most like setuid is not working
144     properly on BackupPC_Admin. Check the permissions on
145     $Conf{CgiDir}/BackupPC_Admin and look at the documentation.
146     EOF
147     }
148    
149     if ( !defined($Hosts) || $bpc->HostsMTime() != $HostsMTime ) {
150     $HostsMTime = $bpc->HostsMTime();
151     $Hosts = $bpc->HostInfoRead();
152    
153     # turn moreUsers list into a hash for quick lookups
154     foreach my $host (keys %$Hosts) {
155     $Hosts->{$host}{moreUsers} =
156     {map {$_, 1} split(",", $Hosts->{$host}{moreUsers}) }
157     }
158     }
159 dpavlin 316
160     #
161     # Untaint the host name
162     #
163     if ( $In{host} =~ /^([\w.\s-]+)$/ ) {
164     $In{host} = $1;
165     } else {
166     delete($In{host});
167     }
168 dpavlin 1 }
169    
170     sub timeStamp2
171     {
172     my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
173     = localtime($_[0] == 0 ? time : $_[0] );
174     $mon++;
175     if ( $Conf{CgiDateFormatMMDD} ) {
176     return sprintf("$mon/$mday %02d:%02d", $hour, $min);
177     } else {
178     return sprintf("$mday/$mon %02d:%02d", $hour, $min);
179     }
180     }
181    
182     sub HostLink
183     {
184     my($host) = @_;
185     my($s);
186     if ( defined($Hosts->{$host}) || defined($Status{$host}) ) {
187     $s = "<a href=\"$MyURL?host=${EscURI($host)}\">$host</a>";
188     } else {
189     $s = $host;
190     }
191     return \$s;
192     }
193    
194     sub UserLink
195     {
196     my($user) = @_;
197     my($s);
198    
199     return \$user if ( $user eq ""
200     || $Conf{CgiUserUrlCreate} eq "" );
201     if ( $Conf{CgiUserHomePageCheck} eq ""
202     || -f sprintf($Conf{CgiUserHomePageCheck}, $user, $user, $user) ) {
203     $s = "<a href=\""
204     . sprintf($Conf{CgiUserUrlCreate}, $user, $user, $user)
205     . "\">$user</a>";
206     } else {
207     $s = $user;
208     }
209     return \$s;
210     }
211    
212     sub EscHTML
213     {
214     my($s) = @_;
215     $s =~ s/&/&amp;/g;
216     $s =~ s/\"/&quot;/g;
217     $s =~ s/>/&gt;/g;
218     $s =~ s/</&lt;/g;
219     $s =~ s{([^[:print:]])}{sprintf("&\#x%02X;", ord($1));}eg;
220     return \$s;
221     }
222    
223     sub EscURI
224     {
225     my($s) = @_;
226     $s =~ s{([^\w.\/-])}{sprintf("%%%02X", ord($1));}eg;
227     return \$s;
228     }
229    
230     sub ErrorExit
231     {
232     my(@mesg) = @_;
233     my($head) = shift(@mesg);
234     my($mesg) = join("</p>\n<p>", @mesg);
235    
236     if ( !defined($ENV{REMOTE_USER}) ) {
237     $mesg .= <<EOF;
238     <p>
239     Note: \$ENV{REMOTE_USER} is not set, which could mean there is an
240     installation problem. BackupPC_Admin expects Apache to authenticate
241     the user and pass their user name into this script as the REMOTE_USER
242     environment variable. See the documentation.
243     EOF
244     }
245    
246     $bpc->ServerMesg("log User $User (host=$In{host}) got CGI error: $head")
247     if ( defined($bpc) );
248     if ( !defined($Lang->{Error}) ) {
249     $mesg = <<EOF if ( !defined($mesg) );
250     There is some problem with the BackupPC installation.
251     Please check the permissions on BackupPC_Admin.
252     EOF
253     my $content = <<EOF;
254     ${h1("Error: Unable to read config.pl or language strings!!")}
255     <p>$mesg</p>
256     EOF
257     Header("BackupPC: Error", $content);
258     Trailer();
259     } else {
260     my $content = eval("qq{$Lang->{Error____head}}");
261     Header(eval("qq{$Lang->{Error}}"), $content);
262     Trailer();
263     }
264     exit(1);
265     }
266    
267     sub ServerConnect
268     {
269     #
270     # Verify that the server connection is ok
271     #
272     return if ( $bpc->ServerOK() );
273     $bpc->ServerDisconnect();
274     if ( my $err = $bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort}) ) {
275     if ( CheckPermission()
276     && -f $Conf{ServerInitdPath}
277     && $Conf{ServerInitdStartCmd} ne "" ) {
278     my $content = eval("qq{$Lang->{Admin_Start_Server}}");
279     Header(eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}"), $content);
280     Trailer();
281     exit(1);
282     } else {
283     ErrorExit(eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}"));
284     }
285     }
286     }
287    
288     sub GetStatusInfo
289     {
290     my($status) = @_;
291     ServerConnect();
292 dpavlin 316 %Status = () if ( $status =~ /\bhosts\b/ );
293     %StatusHost = () if ( $status =~ /\bhost\(/ );
294 dpavlin 1 my $reply = $bpc->ServerMesg("status $status");
295     $reply = $1 if ( $reply =~ /(.*)/s );
296     eval($reply);
297     # ignore status related to admin and trashClean jobs
298     if ( $status =~ /\bhosts\b/ ) {
299     foreach my $host ( grep(/admin/, keys(%Status)) ) {
300     delete($Status{$host}) if ( $bpc->isAdminJob($host) );
301     }
302     delete($Status{$bpc->trashJob});
303     }
304     }
305    
306     sub ReadUserEmailInfo
307     {
308     if ( (stat("$TopDir/log/UserEmailInfo.pl"))[9] != $UserEmailInfoMTime ) {
309     do "$TopDir/log/UserEmailInfo.pl";
310     $UserEmailInfoMTime = (stat("$TopDir/log/UserEmailInfo.pl"))[9];
311     }
312     }
313    
314     #
315     # Check if the user is privileged. A privileged user can access
316     # any information (backup files, logs, status pages etc).
317     #
318     # A user is privileged if they belong to the group
319     # $Conf{CgiAdminUserGroup}, or they are in $Conf{CgiAdminUsers}
320     # or they are the user assigned to a host in the host file.
321     #
322     sub CheckPermission
323     {
324     my($host) = @_;
325     my $Privileged = 0;
326    
327     return 0 if ( $User eq "" && $Conf{CgiAdminUsers} ne "*"
328     || $host ne "" && !defined($Hosts->{$host}) );
329     if ( $Conf{CgiAdminUserGroup} ne "" ) {
330     my($n,$p,$gid,$mem) = getgrnam($Conf{CgiAdminUserGroup});
331     $Privileged ||= ($mem =~ /\b$User\b/);
332 dpavlin 231
333     # check against REMOTE_NTGROUP from mod_ntlm
334     $Privileged ||= $Conf{CgiAdminUserGroup} eq $ENV{REMOTE_NTGROUP};
335 dpavlin 1 }
336     if ( $Conf{CgiAdminUsers} ne "" ) {
337     $Privileged ||= ($Conf{CgiAdminUsers} =~ /\b$User\b/);
338     $Privileged ||= $Conf{CgiAdminUsers} eq "*";
339     }
340     $PrivAdmin = $Privileged;
341     return $Privileged if ( !defined($host) );
342    
343     $Privileged ||= $User eq $Hosts->{$host}{user};
344     $Privileged ||= defined($Hosts->{$host}{moreUsers}{$User});
345     return $Privileged;
346     }
347    
348     #
349     # Returns the list of hosts that should appear in the navigation bar
350     # for this user. If $getAll is set, the admin gets all the hosts.
351     # Otherwise, regular users get hosts for which they are the user or
352     # are listed in the moreUsers column in the hosts file.
353     #
354     sub GetUserHosts
355     {
356     my($getAll) = @_;
357     my @hosts;
358    
359     if ( $getAll && CheckPermission() ) {
360     @hosts = sort keys %$Hosts;
361     } else {
362     @hosts = sort grep { $Hosts->{$_}{user} eq $User ||
363     defined($Hosts->{$_}{moreUsers}{$User}) } keys(%$Hosts);
364     }
365     return @hosts;
366     }
367    
368     #
369     # Given a host name tries to find the IP address. For non-dhcp hosts
370     # we just return the host name. For dhcp hosts we check the address
371     # the user is using ($ENV{REMOTE_ADDR}) and also the last-known IP
372     # address for $host. (Later we should replace this with a broadcast
373     # nmblookup.)
374     #
375     sub ConfirmIPAddress
376     {
377     my($host) = @_;
378     my $ipAddr = $host;
379    
380     if ( defined($Hosts->{$host}) && $Hosts->{$host}{dhcp}
381     && $ENV{REMOTE_ADDR} =~ /^(\d+[\.\d]*)$/ ) {
382     $ipAddr = $1;
383     my($netBiosHost, $netBiosUser) = $bpc->NetBiosInfoGet($ipAddr);
384     if ( $netBiosHost ne $host ) {
385     my($tryIP);
386     GetStatusInfo("host(${EscURI($host)})");
387     if ( defined($StatusHost{dhcpHostIP})
388     && $StatusHost{dhcpHostIP} ne $ipAddr ) {
389     $tryIP = eval("qq{$Lang->{tryIP}}");
390     ($netBiosHost, $netBiosUser)
391     = $bpc->NetBiosInfoGet($StatusHost{dhcpHostIP});
392     }
393     if ( $netBiosHost ne $host ) {
394     ErrorExit(eval("qq{$Lang->{Can_t_find_IP_address_for}}"),
395     eval("qq{$Lang->{host_is_a_DHCP_host}}"));
396     }
397     $ipAddr = $StatusHost{dhcpHostIP};
398     }
399     }
400     return $ipAddr;
401     }
402    
403     ###########################################################################
404     # HTML layout subroutines
405     ###########################################################################
406    
407     sub Header
408     {
409     my($title, $content, $noBrowse, $contentSub, $contentPost) = @_;
410     my @adminLinks = (
411     { link => "", name => $Lang->{Status}},
412     { link => "?action=adminOpts", name => $Lang->{Admin_Options},
413     priv => 1},
414     { link => "?action=summary", name => $Lang->{PC_Summary}},
415     { link => "?action=view&type=LOG", name => $Lang->{LOG_file},
416     priv => 1},
417     { link => "?action=LOGlist", name => $Lang->{Old_LOGs},
418     priv => 1},
419     { link => "?action=emailSummary", name => $Lang->{Email_summary},
420     priv => 1},
421     { link => "?action=view&type=config", name => $Lang->{Config_file},
422     priv => 1},
423     { link => "?action=view&type=hosts", name => $Lang->{Hosts_file},
424     priv => 1},
425     { link => "?action=queue", name => $Lang->{Current_queues},
426     priv => 1},
427 dpavlin 4 { link => "?action=search", name => $Lang->{Search_archive},
428 dpavlin 13 priv => 0},
429 dpavlin 4 { link => "?action=burn", name => $Lang->{Burn_media},
430     priv => 1},
431 dpavlin 1 @{$Conf{CgiNavBarLinks} || []},
432     );
433     my $host = $In{host};
434    
435     print $Cgi->header();
436     print <<EOF;
437     <!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
438     <html><head>
439     <title>$title</title>
440     <link rel=stylesheet type="text/css" href="$Conf{CgiImageDirURL}/$Conf{CgiCSSFile}" title="CSSFile">
441     $Conf{CgiHeaders}
442     </head><body onLoad="document.getElementById('NavMenu').style.height=document.body.scrollHeight">
443     <a href="http://backuppc.sourceforge.net"><img src="$Conf{CgiImageDirURL}/logo.gif" hspace="5" vspace="7" border="0"></a><br>
444     EOF
445    
446     if ( defined($Hosts) && defined($host) && defined($Hosts->{$host}) ) {
447     print "<div class=\"NavMenu\">";
448     NavSectionTitle("${EscHTML($host)}");
449     print <<EOF;
450     </div>
451     <div class="NavMenu">
452     EOF
453     NavLink("?host=${EscURI($host)}",
454     "$host $Lang->{Home}", " class=\"navbar\"");
455     NavLink("?action=browse&host=${EscURI($host)}",
456     $Lang->{Browse}, " class=\"navbar\"") if ( !$noBrowse );
457     NavLink("?action=view&type=LOG&host=${EscURI($host)}",
458     $Lang->{LOG_file}, " class=\"navbar\"");
459     NavLink("?action=LOGlist&host=${EscURI($host)}",
460     $Lang->{LOG_files}, " class=\"navbar\"");
461     if ( -f "$TopDir/pc/$host/SmbLOG.bad"
462     || -f "$TopDir/pc/$host/SmbLOG.bad.z"
463     || -f "$TopDir/pc/$host/XferLOG.bad"
464     || -f "$TopDir/pc/$host/XferLOG.bad.z" ) {
465     NavLink("?action=view&type=XferLOGbad&host=${EscURI($host)}",
466     $Lang->{Last_bad_XferLOG}, " class=\"navbar\"");
467     NavLink("?action=view&type=XferErrbad&host=${EscURI($host)}",
468     $Lang->{Last_bad_XferLOG_errors_only},
469     " class=\"navbar\"");
470     }
471 dpavlin 316 if ( -f "$TopDir/pc/$host/config.pl"
472     || ($host ne "config" && -f "$TopDir/conf/$host.pl") ) {
473 dpavlin 1 NavLink("?action=view&type=config&host=${EscURI($host)}",
474     $Lang->{Config_file}, " class=\"navbar\"");
475     }
476     print "</div>\n";
477     }
478     print("<div id=\"Content\">\n$content\n");
479     if ( defined($contentSub) && ref($contentSub) eq "CODE" ) {
480     while ( (my $s = &$contentSub()) ne "" ) {
481     print($s);
482     }
483     }
484     print($contentPost) if ( defined($contentPost) );
485     print <<EOF;
486     <br><br><br>
487     </div>
488     <div class="NavMenu" id="NavMenu" style="height:100%">
489     EOF
490     my $hostSelectbox = "<option value=\"#\">$Lang->{Select_a_host}</option>";
491     my @hosts = GetUserHosts($Conf{CgiNavBarAdminAllHosts});
492     if ( defined($Hosts) && %$Hosts > 0 && @hosts ) {
493     NavSectionTitle($Lang->{Hosts});
494     foreach my $host ( @hosts ) {
495     NavLink("?host=${EscURI($host)}", $host)
496     if ( @hosts < $Conf{CgiNavBarAdminAllHosts} );
497     my $sel = " selected" if ( $host eq $In{host} );
498     $hostSelectbox .= "<option value=\"?host=${EscURI($host)}\"$sel>"
499     . "$host</option>";
500     }
501     }
502     if ( @hosts >= $Conf{CgiNavBarAdminAllHosts} ) {
503     print <<EOF;
504     <br>
505     <select onChange="document.location=this.value">
506     $hostSelectbox
507     </select>
508     <br><br>
509     EOF
510     }
511     if ( $Conf{CgiSearchBoxEnable} ) {
512     print <<EOF;
513     <form action="$MyURL" method="get">
514     <input type="text" name="host" size="14" maxlength="64">
515     <input type="hidden" name="action" value="hostInfo"><input type="submit" value="$Lang->{Go}" name="ignore">
516     </form>
517     EOF
518     }
519     NavSectionTitle($Lang->{NavSectionTitle_});
520     foreach my $l ( @adminLinks ) {
521     if ( $PrivAdmin || !$l->{priv} ) {
522 dpavlin 316 my $txt = $l->{lname} ne "" ? $Lang->{$l->{lname}} : $l->{name};
523 dpavlin 1 NavLink($l->{link}, $txt);
524     }
525     }
526    
527     print <<EOF;
528     <br><br><br>
529     </div>
530     EOF
531     }
532    
533     sub Trailer
534     {
535     print <<EOF;
536     </body></html>
537     EOF
538     }
539    
540    
541     sub NavSectionTitle
542     {
543     my($head) = @_;
544     print <<EOF;
545     <div class="NavTitle">$head</div>
546     EOF
547     }
548    
549     sub NavSectionStart
550     {
551     }
552    
553     sub NavSectionEnd
554     {
555     }
556    
557     sub NavLink
558     {
559     my($link, $text) = @_;
560     if ( defined($link) ) {
561     my($class);
562     $class = " class=\"NavCurrent\""
563     if ( length($link) && $ENV{REQUEST_URI} =~ /\Q$link\E$/
564     || $link eq "" && $ENV{REQUEST_URI} !~ /\?/ );
565     $link = "$MyURL$link" if ( $link eq "" || $link =~ /^\?/ );
566     print <<EOF;
567     <a href="$link"$class>$text</a>
568     EOF
569     } else {
570     print <<EOF;
571     $text<br>
572     EOF
573     }
574     }
575    
576     sub h1
577     {
578     my($str) = @_;
579     return \<<EOF;
580     <div class="h1">$str</div>
581     EOF
582     }
583    
584     sub h2
585     {
586     my($str) = @_;
587     return \<<EOF;
588     <div class="h2">$str</div>
589     EOF
590     }

  ViewVC Help
Powered by ViewVC 1.1.26