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