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