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