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