Release for 3.2.0. Changes since 3.2.0beta1:
[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-2009  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.0, released 31 Jul 2010.
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                       eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server_error_message}}"));
299         }
300     }
301 }
302
303 sub GetStatusInfo
304 {
305     my($status) = @_;
306     ServerConnect();
307     %Status = ()     if ( $status =~ /\bhosts\b/ );
308     %StatusHost = () if ( $status =~ /\bhost\(/ );
309     my $reply = $bpc->ServerMesg("status $status");
310     $reply = $1 if ( $reply =~ /(.*)/s );
311     eval($reply);
312     # ignore status related to admin and trashClean jobs
313     if ( $status =~ /\bhosts\b/ ) {
314         foreach my $host ( grep(/admin/, keys(%Status)) ) {
315             delete($Status{$host}) if ( $bpc->isAdminJob($host) );
316         }
317         delete($Status{$bpc->trashJob});
318     }
319 }
320
321 sub ReadUserEmailInfo
322 {
323     if ( (stat("$LogDir/UserEmailInfo.pl"))[9] != $UserEmailInfoMTime ) {
324         do "$LogDir/UserEmailInfo.pl";
325         $UserEmailInfoMTime = (stat("$LogDir/UserEmailInfo.pl"))[9];
326     }
327 }
328
329 #
330 # Check if the user is privileged.  A privileged user can access
331 # any information (backup files, logs, status pages etc).
332 #
333 # A user is privileged if they belong to the group
334 # $Conf{CgiAdminUserGroup}, or they are in $Conf{CgiAdminUsers}
335 # or they are the user assigned to a host in the host file.
336 #
337 sub CheckPermission
338 {
339     my($host) = @_;
340     my $Privileged = 0;
341
342     return 0 if ( $User eq "" && $Conf{CgiAdminUsers} ne "*"
343                || $host ne "" && !defined($Hosts->{$host}) );
344     if ( $Conf{CgiAdminUserGroup} ne "" ) {
345         my($n,$p,$gid,$mem) = getgrnam($Conf{CgiAdminUserGroup});
346         $Privileged ||= ($mem =~ /\b\Q$User\E\b/);
347     }
348     if ( $Conf{CgiAdminUsers} ne "" ) {
349         $Privileged ||= ($Conf{CgiAdminUsers} =~ /\b\Q$User\E\b/);
350         $Privileged ||= $Conf{CgiAdminUsers} eq "*";
351     }
352     $PrivAdmin = $Privileged;
353     return $Privileged if ( !defined($host) );
354
355     $Privileged ||= $User eq $Hosts->{$host}{user};
356     $Privileged ||= defined($Hosts->{$host}{moreUsers}{$User});
357     return $Privileged;
358 }
359
360 #
361 # Returns the list of hosts that should appear in the navigation bar
362 # for this user.  If $getAll is set, the admin gets all the hosts.
363 # Otherwise, regular users get hosts for which they are the user or
364 # are listed in the moreUsers column in the hosts file.
365 #
366 sub GetUserHosts
367 {
368     my($getAll) = @_;
369     my @hosts;
370
371     if ( $getAll && CheckPermission() ) {
372         @hosts = sort keys %$Hosts;
373     } else {
374         @hosts = sort grep { $Hosts->{$_}{user} eq $User ||
375                        defined($Hosts->{$_}{moreUsers}{$User}) } keys(%$Hosts);
376     }
377     return @hosts;
378 }
379
380 #
381 # Given a host name tries to find the IP address.  For non-dhcp hosts
382 # we just return the host name.  For dhcp hosts we check the address
383 # the user is using ($ENV{REMOTE_ADDR}) and also the last-known IP
384 # address for $host.  (Later we should replace this with a broadcast
385 # nmblookup.)
386 #
387 sub ConfirmIPAddress
388 {
389     my($host) = @_;
390     my $ipAddr = $host;
391
392     if ( defined($Hosts->{$host}) && $Hosts->{$host}{dhcp}
393                && $ENV{REMOTE_ADDR} =~ /^(\d+[\.\d]*)$/ ) {
394         $ipAddr = $1;
395         my($netBiosHost, $netBiosUser) = $bpc->NetBiosInfoGet($ipAddr);
396         if ( $netBiosHost ne $host ) {
397             my($tryIP);
398             GetStatusInfo("host(${EscURI($host)})");
399             if ( defined($StatusHost{dhcpHostIP})
400                         && $StatusHost{dhcpHostIP} ne $ipAddr ) {
401                 $tryIP = eval("qq{$Lang->{tryIP}}");
402                 ($netBiosHost, $netBiosUser)
403                         = $bpc->NetBiosInfoGet($StatusHost{dhcpHostIP});
404             }
405             if ( $netBiosHost ne $host ) {
406                 ErrorExit(eval("qq{$Lang->{Can_t_find_IP_address_for}}"),
407                           eval("qq{$Lang->{host_is_a_DHCP_host}}"));
408             }
409             $ipAddr = $StatusHost{dhcpHostIP};
410         }
411     }
412     return $ipAddr;
413 }
414
415 ###########################################################################
416 # HTML layout subroutines
417 ###########################################################################
418
419 sub Header
420 {
421     my($title, $content, $noBrowse, $contentSub, $contentPost) = @_;
422     my @adminLinks = (
423         { link => "",                      name => $Lang->{Status}},
424         { link => "?action=summary",       name => $Lang->{PC_Summary}},
425         { link => "?action=editConfig",    name => $Lang->{CfgEdit_Edit_Config},
426                                            priv => 1},
427         { link => "?action=editConfig&newMenu=hosts",
428                                            name => $Lang->{CfgEdit_Edit_Hosts},
429                                            priv => 1},
430         { link => "?action=adminOpts",     name => $Lang->{Admin_Options},
431                                            priv => 1},
432         { link => "?action=view&type=LOG", name => $Lang->{LOG_file},
433                                            priv => 1},
434         { link => "?action=LOGlist",       name => $Lang->{Old_LOGs},
435                                            priv => 1},
436         { link => "?action=emailSummary",  name => $Lang->{Email_summary},
437                                            priv => 1},
438         { link => "?action=queue",         name => $Lang->{Current_queues},
439                                            priv => 1},
440         @{$Conf{CgiNavBarLinks} || []},
441     );
442     my $host = $In{host};
443
444     binmode(STDOUT, ":utf8");
445     print $Cgi->header(-charset => "utf-8");
446     print <<EOF;
447 <!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
448 <html><head>
449 <title>$title</title>
450 <link rel=stylesheet type="text/css" href="$Conf{CgiImageDirURL}/$Conf{CgiCSSFile}" title="CSSFile">
451 <link rel=icon href="$Conf{CgiImageDirURL}/favicon.ico" type="image/x-icon">
452 $Conf{CgiHeaders}
453 <script src="$Conf{CgiImageDirURL}/sorttable.js"></script>
454 </head><body onLoad="document.getElementById('NavMenu').style.height=document.body.scrollHeight">
455 <a href="http://backuppc.sourceforge.net"><img src="$Conf{CgiImageDirURL}/logo.gif" hspace="5" vspace="7" border="0"></a><br>
456 EOF
457
458     if ( defined($Hosts) && defined($host) && defined($Hosts->{$host}) ) {
459         print "<div class=\"NavMenu\">";
460         NavSectionTitle("${EscHTML($host)}");
461         print <<EOF;
462 </div>
463 <div class="NavMenu">
464 EOF
465         NavLink("?host=${EscURI($host)}",
466                 "$host $Lang->{Home}", " class=\"navbar\"");
467         NavLink("?action=browse&host=${EscURI($host)}",
468                 $Lang->{Browse}, " class=\"navbar\"") if ( !$noBrowse );
469         NavLink("?action=view&type=LOG&host=${EscURI($host)}",
470                 $Lang->{LOG_file}, " class=\"navbar\"");
471         NavLink("?action=LOGlist&host=${EscURI($host)}",
472                 $Lang->{LOG_files}, " class=\"navbar\"");
473         if ( -f "$TopDir/pc/$host/SmbLOG.bad"
474                     || -f "$TopDir/pc/$host/SmbLOG.bad.z"
475                     || -f "$TopDir/pc/$host/XferLOG.bad"
476                     || -f "$TopDir/pc/$host/XferLOG.bad.z" ) {
477            NavLink("?action=view&type=XferLOGbad&host=${EscURI($host)}",
478                     $Lang->{Last_bad_XferLOG}, " class=\"navbar\"");
479            NavLink("?action=view&type=XferErrbad&host=${EscURI($host)}",
480                     $Lang->{Last_bad_XferLOG_errors_only},
481                     " class=\"navbar\"");
482         }
483         if ( $Conf{CgiUserConfigEditEnable} || $PrivAdmin ) {
484             NavLink("?action=editConfig&host=${EscURI($host)}",
485                     $Lang->{CfgEdit_Edit_Config}, " class=\"navbar\"");
486         } elsif ( -f "$TopDir/pc/$host/config.pl"
487                     || ($host ne "config" && -f "$TopDir/conf/$host.pl") ) {
488             NavLink("?action=view&type=config&host=${EscURI($host)}",
489                     $Lang->{Config_file}, " class=\"navbar\"");
490         }
491         print "</div>\n";
492     }
493     print("<div id=\"Content\">\n$content\n");
494     if ( defined($contentSub) && ref($contentSub) eq "CODE" ) {
495         while ( (my $s = &$contentSub()) ne "" ) {
496             print($s);
497         }
498     }
499     print($contentPost) if ( defined($contentPost) );
500     print <<EOF;
501 <br><br><br>
502 </div>
503 <div class="NavMenu" id="NavMenu" style="height:100%">
504 EOF
505     my $hostSelectbox = "<option value=\"#\">$Lang->{Select_a_host}</option>";
506     my @hosts = GetUserHosts($Conf{CgiNavBarAdminAllHosts});
507     NavSectionTitle($Lang->{Hosts});
508     if ( defined($Hosts) && %$Hosts > 0 && @hosts ) {
509         foreach my $host ( @hosts ) {
510             NavLink("?host=${EscURI($host)}", $host)
511                     if ( @hosts < $Conf{CgiNavBarAdminAllHosts} );
512             my $sel = " selected" if ( $host eq $In{host} );
513             $hostSelectbox .= "<option value=\"?host=${EscURI($host)}\"$sel>"
514                             . "$host</option>";
515         }
516     }
517     if ( @hosts >= $Conf{CgiNavBarAdminAllHosts} ) {
518         print <<EOF;
519 <br>
520 <select onChange="document.location=this.value">
521 $hostSelectbox
522 </select>
523 <br><br>
524 EOF
525     }
526     if ( $Conf{CgiSearchBoxEnable} ) {
527         print <<EOF;
528 <form action="$MyURL" method="get">
529     <input type="text" name="host" size="14" maxlength="64">
530     <input type="hidden" name="action" value="hostInfo"><input type="submit" value="$Lang->{Go}" name="ignore">
531     </form>
532 EOF
533     }
534     NavSectionTitle($Lang->{NavSectionTitle_});
535     foreach my $l ( @adminLinks ) {
536         if ( $PrivAdmin || !$l->{priv} ) {
537             my $txt = $l->{lname} ne "" ? $Lang->{$l->{lname}} : $l->{name};
538             NavLink($l->{link}, $txt);
539         }
540     }
541
542     print <<EOF;
543 <br><br><br>
544 </div>
545 EOF
546 }
547
548 sub Trailer
549 {
550     print <<EOF;
551 </body></html>
552 EOF
553 }
554
555
556 sub NavSectionTitle
557 {
558     my($head) = @_;
559     print <<EOF;
560 <div class="NavTitle">$head</div>
561 EOF
562 }
563
564 sub NavSectionStart
565 {
566 }
567
568 sub NavSectionEnd
569 {
570 }
571
572 sub NavLink
573 {
574     my($link, $text) = @_;
575     if ( defined($link) ) {
576         my($class);
577         $class = " class=\"NavCurrent\""
578                 if ( length($link) && $ENV{REQUEST_URI} =~ /\Q$link\E$/
579                     || $link eq "" && $ENV{REQUEST_URI} !~ /\?/ );
580         $link = "$MyURL$link" if ( $link eq "" || $link =~ /^\?/ );
581         print <<EOF;
582 <a href="$link"$class>$text</a>
583 EOF
584     } else {
585         print <<EOF;
586 $text<br>
587 EOF
588     }
589 }
590
591 sub h1
592 {
593     my($str) = @_;
594     return \<<EOF;
595 <div class="h1">$str</div>
596 EOF
597 }
598
599 sub h2
600 {
601     my($str) = @_;
602     return \<<EOF;
603 <div class="h2">$str</div>
604 EOF
605 }