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