[LON-CAPA-cvs] cvs: loncom /cgi loncgi.pm
raeburn
raeburn@source.lon-capa.org
Fri, 28 Nov 2008 20:39:43 -0000
This is a MIME encoded message
--raeburn1227904783
Content-Type: text/plain
raeburn Fri Nov 28 20:39:43 2008 EDT
Modified files:
/loncom/cgi loncgi.pm
Log:
- Added subroutines: check_ipbased_access(), can_view(), missing_cookie_msg(),
serverstatus_titles(), and get_items() for use in checking access for a
number of server status scripts in /home/httpd/cgi-bin
- Added localization.
- Updated documentation.
--raeburn1227904783
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20081128203943.txt"
Index: loncom/cgi/loncgi.pm
diff -u loncom/cgi/loncgi.pm:1.8 loncom/cgi/loncgi.pm:1.9
--- loncom/cgi/loncgi.pm:1.8 Tue Sep 19 21:36:31 2006
+++ loncom/cgi/loncgi.pm Fri Nov 28 20:39:43 2008
@@ -1,7 +1,7 @@
#
# LON-CAPA helpers for cgi-bin scripts
#
-# $Id: loncgi.pm,v 1.8 2006/09/19 21:36:31 albertel Exp $
+# $Id: loncgi.pm,v 1.9 2008/11/28 20:39:43 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -36,8 +36,11 @@
=head1 SYNOPSIS
-Provides subroutines for checking a LON-CAPA cookie and loading the users
-environment.
+Provides subroutines for checking a LON-CAPA cookie, loading the user's
+environment, retrieving arguments passed in via a CGI's Query String,
+checking access controls, providing a user with an explanation
+when access is denied, and descriptions of various server status pages
+generated by CGI scripts which use these subroutines for authorization.
=head1 Subroutines
@@ -60,6 +63,7 @@
use LONCAPA;
use LONCAPA::Configuration();
use GDBM_File;
+use Apache::lonlocal;
my $lonidsdir;
@@ -69,12 +73,13 @@
$lonidsdir = $perlvar->{'lonIDsDir'};
}
+
#############################################
#############################################
=pod
-=item check_cookie_and_load_env
+=item check_cookie_and_load_env()
Inputs: none
@@ -103,7 +108,7 @@
=pod
-=item check_cookie
+=item check_cookie()
Inputs: none
@@ -130,7 +135,7 @@
=pod
-=item transfer_profile_to_env
+=item transfer_profile_to_env()
Load the users environment into the %env hash.
@@ -156,6 +161,253 @@
#############################################
#############################################
+=pod
+
+=item check_ipbased_access()
+
+Inputs: $page, the identifier of the page to be viewed,
+ can be one of the keys in the hash from &serverstatus_titles()
+
+ $ip, the IP address of the client requesting the page.
+
+Returns: 1 if access is permitted for the requestor's IP.
+ Access is allowed if on of the following is true:
+ (a) the requestor IP is the loopback address
+ (b) Domain configurations for domains hosted on this server include
+ the requestor's IP as one of the specified IPs with access
+ to this page. (does not apply to 'ping' page type)
+=cut
+
+#############################################
+#############################################
+sub check_ipbased_access {
+ my ($page,$ip) = @_;
+ my $allowed;
+ if (!defined($ip)) {
+ $ip = $ENV{'REMOTE_ADDR'};
+ }
+ if (($page ne 'lonstatus') && ($page ne 'serverstatus')) {
+ if ($ip eq '127.0.0.1') {
+ $allowed = 1;
+ return $allowed;
+ }
+ }
+ if ($page ne 'ping') {
+ my @poss_domains = &Apache::lonnet::current_machine_domains();
+ foreach my $dom (@poss_domains) {
+ my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],$dom);
+ if (ref($domconfig{'serverstatuses'}) eq 'HASH') {
+ if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
+ if ($domconfig{'serverstatuses'}{$page}{'machines'} ne '') {
+ my @okmachines = split(/,/,$domconfig{'serverstatuses'}{$page}{'machines'});
+ if (grep(/^\Q$ip\E$/,@okmachines)) {
+ $allowed = 1;
+ last;
+ }
+ }
+ }
+ }
+ }
+ }
+ return $allowed;
+}
+
+#############################################
+#############################################
+
+=pod
+
+=item can_view()
+
+Inputs: $page, the identifier of the page to be viewed,
+ can be one of the keys in the hash from &serverstatus_titles()
+
+Returns: 1 if access to the page is permitted.
+ Access allowed if one of the following is true:
+ (a) Requestor has LON-CAPA superuser role
+ (b) Requestor's role is Domain Coordinator in one of the domains
+ hosted on this server
+ (c) Domain configurations for domains hosted on this server include
+ the requestor as one of the named users (username:domain) with access
+ to the page.
+
+ In the case of requests for the 'ping' page, and access is also allowed if
+ at least one domain hosted on requestor's server is also hosted on this server.
+
+=cut
+
+#############################################
+#############################################
+sub can_view {
+ my ($page) = @_;
+ my $allowed;
+ if ($Apache::lonnet::env{'request.role'} =~ m{^su\./}) {
+ $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 {
+ my @poss_domains = &Apache::lonnet::current_machine_domains();
+ foreach my $dom (@poss_domains) {
+ my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],$dom);
+ if ($Apache::lonnet::env{'request.role'} eq "dc./$dom/") {
+ $allowed = 1;
+ } elsif (ref($domconfig{'serverstatuses'}) eq 'HASH') {
+ if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
+ if ($domconfig{'serverstatuses'}{$page}{'namedusers'} ne '') {
+ my @okusers = split(/,/,$domconfig{'serverstatuses'}{$page}{'namedusers'});
+ if (grep(/^\Q$Apache::lonnet::env{'user.name'}:$Apache::lonnet::env{'user.domain'}\E$/,@okusers)) {
+ $allowed = 1;
+ }
+ }
+ }
+ }
+ last if $allowed;
+ }
+ }
+ return $allowed;
+}
+
+#############################################
+#############################################
+
+=pod
+
+=unauthorized_msg()
+
+Inputs: $page, the identifier of the page to be viewed,
+ can be one of the keys in the hash from &serverstatus_titles()
+
+Returns: A string explaining why access was denied for the particular page.
+
+=cut
+
+#############################################
+#############################################
+sub unauthorized_msg {
+ my ($page) = @_;
+ my $titles = &serverstatus_titles();
+ if ($page eq 'clusterstatus') {
+ return &mt('Your current role does not permit you to view the requested server status page: [_1]',$titles->{$page});
+ }
+ my @poss_domains = &Apache::lonnet::current_machine_domains();
+ if (@poss_domains == 1) {
+ my $domdesc = &Apache::lonnet::domain($poss_domains[0]);
+ return &mt('The configuration for domain: [_1] does not permit you to view the requested server status page: [_2].',"$domdesc ($poss_domains[0])",$titles->{$page});
+ } elsif (@poss_domains > 1) {
+ my $output = &mt('Configurations for the domains housed on this server: ').'<ul>';
+ foreach my $dom (@poss_domains) {
+ my $domdesc = &Apache::lonnet::domain($dom);
+ $output .= '<li>'.&Apache::lonnet::domain($dom).'('.$dom.')</li>';
+ }
+ $output .= '</ul>'.&mt('do not permit you to view the requested server status page: [_1]',$titles->{$page});
+ return $output;
+ } else {
+ return &mt('No domain information exists for this server');
+ }
+}
+
+#############################################
+#############################################
+
+=pod
+
+=item missing_cookie_msg()
+
+Inputs: none
+Returns: HTML for a page indicating cookie information absent.
+
+=cut
+
+#############################################
+#############################################
+sub missing_cookie_msg {
+ my %lt = &Apache::lonlocal::texthash (
+ cook => 'Bad Cookie',
+ your => 'Your cookie information is incorrect.',
+ );
+ return <<END;
+<html>
+<head><title>$lt{'cook'}</title></head>
+<body>
+$lt{'your'}
+</body>
+</html>
+END
+
+}
+
+#############################################
+#############################################
+
+=pod
+
+=item serverstatus_titles()
+
+Inputs: none
+
+Returns: a reference to a hash of pages, where in the hash
+ keys are names of pages which employ loncgi.pm
+ or lonstatusacc.pm for access control,
+ and corresponding values are descriptions of each page
+
+=cut
+
+#############################################
+#############################################
+sub serverstatus_titles {
+ my %titles = &Apache::lonlocal::texthash (
+ 'userstatus' => 'User Status Summary',
+ 'lonstatus' => 'Display Detailed Report',
+ 'loncron' => 'Generate Detailed Report',
+ 'server-status' => 'Apache Status Page',
+ 'codeversions' => 'LON-CAPA Module Versions',
+ 'clusterstatus' => 'Domain status',
+ 'metadata_keywords' => 'Display Metadata Keywords',
+ 'metadata_harvest' => 'Harvest Metadata Searches',
+ 'takeoffline' => 'Offline - replace Log-in page',
+ 'takeonline' => 'Online - restore Log-in page',
+ 'showenv' => "Show user environment",
+ );
+ return \%titles;
+}
+
+#############################################
+#############################################
+
+=pod
+
+=cgi_getitems()
+
+Inputs: $query (the CGI query string), and $getitems, a reference to a hash
+
+Returns: nothing
+
+Side Effects: populates $getitems hash ref with key => value
+ where each key is the name of the form item in the query string
+ and value is an array of corresponding values.
+=cut
+
+#############################################
+#############################################
+sub cgi_getitems {
+ my ($query,$getitems)= @_;
+ foreach (split(/&/,$query)) {
+ my ($name, $value) = split(/=/,$_);
+ $name = &unescape($name);
+ $value =~ tr/+/ /;
+ $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
+ push(@{$$getitems{$name}},$value);
+ }
+ return;
+}
=pod
--raeburn1227904783--