078f3fd18ca098ca003372ccd6f237556737b8a9
[BackupPC.git] / lib / BackupPC / CGI / Lib.pm
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_CVS, released 3 Jul 2003.
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);
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
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     #
97     # Default REMOTE_USER so in a miminal installation the user
98     # has a sensible default.
99     #
100     $ENV{REMOTE_USER} = $Conf{BackupPCUser} if ( !defined($ENV{REMOTE_USER}) );
101
102     #
103     # We require that Apache pass in $ENV{SCRIPT_NAME} and $ENV{REMOTE_USER}.
104     # The latter requires .ht_access style authentication.  Replace this
105     # code if you are using some other type of authentication, and have
106     # a different way of getting the user name.
107     #
108     $MyURL  = $ENV{SCRIPT_NAME};
109     $User   = $ENV{REMOTE_USER};
110
111     if ( !defined($bpc) ) {
112         ErrorExit($Lang->{BackupPC__Lib__new_failed__check_apache_error_log})
113             if ( !($bpc = BackupPC::Lib->new(undef, undef, 1)) );
114         $TopDir = $bpc->TopDir();
115         $BinDir = $bpc->BinDir();
116         %Conf   = $bpc->Conf();
117         $Lang   = $bpc->Lang();
118         $ConfigMTime = $bpc->ConfigMTime();
119     } elsif ( $bpc->ConfigMTime() != $ConfigMTime ) {
120         $bpc->ConfigRead();
121         %Conf   = $bpc->Conf();
122         $ConfigMTime = $bpc->ConfigMTime();
123         $Lang   = $bpc->Lang();
124     }
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 }
160
161 sub timeStamp2
162 {
163     my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
164               = localtime($_[0] == 0 ? time : $_[0] );
165     $mon++;
166     if ( $Conf{CgiDateFormatMMDD} ) {
167         return sprintf("$mon/$mday %02d:%02d", $hour, $min);
168     } else {
169         return sprintf("$mday/$mon %02d:%02d", $hour, $min);
170     }
171 }
172
173 sub HostLink
174 {
175     my($host) = @_;
176     my($s);
177     if ( defined($Hosts->{$host}) || defined($Status{$host}) ) {
178         $s = "<a href=\"$MyURL?host=${EscURI($host)}\">$host</a>";
179     } else {
180         $s = $host;
181     }
182     return \$s;
183 }
184
185 sub UserLink
186 {
187     my($user) = @_;
188     my($s);
189
190     return \$user if ( $user eq ""
191                     || $Conf{CgiUserUrlCreate} eq "" );
192     if ( $Conf{CgiUserHomePageCheck} eq ""
193             || -f sprintf($Conf{CgiUserHomePageCheck}, $user, $user, $user) ) {
194         $s = "<a href=\""
195              . sprintf($Conf{CgiUserUrlCreate}, $user, $user, $user)
196              . "\">$user</a>";
197     } else {
198         $s = $user;
199     }
200     return \$s;
201 }
202
203 sub EscHTML
204 {
205     my($s) = @_;
206     $s =~ s/&/&amp;/g;
207     $s =~ s/\"/&quot;/g;
208     $s =~ s/>/&gt;/g;
209     $s =~ s/</&lt;/g;
210     $s =~ s{([^[:print:]])}{sprintf("&\#x%02X;", ord($1));}eg;
211     return \$s;
212 }
213
214 sub EscURI
215 {
216     my($s) = @_;
217     $s =~ s{([^\w.\/-])}{sprintf("%%%02X", ord($1));}eg;
218     return \$s;
219 }
220
221 sub ErrorExit
222 {
223     my(@mesg) = @_;
224     my($head) = shift(@mesg);
225     my($mesg) = join("</p>\n<p>", @mesg);
226     $Conf{CgiHeaderFontType} ||= "arial"; 
227     $Conf{CgiHeaderFontSize} ||= "3";  
228     $Conf{CgiNavBarBgColor}  ||= "#ddeeee";
229     $Conf{CgiHeaderBgColor}  ||= "#99cc33";
230
231     if ( !defined($ENV{REMOTE_USER}) ) {
232         $mesg .= <<EOF;
233 <p>
234 Note: \$ENV{REMOTE_USER} is not set, which could mean there is an
235 installation problem.  BackupPC_Admin expects Apache to authenticate
236 the user and pass their user name into this script as the REMOTE_USER
237 environment variable.  See the documentation.
238 EOF
239     }
240
241     $bpc->ServerMesg("log User $User (host=$In{host}) got CGI error: $head")
242                             if ( defined($bpc) );
243     if ( !defined($Lang->{Error}) ) {
244         Header("BackupPC: Error");
245         $mesg = <<EOF if ( !defined($mesg) );
246 There is some problem with the BackupPC installation.
247 Please check the permissions on BackupPC_Admin.
248 EOF
249         print <<EOF;
250 ${h1("Error: Unable to read config.pl or language strings!!")}
251 <p>$mesg</p>
252 EOF
253         Trailer();
254     } else {
255         Header(eval("qq{$Lang->{Error}}"));
256         print (eval("qq{$Lang->{Error____head}}"));
257         Trailer();
258     }
259     exit(1);
260 }
261
262 sub ServerConnect
263 {
264     #
265     # Verify that the server connection is ok
266     #
267     return if ( $bpc->ServerOK() );
268     $bpc->ServerDisconnect();
269     if ( my $err = $bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort}) ) {
270         ErrorExit(eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}"));
271     }
272 }
273
274 sub GetStatusInfo
275 {
276     my($status) = @_;
277     ServerConnect();
278     my $reply = $bpc->ServerMesg("status $status");
279     $reply = $1 if ( $reply =~ /(.*)/s );
280     eval($reply);
281     # ignore status related to admin and trashClean jobs
282     if ( $status =~ /\bhosts\b/ ) {
283         delete($Status{$bpc->adminJob});
284         delete($Status{$bpc->trashJob});
285     }
286 }
287
288 sub ReadUserEmailInfo
289 {
290     if ( (stat("$TopDir/log/UserEmailInfo.pl"))[9] != $UserEmailInfoMTime ) {
291         do "$TopDir/log/UserEmailInfo.pl";
292         $UserEmailInfoMTime = (stat("$TopDir/log/UserEmailInfo.pl"))[9];
293     }
294 }
295
296 #
297 # Check if the user is privileged.  A privileged user can access
298 # any information (backup files, logs, status pages etc).
299 #
300 # A user is privileged if they belong to the group
301 # $Conf{CgiAdminUserGroup}, or they are in $Conf{CgiAdminUsers}
302 # or they are the user assigned to a host in the host file.
303 #
304 sub CheckPermission
305 {
306     my($host) = @_;
307     my $Privileged = 0;
308
309     return 0 if ( $User eq "" && $Conf{CgiAdminUsers} ne "*"
310                || $host ne "" && !defined($Hosts->{$host}) );
311     if ( $Conf{CgiAdminUserGroup} ne "" ) {
312         my($n,$p,$gid,$mem) = getgrnam($Conf{CgiAdminUserGroup});
313         $Privileged ||= ($mem =~ /\b$User\b/);
314     }
315     if ( $Conf{CgiAdminUsers} ne "" ) {
316         $Privileged ||= ($Conf{CgiAdminUsers} =~ /\b$User\b/);
317         $Privileged ||= $Conf{CgiAdminUsers} eq "*";
318     }
319     $PrivAdmin = $Privileged;
320     $Privileged ||= $User eq $Hosts->{$host}{user};
321     $Privileged ||= defined($Hosts->{$host}{moreUsers}{$User});
322
323     return $Privileged;
324 }
325
326 #
327 # Returns the list of hosts that should appear in the navigation bar
328 # for this user.  If $Conf{CgiNavBarAdminAllHosts} is set, the admin
329 # gets all the hosts.  Otherwise, regular users get hosts for which
330 # they are the user or are listed in the moreUsers column in the
331 # hosts file.
332 #
333 sub GetUserHosts
334 {
335     if ( $Conf{CgiNavBarAdminAllHosts} && CheckPermission() ) {
336        return sort keys %$Hosts;
337     }
338
339     return sort grep { $Hosts->{$_}{user} eq $User ||
340                        defined($Hosts->{$_}{moreUsers}{$User}) } keys(%$Hosts);
341 }
342
343 #
344 # Given a host name tries to find the IP address.  For non-dhcp hosts
345 # we just return the host name.  For dhcp hosts we check the address
346 # the user is using ($ENV{REMOTE_ADDR}) and also the last-known IP
347 # address for $host.  (Later we should replace this with a broadcast
348 # nmblookup.)
349 #
350 sub ConfirmIPAddress
351 {
352     my($host) = @_;
353     my $ipAddr = $host;
354
355     if ( defined($Hosts->{$host}) && $Hosts->{$host}{dhcp}
356                && $ENV{REMOTE_ADDR} =~ /^(\d+[\.\d]*)$/ ) {
357         $ipAddr = $1;
358         my($netBiosHost, $netBiosUser) = $bpc->NetBiosInfoGet($ipAddr);
359         if ( $netBiosHost ne $host ) {
360             my($tryIP);
361             GetStatusInfo("host(${EscURI($host)})");
362             if ( defined($StatusHost{dhcpHostIP})
363                         && $StatusHost{dhcpHostIP} ne $ipAddr ) {
364                 $tryIP = eval("qq{$Lang->{tryIP}}");
365                 ($netBiosHost, $netBiosUser)
366                         = $bpc->NetBiosInfoGet($StatusHost{dhcpHostIP});
367             }
368             if ( $netBiosHost ne $host ) {
369                 ErrorExit(eval("qq{$Lang->{Can_t_find_IP_address_for}}"),
370                           eval("qq{$Lang->{host_is_a_DHCP_host}}"));
371             }
372             $ipAddr = $StatusHost{dhcpHostIP};
373         }
374     }
375     return $ipAddr;
376 }
377
378 ###########################################################################
379 # HTML layout subroutines
380 ###########################################################################
381
382 sub Header
383 {
384     my($title) = @_;
385     my @adminLinks = (
386         { link => "",                          name => $Lang->{Status},
387                                                priv => 1},
388         { link => "?action=summary",           name => $Lang->{PC_Summary} },
389         { link => "?action=view&type=LOG",     name => $Lang->{LOG_file} },
390         { link => "?action=LOGlist",           name => $Lang->{Old_LOGs} },
391         { link => "?action=emailSummary",      name => $Lang->{Email_summary} },
392         { link => "?action=view&type=config",  name => $Lang->{Config_file} },
393         { link => "?action=view&type=hosts",   name => $Lang->{Hosts_file} },
394         { link => "?action=queue",             name => $Lang->{Current_queues} },
395         { link => "?action=view&type=docs",    name => $Lang->{Documentation},
396                                                priv => 1},
397         { link => "http://backuppc.sourceforge.net/faq", name => "FAQ",
398                                                priv => 1},
399         { link => "http://backuppc.sourceforge.net", name => "SourceForge",
400                                                priv => 1},
401     );
402     print $Cgi->header();
403     print <<EOF;
404 <!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
405 <html><head>
406 <title>$title</title>
407 $Conf{CgiHeaders}
408 </head><body bgcolor="$Conf{CgiBodyBgColor}">
409 <table cellpadding="0" cellspacing="0" border="0">
410 <tr valign="top"><td valign="top" bgcolor="$Conf{CgiNavBarBgColor}" width="10%">
411 EOF
412     NavSectionTitle("BackupPC");
413     print "&nbsp;\n";
414     if ( defined($In{host}) && defined($Hosts->{$In{host}}) ) {
415         my $host = $In{host};
416         NavSectionTitle( eval("qq{$Lang->{Host_Inhost}}") );
417         NavSectionStart();
418         NavLink("?host=${EscURI($host)}", $Lang->{Home});
419         NavLink("?action=view&type=LOG&host=${EscURI($host)}", $Lang->{LOG_file});
420         NavLink("?action=LOGlist&host=${EscURI($host)}", $Lang->{Old_LOGs});
421         if ( -f "$TopDir/pc/$host/SmbLOG.bad"
422                     || -f "$TopDir/pc/$host/SmbLOG.bad.z"
423                     || -f "$TopDir/pc/$host/XferLOG.bad"
424                     || -f "$TopDir/pc/$host/XferLOG.bad.z" ) {
425             NavLink("?action=view&type=XferLOGbad&host=${EscURI($host)}",
426                                 $Lang->{Last_bad_XferLOG});
427             NavLink("?action=view&type=XferErrbad&host=${EscURI($host)}",
428                                 $Lang->{Last_bad_XferLOG_errors_only});
429         }
430         if ( -f "$TopDir/pc/$host/config.pl" ) {
431             NavLink("?action=view&type=config&host=${EscURI($host)}", $Lang->{Config_file});
432         }
433         NavSectionEnd();
434     }
435     NavSectionTitle($Lang->{NavSectionTitle_});
436     NavSectionStart();
437     foreach my $l ( @adminLinks ) {
438         if ( $PrivAdmin || $l->{priv} ) {
439             NavLink($l->{link}, $l->{name});
440         } else {
441             NavLink(undef, $l->{name});
442         }
443     }
444     NavSectionEnd();
445     NavSectionTitle($Lang->{Hosts});
446     print <<EOF;
447 <table cellpadding="2" cellspacing="0" border="0" width="100%">
448     <tr><td>$Lang->{Host_or_User_name}</td>
449     <tr><td><form action="$MyURL" method="get"><small>
450     <input type="text" name="host" size="10" maxlength="64">
451     <input type="hidden" name="action" value="hostInfo"><input type="submit" value="$Lang->{Go}" name="ignore">
452     </small></form></td></tr>
453 </table>
454 EOF
455     if ( defined($Hosts) && %$Hosts > 0 ) {
456         NavSectionStart(1);
457         foreach my $host ( GetUserHosts() ) {
458             NavLink("?host=${EscURI($host)}", $host);
459         }
460         NavSectionEnd();
461     }
462     print <<EOF;
463 </td><td valign="top" width="5">&nbsp;&nbsp;</td>
464 <td valign="top" width="90%">
465 EOF
466 }
467
468 sub Trailer
469 {
470     print <<EOF;
471 </td></table>
472 </body></html>
473 EOF
474 }
475
476
477 sub NavSectionTitle
478 {
479     my($head) = @_;
480     print <<EOF;
481 <table cellpadding="2" cellspacing="0" border="0" width="100%">
482 <tr><td bgcolor="$Conf{CgiHeaderBgColor}"><font face="$Conf{CgiHeaderFontType}"
483 size="$Conf{CgiHeaderFontSize}"><b>$head</b>
484 </font></td></tr>
485 </table>
486 EOF
487 }
488
489 sub NavSectionStart
490 {
491     my($padding) = @_;
492
493     $padding = 1 if ( !defined($padding) );
494     print <<EOF;
495 <table cellpadding="$padding" cellspacing="0" border="0" width="100%">
496 EOF
497 }
498
499 sub NavSectionEnd
500 {
501     print "</table>\n";
502 }
503
504 sub NavLink
505 {
506     my($link, $text) = @_;
507     print "<tr><td width=\"2%\" valign=\"top\"><b>&middot;</b></td>";
508     if ( defined($link) ) {
509         $link = "$MyURL$link" if ( $link eq "" || $link =~ /^\?/ );
510         print <<EOF;
511 <td width="98%"><a href="$link"><small>$text</small></a></td></tr>
512 EOF
513     } else {
514         print <<EOF;
515 <td width="98%"><small>$text</small></td></tr>
516 EOF
517     }
518 }
519
520 sub h1
521 {
522     my($str) = @_;
523     return \<<EOF;
524 <table cellpadding="2" cellspacing="0" border="0" width="100%">
525 <tr>
526 <td bgcolor="$Conf{CgiHeaderBgColor}">&nbsp;<font face="$Conf{CgiHeaderFontType}"
527     size="$Conf{CgiHeaderFontSize}"><b>$str</b></font>
528 </td></tr>
529 </table>
530 EOF
531 }
532
533 sub h2
534 {
535     my($str) = @_;
536     return \<<EOF;
537 <table cellpadding="2" cellspacing="0" border="0" width="100%">
538 <tr>
539 <td bgcolor="$Conf{CgiHeaderBgColor}">&nbsp;<font face="$Conf{CgiHeaderFontType}"
540     size="$Conf{CgiHeaderFontSize}"><b>$str</b></font>
541 </td></tr>
542 </table>
543 EOF
544 }