is a high-performance, enterprise-grade system for backing up Linux and WinXX PCs and laptops to a server’s disk (http/cgi user interface).
| Lib.pm (BackupPC-4.3.2) | : | Lib.pm (BackupPC-4.4.0) |
|---|
| | |
| skipping to change at line 31 | | skipping to change at line 31 |
|---|
| # This program is distributed in the hope that it will be useful, | | # This program is distributed in the hope that it will be useful, |
| # but WITHOUT ANY WARRANTY; without even the implied warranty of | | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
| # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| # GNU General Public License for more details. | | # GNU General Public License for more details. |
| # | | # |
| # You should have received a copy of the GNU General Public License | | # You should have received a copy of the GNU General Public License |
| # along with this program. If not, see <http://www.gnu.org/licenses/>. | | # along with this program. If not, see <http://www.gnu.org/licenses/>. |
| # | | # |
| #======================================================================== | | #======================================================================== |
| # | | # |
|
| # Version 4.3.2, released 17 Feb 2020. | | # Version 4.4.0, released 20 Jun 2020. |
| # | | # |
| # See http://backuppc.sourceforge.net. | | # See http://backuppc.sourceforge.net. |
| # | | # |
| #======================================================================== | | #======================================================================== |
| | |
| package BackupPC::CGI::Lib; | | package BackupPC::CGI::Lib; |
| | |
| use strict; | | use strict; |
| use BackupPC::Lib; | | use BackupPC::Lib; |
| | |
| require Exporter; | | require Exporter; |
| | |
| use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS ); | | use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS ); |
| | |
| use vars qw($Cgi %In $MyURL $User %Conf $TopDir $LogDir $BinDir $bpc); | | use vars qw($Cgi %In $MyURL $User %Conf $TopDir $LogDir $BinDir $bpc); |
| use vars qw(%Status %Info %Jobs @BgQueue @UserQueue @CmdQueue | | use vars qw(%Status %Info %Jobs @BgQueue @UserQueue @CmdQueue |
|
| %QueueLen %StatusHost); | | %QueueLen %StatusHost); |
| use vars qw($Hosts $HostsMTime $ConfigMTime $PrivAdmin); | | use vars qw($Hosts $HostsMTime $ConfigMTime $PrivAdmin); |
| use vars qw(%UserEmailInfo $UserEmailInfoMTime %RestoreReq %ArchiveReq); | | use vars qw(%UserEmailInfo $UserEmailInfoMTime %RestoreReq %ArchiveReq); |
| use vars qw($Lang); | | use vars qw($Lang); |
| | |
| @ISA = qw(Exporter); | | @ISA = qw(Exporter); |
| | |
|
| @EXPORT = qw( ); | | @EXPORT = qw( ); |
| | |
| @EXPORT_OK = qw( | | @EXPORT_OK = qw( |
|
| timeStamp2 | | timeStamp2 |
| HostLink | | HostLink |
| UserLink | | UserLink |
| EscHTML | | EscHTML |
| EscURI | | EscURI |
| ErrorExit | | ErrorExit |
| ServerConnect | | ServerConnect |
| GetStatusInfo | | GetStatusInfo |
| ReadUserEmailInfo | | ReadUserEmailInfo |
| CheckPermission | | CheckPermission |
| GetUserHosts | | GetUserHosts |
| ConfirmIPAddress | | ConfirmIPAddress |
| Header | | Header |
| Trailer | | Trailer |
| NavSectionTitle | | NavSectionTitle |
| NavSectionStart | | NavSectionStart |
| NavSectionEnd | | NavSectionEnd |
| NavLink | | NavLink |
| h1 | | h1 |
| h2 | | h2 |
| $Cgi %In $MyURL $User %Conf $TopDir $LogDir $BinDir $bpc | | $Cgi %In $MyURL $User %Conf $TopDir $LogDir $BinDir $bpc |
| %Status %Info %Jobs @BgQueue @UserQueue @CmdQueue | | %Status %Info %Jobs @BgQueue @UserQueue @CmdQueue |
| %QueueLen %StatusHost | | %QueueLen %StatusHost |
| $Hosts $HostsMTime $ConfigMTime $PrivAdmin | | $Hosts $HostsMTime $ConfigMTime $PrivAdmin |
| %UserEmailInfo $UserEmailInfoMTime %RestoreReq %ArchiveReq | | %UserEmailInfo $UserEmailInfoMTime %RestoreReq %ArchiveReq |
| $Lang | | $Lang |
| ); | | |
| | |
| %EXPORT_TAGS = ( | | |
| 'all' => [ @EXPORT_OK ], | | |
| ); | | ); |
| | |
|
| | %EXPORT_TAGS = ('all' => [@EXPORT_OK]); |
| | |
| sub NewRequest | | sub NewRequest |
| { | | { |
| $Cgi = new CGI; | | $Cgi = new CGI; |
|
| %In = $Cgi->Vars; | | %In = $Cgi->Vars; |
| | |
| if ( !defined($bpc) ) { | | if ( !defined($bpc) ) { |
|
| ErrorExit($Lang->{BackupPC__Lib__new_failed__check_apache_error_log}) | | ErrorExit($Lang->{BackupPC__Lib__new_failed__check_apache_error_log}) |
| if ( !($bpc = BackupPC::Lib->new(undef, undef, undef, 1)) ); | | if ( !($bpc = BackupPC::Lib->new(undef, undef, undef, 1)) ); |
| $TopDir = $bpc->TopDir(); | | $TopDir = $bpc->TopDir(); |
| $LogDir = $bpc->LogDir(); | | $LogDir = $bpc->LogDir(); |
| $BinDir = $bpc->BinDir(); | | $BinDir = $bpc->BinDir(); |
| %Conf = $bpc->Conf(); | | %Conf = $bpc->Conf(); |
| $Lang = $bpc->Lang(); | | $Lang = $bpc->Lang(); |
| $ConfigMTime = $bpc->ConfigMTime(); | | $ConfigMTime = $bpc->ConfigMTime(); |
| umask($Conf{UmaskMode}); | | umask($Conf{UmaskMode}); |
| } elsif ( $bpc->ConfigMTime() != $ConfigMTime ) { | | } elsif ( $bpc->ConfigMTime() != $ConfigMTime ) { |
| $bpc->ConfigRead(); | | $bpc->ConfigRead(); |
|
| $TopDir = $bpc->TopDir(); | | $TopDir = $bpc->TopDir(); |
| $LogDir = $bpc->LogDir(); | | $LogDir = $bpc->LogDir(); |
| $BinDir = $bpc->BinDir(); | | $BinDir = $bpc->BinDir(); |
| %Conf = $bpc->Conf(); | | %Conf = $bpc->Conf(); |
| $Lang = $bpc->Lang(); | | $Lang = $bpc->Lang(); |
| $ConfigMTime = $bpc->ConfigMTime(); | | $ConfigMTime = $bpc->ConfigMTime(); |
| umask($Conf{UmaskMode}); | | umask($Conf{UmaskMode}); |
| } | | } |
| | |
| # | | # |
| # Default REMOTE_USER so in a miminal installation the user | | # Default REMOTE_USER so in a miminal installation the user |
| # has a sensible default. | | # has a sensible default. |
| # | | # |
| $ENV{REMOTE_USER} = $Conf{BackupPCUser} if ( $ENV{REMOTE_USER} eq "" ); | | $ENV{REMOTE_USER} = $Conf{BackupPCUser} if ( $ENV{REMOTE_USER} eq "" ); |
| | |
| # | | # |
| # We require that Apache pass in $ENV{SCRIPT_NAME} and $ENV{REMOTE_USER}. | | # We require that Apache pass in $ENV{SCRIPT_NAME} and $ENV{REMOTE_USER}. |
| # The latter requires .ht_access style authentication. Replace this | | # The latter requires .ht_access style authentication. Replace this |
| # code if you are using some other type of authentication, and have | | # code if you are using some other type of authentication, and have |
| # a different way of getting the user name. | | # a different way of getting the user name. |
| # | | # |
|
| $MyURL = $ENV{SCRIPT_NAME}; | | $MyURL = $ENV{SCRIPT_NAME}; |
| $User = $ENV{REMOTE_USER}; | | $User = $ENV{REMOTE_USER}; |
| | |
| # | | # |
| # Handle LDAP uid=user when using mod_authz_ldap and otherwise untaint | | # Handle LDAP uid=user when using mod_authz_ldap and otherwise untaint |
| # | | # |
|
| $User = $1 if ( $User =~ /uid=([^,]+)/i || $User =~ /(.*)/ ); | | $User = $1 if ( $User =~ /uid=([^,]+)/i || $User =~ /(.*)/ ); |
| | |
| # | | # |
| # Clean up %ENV for taint checking | | # Clean up %ENV for taint checking |
| # | | # |
| delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; | | delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; |
| $ENV{PATH} = $Conf{MyPath}; | | $ENV{PATH} = $Conf{MyPath}; |
| | |
| # | | # |
| # Verify we are running as the correct user | | # Verify we are running as the correct user |
| # | | # |
|
| if ( $Conf{BackupPCUserVerify} | | if ( $Conf{BackupPCUserVerify} && $> != (my $uid = getpwnam($Conf{BackupPCUs |
| && $> != (my $uid = getpwnam($Conf{BackupPCUser})) ) { | | er})) ) { |
| ErrorExit(eval("qq{$Lang->{Wrong_user__my_userid_is___}}"), <<EOF); | | ErrorExit(eval("qq{$Lang->{Wrong_user__my_userid_is___}}"), <<EOF); |
| This script needs to run as the user specified in \$Conf{BackupPCUser}, | | This script needs to run as the user specified in \$Conf{BackupPCUser}, |
| which is set to $Conf{BackupPCUser}. | | which is set to $Conf{BackupPCUser}. |
| <p> | | <p> |
| This is an installation problem. If you are using mod_perl then | | This is an installation problem. If you are using mod_perl then |
| it appears that Apache is not running as user $Conf{BackupPCUser}. | | it appears that Apache is not running as user $Conf{BackupPCUser}. |
| If you are not using mod_perl, then most like setuid is not working | | If you are not using mod_perl, then most like setuid is not working |
| properly on BackupPC_Admin. Check the permissions on | | properly on BackupPC_Admin. Check the permissions on |
| $Conf{CgiDir}/BackupPC_Admin and look at the documentation. | | $Conf{CgiDir}/BackupPC_Admin and look at the documentation. |
| EOF | | EOF |
| } | | } |
| | |
| if ( !defined($Hosts) || $bpc->HostsMTime() != $HostsMTime ) { | | if ( !defined($Hosts) || $bpc->HostsMTime() != $HostsMTime ) { |
|
| $HostsMTime = $bpc->HostsMTime(); | | $HostsMTime = $bpc->HostsMTime(); |
| $Hosts = $bpc->HostInfoRead(); | | $Hosts = $bpc->HostInfoRead(); |
| | |
|
| # turn moreUsers list into a hash for quick lookups | | # turn moreUsers list into a hash for quick lookups |
| foreach my $host (keys %$Hosts) { | | foreach my $host ( keys %$Hosts ) { |
| $Hosts->{$host}{moreUsers} = | | $Hosts->{$host}{moreUsers} = |
| {map {$_, 1} split(",", $Hosts->{$host}{moreUsers}) } | | {map { $_, 1 } split(",", $Hosts->{$host}{moreUsers})}; |
| } | | } |
| } | | } |
| | |
| # | | # |
| # Untaint the host name | | # Untaint the host name |
| # | | # |
| if ( $In{host} =~ /^([\w.\s-]+)$/ ) { | | if ( $In{host} =~ /^([\w.\s-]+)$/ ) { |
|
| $In{host} = $1; | | $In{host} = $1; |
| } else { | | } else { |
|
| delete($In{host}); | | delete($In{host}); |
| } | | } |
| } | | } |
| | |
| sub timeStamp2 | | sub timeStamp2 |
| { | | { |
| my $now = $_[0] == 0 ? time : $_[0]; | | my $now = $_[0] == 0 ? time : $_[0]; |
|
| my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) | | my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime( |
| = localtime($now); | | $now); |
| $mon++; | | $mon++; |
| if ( $Conf{CgiDateFormatMMDD} == 2 ) { | | if ( $Conf{CgiDateFormatMMDD} == 2 ) { |
| $year += 1900; | | $year += 1900; |
| return sprintf("%04d-%02d-%02d %02d:%02d", $year, $mon, $mday, $hour, $m
in); | | return sprintf("%04d-%02d-%02d %02d:%02d", $year, $mon, $mday, $hour, $m
in); |
| } elsif ( $Conf{CgiDateFormatMMDD} ) { | | } elsif ( $Conf{CgiDateFormatMMDD} ) { |
| # | | # |
| # Add the year if the time is more than 330 days ago | | # Add the year if the time is more than 330 days ago |
| # | | # |
| if ( time - $now > 330 * 24 * 3600 ) { | | if ( time - $now > 330 * 24 * 3600 ) { |
| $year -= 100; | | $year -= 100; |
| return sprintf("$mon/$mday/%02d %02d:%02d", $year, $hour, $min); | | return sprintf("$mon/$mday/%02d %02d:%02d", $year, $hour, $min); |
| } else { | | } else { |
|
| return sprintf("$mon/$mday %02d:%02d", $hour, $min); | | return sprintf("$mon/$mday %02d:%02d", $hour, $min); |
| } | | } |
| } else { | | } else { |
| # | | # |
| # Add the year if the time is more than 330 days ago | | # Add the year if the time is more than 330 days ago |
| # | | # |
| if ( time - $now > 330 * 24 * 3600 ) { | | if ( time - $now > 330 * 24 * 3600 ) { |
| $year -= 100; | | $year -= 100; |
| return sprintf("$mday/$mon/%02d %02d:%02d", $year, $hour, $min); | | return sprintf("$mday/$mon/%02d %02d:%02d", $year, $hour, $min); |
|
| } else { | | } else { |
| return sprintf("$mday/$mon %02d:%02d", $hour, $min); | | return sprintf("$mday/$mon %02d:%02d", $hour, $min); |
| } | | } |
| } | | } |
| } | | } |
| | |
| sub HostLink | | sub HostLink |
| { | | { |
| my($host) = @_; | | my($host) = @_; |
| my($s); | | my($s); |
| if ( defined($Hosts->{$host}) ) { | | if ( defined($Hosts->{$host}) ) { |
| $s = "<a href=\"$MyURL?host=${EscURI($host)}\">$host</a>"; | | $s = "<a href=\"$MyURL?host=${EscURI($host)}\">$host</a>"; |
| } else { | | } else { |
| $s = $host; | | $s = $host; |
| } | | } |
| return \$s; | | return \$s; |
| } | | } |
| | |
| sub UserLink | | sub UserLink |
| { | | { |
| my($user) = @_; | | my($user) = @_; |
| my($s); | | my($s); |
| | |
|
| return \$user if ( $user eq "" | | return \$user if ( $user eq "" || $Conf{CgiUserUrlCreate} eq "" ); |
| || $Conf{CgiUserUrlCreate} eq "" ); | | if ( $Conf{CgiUserHomePageCheck} eq "" || -f sprintf($Conf{CgiUserHomePageCh |
| if ( $Conf{CgiUserHomePageCheck} eq "" | | eck}, $user, $user, $user) ) { |
| || -f sprintf($Conf{CgiUserHomePageCheck}, $user, $user, $user) ) { | | $s = "<a href=\"" . sprintf($Conf{CgiUserUrlCreate}, $user, $user, $user |
| $s = "<a href=\"" | | ) . "\">$user</a>"; |
| . sprintf($Conf{CgiUserUrlCreate}, $user, $user, $user) | | |
| . "\">$user</a>"; | | |
| } else { | | } else { |
| $s = $user; | | $s = $user; |
| } | | } |
| return \$s; | | return \$s; |
| } | | } |
| | |
| sub EscHTML | | sub EscHTML |
| { | | { |
| my($s) = @_; | | my($s) = @_; |
| $s =~ s/&/&/g; | | $s =~ s/&/&/g; |
| | |
| skipping to change at line 267 | | skipping to change at line 259 |
|---|
| return \$s; | | return \$s; |
| } | | } |
| | |
| sub ErrorExit | | sub ErrorExit |
| { | | { |
| my(@mesg) = @_; | | my(@mesg) = @_; |
| my($head) = shift(@mesg); | | my($head) = shift(@mesg); |
| my($mesg) = join("</p>\n<p>", @mesg); | | my($mesg) = join("</p>\n<p>", @mesg); |
| | |
| if ( !defined($ENV{REMOTE_USER}) ) { | | if ( !defined($ENV{REMOTE_USER}) ) { |
|
| $mesg .= <<EOF; | | $mesg .= <<EOF; |
| <p> | | <p> |
| Note: \$ENV{REMOTE_USER} is not set, which could mean there is an | | Note: \$ENV{REMOTE_USER} is not set, which could mean there is an |
| installation problem. BackupPC_Admin expects Apache to authenticate | | installation problem. BackupPC_Admin expects Apache to authenticate |
| the user and pass their user name into this script as the REMOTE_USER | | the user and pass their user name into this script as the REMOTE_USER |
| environment variable. See the documentation. | | environment variable. See the documentation. |
| EOF | | EOF |
| } | | } |
| | |
| $bpc->ServerMesg("log User $User (host=$In{host}) got CGI error: $head") | | $bpc->ServerMesg("log User $User (host=$In{host}) got CGI error: $head") |
|
| if ( defined($bpc) ); | | if ( defined($bpc) ); |
| if ( !defined($Lang->{Error}) ) { | | if ( !defined($Lang->{Error}) ) { |
| $mesg = <<EOF if ( !defined($mesg) ); | | $mesg = <<EOF if ( !defined($mesg) ); |
| There is some problem with the BackupPC installation. | | There is some problem with the BackupPC installation. |
| Please check the permissions on BackupPC_Admin. | | Please check the permissions on BackupPC_Admin. |
| EOF | | EOF |
| my $content = <<EOF; | | my $content = <<EOF; |
| ${h1("Error: Unable to read config.pl or language strings!!")} | | ${h1("Error: Unable to read config.pl or language strings!!")} |
| <p>$mesg</p> | | <p>$mesg</p> |
| EOF | | EOF |
| Header("BackupPC: Error", $content); | | Header("BackupPC: Error", $content); |
|
| Trailer(); | | Trailer(); |
| } else { | | } else { |
| my $content = eval("qq{$Lang->{Error____head}}"); | | my $content = eval("qq{$Lang->{Error____head}}"); |
| Header(eval("qq{$Lang->{Error}}"), $content); | | Header(eval("qq{$Lang->{Error}}"), $content); |
|
| Trailer(); | | Trailer(); |
| } | | } |
| exit(1); | | exit(1); |
| } | | } |
| | |
| sub ServerConnect | | sub ServerConnect |
| { | | { |
| # | | # |
| # Verify that the server connection is ok | | # Verify that the server connection is ok |
| # | | # |
| return if ( $bpc->ServerOK() ); | | return if ( $bpc->ServerOK() ); |
| $bpc->ServerDisconnect(); | | $bpc->ServerDisconnect(); |
| if ( my $err = $bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort}) ) { | | if ( my $err = $bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort}) ) { |
|
| if ( CheckPermission() | | if ( CheckPermission() |
| && -f $Conf{ServerInitdPath} | | && -f $Conf{ServerInitdPath} |
| && $Conf{ServerInitdStartCmd} ne "" ) { | | && $Conf{ServerInitdStartCmd} ne "" ) { |
| my $content = eval("qq{$Lang->{Admin_Start_Server}}"); | | my $content = eval("qq{$Lang->{Admin_Start_Server}}"); |
| Header(eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}"), $c
ontent); | | Header(eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}"), $c
ontent); |
| Trailer(); | | Trailer(); |
| exit(1); | | exit(1); |
| } else { | | } else { |
|
| ErrorExit(eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}"), | | ErrorExit( |
| eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server_erro | | eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server}}"), |
| r_message}}")); | | eval("qq{$Lang->{Unable_to_connect_to_BackupPC_server_error_mess |
| | age}}") |
| | ); |
| } | | } |
| } | | } |
| } | | } |
| | |
| sub GetStatusInfo | | sub GetStatusInfo |
| { | | { |
| my($status) = @_; | | my($status) = @_; |
| ServerConnect(); | | ServerConnect(); |
|
| %Status = () if ( $status =~ /\bhosts\b/ ); | | %Status = () if ( $status =~ /\bhosts\b/ ); |
| %StatusHost = () if ( $status =~ /\bhost\(/ ); | | %StatusHost = () if ( $status =~ /\bhost\(/ ); |
| my $reply = $bpc->ServerMesg("status $status"); | | my $reply = $bpc->ServerMesg("status $status"); |
| $reply = $1 if ( $reply =~ /(.*)/s ); | | $reply = $1 if ( $reply =~ /(.*)/s ); |
| eval($reply); | | eval($reply); |
|
| | |
| # ignore status related to admin jobs | | # ignore status related to admin jobs |
| if ( $status =~ /\bhosts\b/ ) { | | if ( $status =~ /\bhosts\b/ ) { |
|
| foreach my $host ( grep(/admin/, keys(%Status)) ) { | | foreach my $host ( grep(/admin/, keys(%Status)) ) { |
| delete($Status{$host}) if ( $bpc->isAdminJob($host) ); | | delete($Status{$host}) if ( $bpc->isAdminJob($host) ); |
| } | | } |
| delete($Status{$bpc->scgiJob}); | | delete($Status{$bpc->scgiJob}); |
| } | | } |
| } | | } |
| | |
| sub ReadUserEmailInfo | | sub ReadUserEmailInfo |
| { | | { |
| if ( (stat("$LogDir/UserEmailInfo.pl"))[9] != $UserEmailInfoMTime ) { | | if ( (stat("$LogDir/UserEmailInfo.pl"))[9] != $UserEmailInfoMTime ) { |
| do "$LogDir/UserEmailInfo.pl"; | | do "$LogDir/UserEmailInfo.pl"; |
| $UserEmailInfoMTime = (stat("$LogDir/UserEmailInfo.pl"))[9]; | | $UserEmailInfoMTime = (stat("$LogDir/UserEmailInfo.pl"))[9]; |
| } | | } |
| | |
| skipping to change at line 358 | | skipping to change at line 353 |
|---|
| # | | # |
| # A user is privileged if they belong to the group | | # A user is privileged if they belong to the group |
| # $Conf{CgiAdminUserGroup}, or they are in $Conf{CgiAdminUsers} | | # $Conf{CgiAdminUserGroup}, or they are in $Conf{CgiAdminUsers} |
| # or they are the user assigned to a host in the host file. | | # or they are the user assigned to a host in the host file. |
| # | | # |
| sub CheckPermission | | sub CheckPermission |
| { | | { |
| my($host) = @_; | | my($host) = @_; |
| my $Privileged = 0; | | my $Privileged = 0; |
| | |
|
| return 0 if ( $User eq "" && $Conf{CgiAdminUsers} ne "*" | | return 0 if ( $User eq "" && $Conf{CgiAdminUsers} ne "*" || $host ne "" && ! |
| || $host ne "" && !defined($Hosts->{$host}) ); | | defined($Hosts->{$host}) ); |
| if ( $Conf{CgiAdminUserGroup} ne "" ) { | | if ( $Conf{CgiAdminUserGroup} ne "" ) { |
| for ( split(/\s+/, $Conf{CgiAdminUserGroup}) ) { | | for ( split(/\s+/, $Conf{CgiAdminUserGroup}) ) { |
|
| my ($n, $p, $gid, $mem) = getgrnam($_); | | my($n, $p, $gid, $mem) = getgrnam($_); |
| $Privileged ||= ( $mem =~ /\b\Q$User\E\b/ ); | | $Privileged ||= ($mem =~ /\b\Q$User\E\b/); |
| last if ( $Privileged ); | | last if ( $Privileged ); |
| } | | } |
| } | | } |
| if ( $Conf{CgiAdminUsers} ne "" ) { | | if ( $Conf{CgiAdminUsers} ne "" ) { |
| $Privileged ||= ($Conf{CgiAdminUsers} =~ /\b\Q$User\E\b/); | | $Privileged ||= ($Conf{CgiAdminUsers} =~ /\b\Q$User\E\b/); |
| $Privileged ||= $Conf{CgiAdminUsers} eq "*"; | | $Privileged ||= $Conf{CgiAdminUsers} eq "*"; |
| } | | } |
| $PrivAdmin = $Privileged; | | $PrivAdmin = $Privileged; |
| return $Privileged if ( !defined($host) ); | | return $Privileged if ( !defined($host) ); |
| | |
| | |
| skipping to change at line 393 | | skipping to change at line 387 |
|---|
| # are listed in the moreUsers column in the hosts file. | | # are listed in the moreUsers column in the hosts file. |
| # | | # |
| sub GetUserHosts | | sub GetUserHosts |
| { | | { |
| my($getAll) = @_; | | my($getAll) = @_; |
| my @hosts; | | my @hosts; |
| | |
| if ( $getAll && CheckPermission() ) { | | if ( $getAll && CheckPermission() ) { |
| @hosts = sort keys %$Hosts; | | @hosts = sort keys %$Hosts; |
| } else { | | } else { |
|
| @hosts = sort grep { $Hosts->{$_}{user} eq $User || | | @hosts = sort grep { $Hosts->{$_}{user} eq $User || defined($Hosts->{$_} |
| defined($Hosts->{$_}{moreUsers}{$User}) } keys(%$Hosts); | | {moreUsers}{$User}) } keys(%$Hosts); |
| } | | } |
| return @hosts; | | return @hosts; |
| } | | } |
| | |
| # | | # |
| # Given a host name tries to find the IP address. For non-dhcp hosts | | # Given a host name tries to find the IP address. For non-dhcp hosts |
| # we just return the host name. For dhcp hosts we check the address | | # we just return the host name. For dhcp hosts we check the address |
| # the user is using ($ENV{REMOTE_ADDR}) and also the last-known IP | | # the user is using ($ENV{REMOTE_ADDR}) and also the last-known IP |
| # address for $host. (Later we should replace this with a broadcast | | # address for $host. (Later we should replace this with a broadcast |
| # nmblookup.) | | # nmblookup.) |
| # | | # |
| sub ConfirmIPAddress | | sub ConfirmIPAddress |
| { | | { |
| my($host) = @_; | | my($host) = @_; |
| my $ipAddr = $host; | | my $ipAddr = $host; |
| | |
|
| if ( defined($Hosts->{$host}) && $Hosts->{$host}{dhcp} | | if ( defined($Hosts->{$host}) && $Hosts->{$host}{dhcp} && $ENV{REMOTE_ADDR} |
| && $ENV{REMOTE_ADDR} =~ /^(\d+[\.\d]*)$/ ) { | | =~ /^(\d+[\.\d]*)$/ ) { |
| $ipAddr = $1; | | $ipAddr = $1; |
| my($netBiosHost, $netBiosUser) = $bpc->NetBiosInfoGet($ipAddr); | | my($netBiosHost, $netBiosUser) = $bpc->NetBiosInfoGet($ipAddr); |
| if ( $netBiosHost ne $host ) { | | if ( $netBiosHost ne $host ) { |
| my($tryIP); | | my($tryIP); |
| GetStatusInfo("host(${EscURI($host)})"); | | GetStatusInfo("host(${EscURI($host)})"); |
| if ( defined($StatusHost{dhcpHostIP}) | | if ( defined($StatusHost{dhcpHostIP}) && $StatusHost{dhcpHostIP} ne |
| && $StatusHost{dhcpHostIP} ne $ipAddr ) { | | $ipAddr ) { |
| $tryIP = eval("qq{$Lang->{tryIP}}"); | | $tryIP = eval("qq{$Lang->{tryIP}}"); |
| ($netBiosHost, $netBiosUser) | | ($netBiosHost, $netBiosUser) = $bpc->NetBiosInfoGet($StatusHost{ |
| = $bpc->NetBiosInfoGet($StatusHost{dhcpHostIP}); | | dhcpHostIP}); |
| } | | } |
| if ( $netBiosHost ne $host ) { | | if ( $netBiosHost ne $host ) { |
| ErrorExit(eval("qq{$Lang->{Can_t_find_IP_address_for}}"), | | ErrorExit(eval("qq{$Lang->{Can_t_find_IP_address_for}}"), eval(" |
| eval("qq{$Lang->{host_is_a_DHCP_host}}")); | | qq{$Lang->{host_is_a_DHCP_host}}")); |
| } | | } |
| $ipAddr = $StatusHost{dhcpHostIP}; | | $ipAddr = $StatusHost{dhcpHostIP}; |
| } | | } |
| } | | } |
| return $ipAddr; | | return $ipAddr; |
| } | | } |
| | |
| ########################################################################### | | ########################################################################### |
| # HTML layout subroutines | | # HTML layout subroutines |
| ########################################################################### | | ########################################################################### |
| | |
| sub Header | | sub Header |
| { | | { |
| my($title, $content, $noBrowse, $contentSub, $contentPost) = @_; | | my($title, $content, $noBrowse, $contentSub, $contentPost) = @_; |
| my @adminLinks = ( | | my @adminLinks = ( |
|
| { link => "?action=status", name => $Lang->{Status}}, | | {link => "?action=status", name => $Lang->{Status}}, |
| { link => "?action=summary", name => $Lang->{PC_Summary}}, | | {link => "?action=summary", name => $Lang->{PC_Summary}}, |
| { link => "?action=editConfig", name => $Lang->{CfgEdit_Edit_Config}, | | { |
| priv => 1}, | | link => "?action=editConfig", |
| { link => "?action=editConfig&newMenu=hosts", | | name => $Lang->{CfgEdit_Edit_Config}, |
| name => $Lang->{CfgEdit_Edit_Hosts}, | | priv => 1 |
| priv => 1}, | | }, |
| { link => "?action=adminOpts", name => $Lang->{Admin_Options}, | | { |
| priv => 1}, | | link => "?action=editConfig&newMenu=hosts", |
| { link => "?action=view&type=LOG", name => $Lang->{LOG_file}, | | name => $Lang->{CfgEdit_Edit_Hosts}, |
| priv => 1}, | | priv => 1 |
| { link => "?action=LOGlist", name => $Lang->{Old_LOGs}, | | }, |
| priv => 1}, | | { |
| { link => "?action=emailSummary", name => $Lang->{Email_summary}, | | link => "?action=adminOpts", |
| priv => 1}, | | name => $Lang->{Admin_Options}, |
| { link => "?action=queue", name => $Lang->{Current_queues}, | | priv => 1 |
| priv => 1}, | | }, |
| | { |
| | link => "?action=view&type=LOG", |
| | name => $Lang->{LOG_file}, |
| | priv => 1 |
| | }, |
| | { |
| | link => "?action=LOGlist", |
| | name => $Lang->{Old_LOGs}, |
| | priv => 1 |
| | }, |
| | { |
| | link => "?action=emailSummary", |
| | name => $Lang->{Email_summary}, |
| | priv => 1 |
| | }, |
| | { |
| | link => "?action=queue", |
| | name => $Lang->{Current_queues}, |
| | priv => 1 |
| | }, |
| @{$Conf{CgiNavBarLinks} || []}, | | @{$Conf{CgiNavBarLinks} || []}, |
| ); | | ); |
| my $host = $In{host}; | | my $host = $In{host}; |
| | |
| binmode(select, ":utf8"); | | binmode(select, ":utf8"); |
| print $Cgi->header(-charset => "utf-8"); | | print $Cgi->header(-charset => "utf-8"); |
| print <<EOF; | | print <<EOF; |
| <!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN"> | | <!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN"> |
| <html><head> | | <html><head> |
| <title>$title</title> | | <title>$title</title> |
|
| <link rel=stylesheet type="text/css" href="$Conf{CgiImageDirURL}/$Conf{CgiCSSFil | | <link rel=stylesheet type="text/css" href="$Conf{CgiImageDirURL}/$Conf{CgiCSSFil |
| e}" title="CSSFile"> | | e}?version=2" title="CSSFile"> |
| <link rel=icon href="$Conf{CgiImageDirURL}/favicon.ico" type="image/x-icon"> | | |
| | <link rel="apple-touch-icon" sizes="180x180" href="$Conf{CgiImageDirURL}/apple-t |
| | ouch-icon.png?v=2"> |
| | <link rel="icon" type="image/png" sizes="32x32" href="$Conf{CgiImageDirURL}/favi |
| | con-32x32.png?v=2"> |
| | <link rel="icon" type="image/png" sizes="16x16" href="$Conf{CgiImageDirURL}/favi |
| | con-16x16.png?v=2"> |
| | <link rel="mask-icon" href="$Conf{CgiImageDirURL}/safari-pinned-tab.svg?v=2" col |
| | or="#5bbad5"> |
| | <link rel="shortcut icon" href="$Conf{CgiImageDirURL}/favicon.ico?v=2"> |
| | |
| $Conf{CgiHeaders} | | $Conf{CgiHeaders} |
| <script src="$Conf{CgiImageDirURL}/sorttable.js"></script> | | <script src="$Conf{CgiImageDirURL}/sorttable.js"></script> |
| </head><body onLoad="document.getElementById('NavMenu').style.height=document.bo
dy.scrollHeight"> | | </head><body onLoad="document.getElementById('NavMenu').style.height=document.bo
dy.scrollHeight"> |
| | |
| <div id="navigation-container"> | | <div id="navigation-container"> |
| <div id="logo-container"> | | <div id="logo-container"> |
|
| <a href="https://backuppc.github.io/backuppc/"><img src="$Conf{Cg
iImageDirURL}/logo.gif"></a> | | <a href="https://backuppc.github.io/backuppc/"><img src="$Conf{Cg
iImageDirURL}/logo320.png"></a> |
| </div> | | </div> |
| EOF | | EOF |
| | |
| if ( defined($Hosts) && defined($host) && defined($Hosts->{$host}) ) { | | if ( defined($Hosts) && defined($host) && defined($Hosts->{$host}) ) { |
|
| print "<div class=\"NavMenu section-title\">"; | | print "<div class=\"NavMenu section-title\">"; |
| NavSectionTitle("${EscHTML($host)}"); | | NavSectionTitle("${EscHTML($host)}"); |
| print <<EOF; | | print <<EOF; |
| </div> | | </div> |
| <div class="NavMenu host"> | | <div class="NavMenu host"> |
| EOF | | EOF |
|
| NavLink("?host=${EscURI($host)}", | | NavLink("?host=${EscURI($host)}", "$host $Lang->{Home}", " |
| "$host $Lang->{Home}", " class=\"navbar\""); | | class=\"navbar\""); |
| NavLink("?action=browse&host=${EscURI($host)}", | | NavLink("?action=browse&host=${EscURI($host)}", $Lang->{Browse}, " |
| $Lang->{Browse}, " class=\"navbar\"") if ( !$noBrowse ); | | class=\"navbar\"") if ( !$noBrowse ); |
| NavLink("?action=view&type=LOG&host=${EscURI($host)}", | | NavLink("?action=view&type=LOG&host=${EscURI($host)}", $Lang->{LOG_file} |
| $Lang->{LOG_file}, " class=\"navbar\""); | | , " class=\"navbar\""); |
| NavLink("?action=LOGlist&host=${EscURI($host)}", | | NavLink("?action=LOGlist&host=${EscURI($host)}", $Lang->{LOG_files |
| $Lang->{LOG_files}, " class=\"navbar\""); | | }, " class=\"navbar\""); |
| if ( -f "$TopDir/pc/$host/SmbLOG.bad" | | if ( -f "$TopDir/pc/$host/SmbLOG.bad" |
| || -f "$TopDir/pc/$host/SmbLOG.bad.z" | | || -f "$TopDir/pc/$host/SmbLOG.bad.z" |
| || -f "$TopDir/pc/$host/XferLOG.bad" | | || -f "$TopDir/pc/$host/XferLOG.bad" |
| || -f "$TopDir/pc/$host/XferLOG.bad.z" ) { | | || -f "$TopDir/pc/$host/XferLOG.bad.z" ) { |
| NavLink("?action=view&type=XferLOGbad&host=${EscURI($host)}", | | NavLink( |
| $Lang->{Last_bad_XferLOG}, " class=\"navbar\""); | | "?action=view&type=XferLOGbad&host=${EscURI($host)}", |
| NavLink("?action=view&type=XferErrbad&host=${EscURI($host)}", | | $Lang->{Last_bad_XferLOG}, |
| $Lang->{Last_bad_XferLOG_errors_only}, | | " class=\"navbar\"" |
| " class=\"navbar\""); | | ); |
| } | | NavLink( |
| | "?action=view&type=XferErrbad&host=${EscURI($host)}", |
| | $Lang->{Last_bad_XferLOG_errors_only}, |
| | " class=\"navbar\"" |
| | ); |
| | } |
| if ( $Conf{CgiUserConfigEditEnable} || $PrivAdmin ) { | | if ( $Conf{CgiUserConfigEditEnable} || $PrivAdmin ) { |
|
| NavLink("?action=editConfig&host=${EscURI($host)}", | | NavLink("?action=editConfig&host=${EscURI($host)}", $Lang->{CfgEdit_ |
| $Lang->{CfgEdit_Edit_Config}, " class=\"navbar\""); | | Edit_Config}, " class=\"navbar\""); |
| } elsif ( -f "$TopDir/pc/$host/config.pl" | | } elsif ( -f "$TopDir/pc/$host/config.pl" || ($host ne "config" && -f "$ |
| || ($host ne "config" && -f "$TopDir/conf/$host.pl") ) { | | TopDir/conf/$host.pl") ) { |
| NavLink("?action=view&type=config&host=${EscURI($host)}", | | NavLink("?action=view&type=config&host=${EscURI($host)}", $Lang->{Co |
| $Lang->{Config_file}, " class=\"navbar\""); | | nfig_file}, " class=\"navbar\""); |
| } | | } |
|
| print "</div>\n"; | | print "</div>\n"; |
| } | | } |
| print <<EOF; | | print <<EOF; |
| <div class="NavMenu" id="NavMenu"> | | <div class="NavMenu" id="NavMenu"> |
| EOF | | EOF |
| my $hostSelectbox = "<option value=\"#\">$Lang->{Select_a_host}</option>"; | | my $hostSelectbox = "<option value=\"#\">$Lang->{Select_a_host}</option>"; |
|
| my @hosts = GetUserHosts($Conf{CgiNavBarAdminAllHosts}); | | my @hosts = GetUserHosts($Conf{CgiNavBarAdminAllHosts}); |
| NavSectionTitle($Lang->{Hosts}); | | NavSectionTitle($Lang->{Hosts}); |
| if ( defined($Hosts) && %$Hosts > 0 && @hosts ) { | | if ( defined($Hosts) && %$Hosts > 0 && @hosts ) { |
| foreach my $host ( @hosts ) { | | foreach my $host ( @hosts ) { |
|
| NavLink("?host=${EscURI($host)}", $host) | | NavLink("?host=${EscURI($host)}", $host) |
| if ( @hosts < $Conf{CgiNavBarAdminAllHosts} ); | | if ( @hosts < $Conf{CgiNavBarAdminAllHosts} ); |
| my $sel = " selected" if ( $host eq $In{host} ); | | my $sel = " selected" if ( $host eq $In{host} ); |
| $hostSelectbox .= "<option value=\"?host=${EscURI($host)}\"$sel>" | | $hostSelectbox .= "<option value=\"?host=${EscURI($host)}\"$sel>$hos |
| . "$host</option>"; | | t</option>"; |
| } | | } |
| } | | } |
| if ( @hosts >= $Conf{CgiNavBarAdminAllHosts} ) { | | if ( @hosts >= $Conf{CgiNavBarAdminAllHosts} ) { |
| print <<EOF; | | print <<EOF; |
| <select onChange="document.location=this.value"> | | <select onChange="document.location=this.value"> |
| $hostSelectbox | | $hostSelectbox |
| </select> | | </select> |
| EOF | | EOF |
| } | | } |
| if ( $Conf{CgiSearchBoxEnable} ) { | | if ( $Conf{CgiSearchBoxEnable} ) { |
| | |
| skipping to change at line 561 | | skipping to change at line 573 |
|---|
| } | | } |
| } | | } |
| | |
| print <<EOF; | | print <<EOF; |
| </div> | | </div> |
| </div> <!-- end #navigation-container --> | | </div> <!-- end #navigation-container --> |
| EOF | | EOF |
| | |
| print("<div id=\"Content\">\n$content\n"); | | print("<div id=\"Content\">\n$content\n"); |
| if ( defined($contentSub) && ref($contentSub) eq "CODE" ) { | | if ( defined($contentSub) && ref($contentSub) eq "CODE" ) { |
|
| while ( (my $s = &$contentSub()) ne "" ) { | | while ( (my $s = &$contentSub()) ne "" ) { |
| print($s); | | print($s); |
| } | | } |
| } | | } |
| print($contentPost) if ( defined($contentPost) ); | | print($contentPost) if ( defined($contentPost) ); |
| } | | } |
| | |
| sub Trailer | | sub Trailer |
| { | | { |
| print <<EOF; | | print <<EOF; |
| </body></html> | | </body></html> |
| EOF | | EOF |
| } | | } |
| | |
| skipping to change at line 597 | | skipping to change at line 609 |
|---|
| sub NavSectionEnd | | sub NavSectionEnd |
| { | | { |
| } | | } |
| | |
| sub NavLink | | sub NavLink |
| { | | { |
| my($link, $text) = @_; | | my($link, $text) = @_; |
| if ( defined($link) ) { | | if ( defined($link) ) { |
| my($class); | | my($class); |
| $class = " class=\"NavCurrent\"" | | $class = " class=\"NavCurrent\"" |
|
| if ( length($link) && $ENV{REQUEST_URI} =~ /\Q$link\E$/ | | if ( length($link) && $ENV{REQUEST_URI} =~ /\Q$link\E$/ |
| || length($link) && $link =~ /\&host=/ && $ENV{REQUEST_URI} | | || length($link) && $link =~ /\&host=/ && $ENV{REQUEST_URI} =~ /\Q$l |
| =~ /\Q$link\E/ | | ink\E/ |
| || $link eq "" && $ENV{REQUEST_URI} !~ /\?/ ); | | || $link eq "" && $ENV{REQUEST_URI} !~ /\?/ ); |
| $link = "$MyURL$link" if ( $link eq "" || $link =~ /^\?/ ); | | $link = "$MyURL$link" if ( $link eq "" || $link =~ /^\?/ ); |
| print <<EOF; | | print <<EOF; |
| <a href="$link"$class>$text</a> | | <a href="$link"$class>$text</a> |
| EOF | | EOF |
| } else { | | } else { |
| print <<EOF; | | print <<EOF; |
| $text<br> | | $text<br> |
| EOF | | EOF |
| } | | } |
| } | | } |
| | | |
| End of changes. 43 change blocks. |
|---|
| 176 lines changed or deleted | | 210 lines changed or added |
|---|
"Fossies" - the Fresh Open Source Software Archive 