version 1.7, 2011/10/14 20:50:54
|
version 1.8, 2011/10/17 17:23:25
|
Line 32
|
Line 32
|
|
|
=head1 NAME |
=head1 NAME |
|
|
loncgi |
lonauthcgi |
|
|
=head1 SYNOPSIS |
=head1 SYNOPSIS |
|
|
Line 59 use Socket;
|
Line 59 use Socket;
|
use Apache::lonnet; |
use Apache::lonnet; |
use Apache::lonlocal; |
use Apache::lonlocal; |
use LONCAPA; |
use LONCAPA; |
use LONCAPA::Configuration(); |
|
|
|
############################################# |
############################################# |
############################################# |
############################################# |
Line 74 Inputs: $page, the identifier of the pag
|
Line 73 Inputs: $page, the identifier of the pag
|
$ip, the IP address of the client requesting the page. |
$ip, the IP address of the client requesting the page. |
|
|
Returns: 1 if access is permitted for the requestor's IP. |
Returns: 1 if access is permitted for the requestor's IP. |
Access is allowed if on of the following is true: |
Access is allowed if one of the following is true: |
(a) the requestor IP is the loopback address |
(a) the requestor IP is the loopback address. |
(b) Domain configurations for domains hosted on this server include |
(b) the requestor IP is the IP of the current server. |
|
(c) the requestor IP is the IP of a manager, |
|
if the page to view is not "takeoffline" or "toggledebug" |
|
(d) the requestor IP is the IP of a server belonging |
|
to a domain included in domains hosted on this server. |
|
(e) Domain configurations for domains hosted on this server include |
the requestor's IP as one of the specified IPs with access |
the requestor's IP as one of the specified IPs with access |
to this page. (does not apply to 'ping' page type) |
to this page. (not applicable to 'ping' page). |
|
|
=cut |
=cut |
|
|
Line 90 sub check_ipbased_access {
|
Line 94 sub check_ipbased_access {
|
if (!defined($ip)) { |
if (!defined($ip)) { |
$ip = $ENV{'REMOTE_ADDR'}; |
$ip = $ENV{'REMOTE_ADDR'}; |
} |
} |
if (($page ne 'lonstatus') && ($page ne 'serverstatus')) { |
if ($ip eq '127.0.0.1') { |
if ($ip eq '127.0.0.1') { |
$allowed = 1; |
|
return $allowed; |
|
} else { |
|
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; |
|
my $host_ip = &Apache::lonnet::get_host_ip($lonhost); |
|
if (($host_ip ne '') && ($host_ip eq $ip)) { |
$allowed = 1; |
$allowed = 1; |
return $allowed; |
return $allowed; |
} |
} |
} |
} |
if (&is_manager_ip($ip)) { |
if (&is_manager_ip($ip)) { |
|
unless (($page eq 'toggledebug') || ($page eq 'takeoffline')) { |
|
$allowed = 1; |
|
return $allowed; |
|
} |
|
} |
|
if (&check_domain_ip($ip)) { |
$allowed = 1; |
$allowed = 1; |
return $allowed; |
return $allowed; |
} |
} |
Line 123 sub check_ipbased_access {
|
Line 138 sub check_ipbased_access {
|
############################################# |
############################################# |
############################################# |
############################################# |
|
|
|
=pod |
|
|
|
=item is_manager_ip() |
|
|
|
Inputs: $remote_ip, the IP address of the client requesting the page. |
|
|
|
Returns: 1 if the client IP address corresponds to that of a |
|
machine listed in /home/httpd/lonTabs/managers.tab |
|
|
|
=cut |
|
|
|
############################################# |
|
############################################# |
sub is_manager_ip { |
sub is_manager_ip { |
my ($remote_ip) = @_; |
my ($remote_ip) = @_; |
return if ($remote_ip eq ''); |
return if ($remote_ip eq ''); |
my ($directory,$is_manager); |
my ($directory,$is_manager); |
my $config=LONCAPA::Configuration::read_conf(); |
foreach my $key (keys(%Apache::lonnet::managerstab)) { |
if (ref($config) eq 'HASH') { |
my $manager_ip; |
$directory = $config->{'lonTabDir'}; |
if ($key =~ /:/) { |
|
my ($cluname,$dnsname) = split(/:/,$key); |
|
my $ip = gethostbyname($dnsname); |
|
if (defined($ip)) { |
|
$manager_ip = inet_ntoa($ip); |
|
} |
|
} else { |
|
$manager_ip = &Apache::lonnet::get_host_ip($key); |
|
} |
|
if (defined($manager_ip)) { |
|
if ($remote_ip eq $manager_ip) { |
|
$is_manager = 1; |
|
last; |
|
} |
|
} |
} |
} |
if (defined($directory)) { |
return $is_manager; |
if (open(MANAGERS, "$directory/managers.tab")) { |
} |
while(my $host = <MANAGERS>) { |
|
chomp($host); |
############################################# |
next if ($host =~ /^\#/); |
############################################# |
my $ip = &Apache::lonnet::get_host_ip($host); |
|
if (defined($ip)) { |
=pod |
if ($remote_ip eq $ip) { |
|
$is_manager = 1; |
=item check_domain_ip() |
last; |
|
} |
Inputs: $remote_ip, the IP address of the client requesting the page. |
} else { |
|
my ($cluname,$dnsname) = split(/:/, $host); |
Returns: 1 if the client IP address is for a machine in the cluster |
$ip = gethostbyname($dnsname); |
and domain in common for client machine and this machine. |
if (defined($ip)) { |
|
my $hostip = inet_ntoa($ip); |
=cut |
if ($hostip = $remote_ip) { |
|
$is_manager = 1; |
############################################# |
|
############################################# |
|
sub check_domain_ip { |
|
my ($remote_ip) = @_; |
|
my %remote_doms; |
|
my $allowed; |
|
if ($remote_ip ne '') { |
|
if (&Apache::lonnet::hostname($remote_ip) ne '') { |
|
my @poss_domains = &Apache::lonnet::current_machine_domains(); |
|
if (@poss_domains > 0) { |
|
my @remote_hosts = &Apache::lonnet::get_hosts_from_ip($remote_ip); |
|
foreach my $hostid (@remote_hosts) { |
|
my $hostdom = &Apache::lonnet::host_domain($hostid); |
|
if ($hostdom ne '') { |
|
if (grep(/^\Q$hostdom\E$/,@poss_domains)) { |
|
$allowed = 1; |
|
last; |
} |
} |
} |
} |
} |
} |
} |
} |
close(MANAGERS); |
|
} |
} |
} |
} |
return $is_manager; |
return $allowed; |
} |
} |
|
|
############################################# |
############################################# |
Line 178 Returns: 1 if access to the page is perm
|
Line 235 Returns: 1 if access to the page is perm
|
the requestor as one of the named users (username:domain) with access |
the requestor as one of the named users (username:domain) with access |
to the page. |
to the page. |
|
|
In the case of requests for the 'ping' page, access is also allowed if |
|
at least one domain hosted on requestor's server is also hosted on this server. |
|
|
|
In the case of requests for the 'showenv' page (/adm/test), the domains tested |
In the case of requests for the 'showenv' page (/adm/test), the domains tested |
are not the domains hosted on the server, but instead are a single domain - |
are not the domains hosted on the server, but instead are a single domain - |
the domain of the requestor. In addition, if the requestor has an active |
the domain of the requestor. In addition, if the requestor has an active |
Domain Coordinator role for that domain, access is permitted, regardless of |
Domain Coordinator role for that domain, access is permitted, regardless of |
the requestor's current role. |
the requestor's current role. |
|
|
=cut |
=cut |
|
|
############################################# |
############################################# |
Line 195 sub can_view {
|
Line 250 sub can_view {
|
my $allowed; |
my $allowed; |
if ($Apache::lonnet::env{'request.role'} =~ m{^su\./}) { |
if ($Apache::lonnet::env{'request.role'} =~ m{^su\./}) { |
$allowed = 1; |
$allowed = 1; |
} elsif ($page eq 'ping') { |
|
my @poss_domains = &Apache::lonnet::current_machine_domains(); |
|
my @hostids= &Apache::lonnet::get_hosts_from_ip($ENV{'REMOTE_ADDR'}); |
|
foreach my $hostid (@hostids) { |
|
my $hostdom = &Apache::lonnet::host_domain($hostid); |
|
if (grep(/^\Q$hostdom\E$/,@poss_domains)) { |
|
$allowed = 1; |
|
last; |
|
} |
|
} |
|
} else { |
} else { |
my @poss_domains; |
my @poss_domains; |
if ($page eq 'showenv') { |
if ($page eq 'showenv') { |
Line 251 sub can_view {
|
Line 296 sub can_view {
|
|
|
=pod |
=pod |
|
|
=unauthorized_msg() |
=item unauthorized_msg() |
|
|
Inputs: $page, the identifier of the page to be viewed, |
Inputs: $page, the identifier of the page to be viewed, |
can be one of the keys in the hash from &serverstatus_titles() |
can be one of the keys in the hash from &serverstatus_titles() |
Line 321 sub serverstatus_titles {
|
Line 366 sub serverstatus_titles {
|
return \%titles; |
return \%titles; |
} |
} |
|
|
|
=pod |
|
|
1; |
=back |
|
|
|
=cut |
|
|
|
1; |