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