[LON-CAPA-cvs] cvs: loncom /cgi lonauthcgi.pm loncgi.pm

raeburn raeburn@source.lon-capa.org
Thu, 25 Dec 2008 01:51:04 -0000


This is a MIME encoded message

--raeburn1230169864
Content-Type: text/plain

raeburn		Thu Dec 25 01:51:04 2008 EDT

  Added files:                 
    /loncom/cgi	lonauthcgi.pm 

  Modified files:              
    /loncom/cgi	loncgi.pm 
  Log:
  - Create new module - lonauthcgi.pm -to contain modules previously in loncgi.pm
      which require lonnet.pm, so loncgi.pm need not import lonnet.pm.
  - Moved &check_ipbased_access(), &can_view(), &unauthorized_msg(), and
      &serverstatus_titles() from  loncgi.pm to lonauthcgi.pm.
  
  
--raeburn1230169864
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20081225015104.txt"

Index: loncom/cgi/loncgi.pm
diff -u loncom/cgi/loncgi.pm:1.10 loncom/cgi/loncgi.pm:1.11
--- loncom/cgi/loncgi.pm:1.10	Sun Nov 30 14:47:18 2008
+++ loncom/cgi/loncgi.pm	Thu Dec 25 01:51:03 2008
@@ -1,7 +1,7 @@
 #
 # LON-CAPA helpers for cgi-bin scripts
 #
-# $Id: loncgi.pm,v 1.10 2008/11/30 14:47:18 raeburn Exp $
+# $Id: loncgi.pm,v 1.11 2008/12/25 01:51:03 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -37,10 +37,7 @@
 =head1 SYNOPSIS
 
 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.
+environment, and retrieving arguments passed in via a CGI's Query String.
 
 =head1 Subroutines
 
@@ -170,162 +167,6 @@
 
 =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
@@ -356,41 +197,6 @@
 
 =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 
@@ -400,6 +206,7 @@
 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
 
 #############################################

Index: loncom/cgi/lonauthcgi.pm
+++ loncom/cgi/lonauthcgi.pm
#
# LON-CAPA authorization for cgi-bin scripts
#
# $Id: lonauthcgi.pm,v 1.1 2008/12/25 01:51:03 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
#############################################
#############################################

=pod

=head1 NAME

loncgi

=head1 SYNOPSIS

Provides subroutines for checking if access to cgi pages is allowed
based on IP address, or for logged-in users based on role and/or     
identity. Also provides subroutines to give a user 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

=over 4

=cut

#############################################
#############################################

package LONCAPA::lonauthcgi;

use strict;
use lib '/home/httpd/lib/perl';
use Apache::lonnet;
use Apache::lonlocal;
use LONCAPA;

#############################################
#############################################

=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 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;
}


1;


--raeburn1230169864--