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