Annotation of loncom/cgi/lonauthcgi.pm, revision 1.1

1.1     ! raeburn     1: #
        !             2: # LON-CAPA authorization for cgi-bin scripts
        !             3: #
        !             4: # $Id: lonauthcgi.pm,v 1.1 2008/12/24 20:15:00 raeburn Exp $
        !             5: #
        !             6: # Copyright Michigan State University Board of Trustees
        !             7: #
        !             8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
        !             9: #
        !            10: # LON-CAPA is free software; you can redistribute it and/or modify
        !            11: # it under the terms of the GNU General Public License as published by
        !            12: # the Free Software Foundation; either version 2 of the License, or
        !            13: # (at your option) any later version.
        !            14: #
        !            15: # LON-CAPA is distributed in the hope that it will be useful,
        !            16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            18: # GNU General Public License for more details.
        !            19: #
        !            20: # You should have received a copy of the GNU General Public License
        !            21: # along with LON-CAPA; if not, write to the Free Software
        !            22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
        !            23: #
        !            24: # /home/httpd/html/adm/gpl.txt
        !            25: #
        !            26: # http://www.lon-capa.org/
        !            27: #
        !            28: #############################################
        !            29: #############################################
        !            30: 
        !            31: =pod
        !            32: 
        !            33: =head1 NAME
        !            34: 
        !            35: loncgi
        !            36: 
        !            37: =head1 SYNOPSIS
        !            38: 
        !            39: Provides subroutines for checking if access to cgi pages is allowed
        !            40: based on IP address, or for logged-in users based on role and/or     
        !            41: identity. Also provides subroutines to give a user an explanation 
        !            42: when access is denied, and descriptions of various server status pages
        !            43: generated by CGI scripts which use these subroutines for authorization. 
        !            44: 
        !            45: =head1 Subroutines
        !            46: 
        !            47: =over 4
        !            48: 
        !            49: =cut
        !            50: 
        !            51: #############################################
        !            52: #############################################
        !            53: 
        !            54: package LONCAPA::lonauthcgi;
        !            55: 
        !            56: use strict;
        !            57: use lib '/home/httpd/lib/perl';
        !            58: use Apache::lonnet;
        !            59: use Apache::lonlocal;
        !            60: use LONCAPA;
        !            61: 
        !            62: #############################################
        !            63: #############################################
        !            64: 
        !            65: =pod
        !            66: 
        !            67: =item check_ipbased_access()
        !            68: 
        !            69: Inputs: $page, the identifier of the page to be viewed,
        !            70:         can be one of the keys in the hash from &serverstatus_titles()
        !            71: 
        !            72:         $ip, the IP address of the client requesting the page.
        !            73: 
        !            74: Returns: 1 if access is permitted for the requestor's IP.
        !            75:          Access is allowed if on of the following is true:
        !            76:          (a) the requestor IP is the loopback address
        !            77:          (b) Domain configurations for domains hosted on this server include
        !            78:              the requestor's IP as one of the specified IPs with access
        !            79:              to this page. (does not apply to 'ping' page type)
        !            80: 
        !            81: =cut
        !            82: 
        !            83: #############################################
        !            84: #############################################
        !            85: sub check_ipbased_access {
        !            86:     my ($page,$ip) = @_;
        !            87:     my $allowed;
        !            88:     if (!defined($ip)) {
        !            89:         $ip = $ENV{'REMOTE_ADDR'};
        !            90:     }
        !            91:     if (($page ne 'lonstatus') && ($page ne 'serverstatus')) {
        !            92:         if ($ip eq '127.0.0.1') {
        !            93:             $allowed = 1;
        !            94:             return $allowed;
        !            95:         }
        !            96:     }
        !            97:     if ($page ne 'ping') {
        !            98:         my @poss_domains = &Apache::lonnet::current_machine_domains();
        !            99:         foreach my $dom (@poss_domains) {
        !           100:             my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],$dom);
        !           101:             if (ref($domconfig{'serverstatuses'}) eq 'HASH') {
        !           102:                 if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
        !           103:                     if ($domconfig{'serverstatuses'}{$page}{'machines'} ne '') {
        !           104:                         my @okmachines = split(/,/,$domconfig{'serverstatuses'}{$page}{'machines'});
        !           105:                         if (grep(/^\Q$ip\E$/,@okmachines)) {
        !           106:                             $allowed = 1;
        !           107:                             last;
        !           108:                         }
        !           109:                     }
        !           110:                 }
        !           111:             }
        !           112:         }
        !           113:         }
        !           114:     }
        !           115:     return $allowed;
        !           116: }
        !           117: 
        !           118: #############################################
        !           119: #############################################
        !           120: 
        !           121: =pod
        !           122: 
        !           123: =item can_view()
        !           124: 
        !           125: Inputs: $page, the identifier of the page to be viewed,
        !           126:         can be one of the keys in the hash from &serverstatus_titles()
        !           127: 
        !           128: Returns: 1 if access to the page is permitted.
        !           129:          Access allowed if one of the following is true:
        !           130:          (a) Requestor has LON-CAPA superuser role
        !           131:          (b) Requestor's role is Domain Coordinator in one of the domains
        !           132:              hosted on this server
        !           133:          (c) Domain configurations for domains hosted on this server include
        !           134:              the requestor as one of the named users (username:domain) with access
        !           135:              to the page.
        !           136: 
        !           137:          In the case of requests for the 'ping' page, and access is also allowed if
        !           138:          at least one domain hosted on requestor's server is also hosted on this server.
        !           139: 
        !           140: =cut
        !           141: 
        !           142: #############################################
        !           143: #############################################
        !           144: sub can_view {
        !           145:     my ($page) = @_;
        !           146:     my $allowed;
        !           147:     if ($Apache::lonnet::env{'request.role'} =~ m{^su\./}) {
        !           148:         $allowed = 1;
        !           149:     } elsif ($page eq 'ping') {
        !           150:         my @poss_domains = &Apache::lonnet::current_machine_domains();
        !           151:         my @hostids= &Apache::lonnet::get_hosts_from_ip($ENV{'REMOTE_ADDR'});
        !           152:         foreach my $hostid (@hostids) {
        !           153:             my $hostdom = &Apache::lonnet::host_domain($hostid);
        !           154:             if (grep(/^\Q$hostdom\E$/,@poss_domains)) {
        !           155:                 $allowed = 1;
        !           156:                 last;
        !           157:             }
        !           158:         }
        !           159:     } else {
        !           160:         my @poss_domains = &Apache::lonnet::current_machine_domains();
        !           161:         foreach my $dom (@poss_domains) {
        !           162:             my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],$dom);
        !           163:             if ($Apache::lonnet::env{'request.role'} eq "dc./$dom/") {
        !           164:                 $allowed = 1;
        !           165:             } elsif (ref($domconfig{'serverstatuses'}) eq 'HASH') {
        !           166:                 if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
        !           167:                     if ($domconfig{'serverstatuses'}{$page}{'namedusers'} ne '') {
        !           168:                         my @okusers = split(/,/,$domconfig{'serverstatuses'}{$page}{'namedusers'});
        !           169:                         if (grep(/^\Q$Apache::lonnet::env{'user.name'}:$Apache::lonnet::env{'user.domain'}\E$/,@okusers)) {
        !           170:                             $allowed = 1;
        !           171:                         }
        !           172:                     }
        !           173:                 }
        !           174:             }
        !           175:             last if $allowed;
        !           176:         }
        !           177:     }
        !           178:     return $allowed;
        !           179: }
        !           180: 
        !           181: #############################################
        !           182: #############################################
        !           183: 
        !           184: =pod
        !           185: 
        !           186: =unauthorized_msg()
        !           187: 
        !           188: Inputs: $page, the identifier of the page to be viewed,
        !           189:         can be one of the keys in the hash from &serverstatus_titles()
        !           190: 
        !           191: Returns: A string explaining why access was denied for the particular page.
        !           192: 
        !           193: =cut
        !           194: 
        !           195: #############################################
        !           196: #############################################
        !           197: sub unauthorized_msg {
        !           198:     my ($page) = @_;
        !           199:     my $titles = &serverstatus_titles();
        !           200:     if ($page eq 'clusterstatus') {
        !           201:         return &mt('Your current role does not permit you to view the requested server status page: [_1]',$titles->{$page});
        !           202:     }
        !           203:     my @poss_domains = &Apache::lonnet::current_machine_domains();
        !           204:     if (@poss_domains == 1) {
        !           205:         my $domdesc = &Apache::lonnet::domain($poss_domains[0]);
        !           206:         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});
        !           207:     } elsif (@poss_domains > 1) {
        !           208:         my $output = &mt('Configurations for the domains housed on this server: ').'<ul>';
        !           209:         foreach my $dom (@poss_domains) {
        !           210:             my $domdesc = &Apache::lonnet::domain($dom);
        !           211:             $output .= '<li>'.&Apache::lonnet::domain($dom).'('.$dom.')</li>';
        !           212:         }
        !           213:         $output .= '</ul>'.&mt('do not permit you to view the requested server status page: [_1]',$titles->{$page});
        !           214:         return $output;
        !           215:     } else {
        !           216:         return &mt('No domain information exists for this server');
        !           217:     }
        !           218: }
        !           219: 
        !           220: #############################################
        !           221: #############################################
        !           222: 
        !           223: =pod
        !           224: 
        !           225: =item serverstatus_titles()
        !           226: 
        !           227: Inputs: none
        !           228: 
        !           229: Returns: a reference to a hash of pages, where in the hash
        !           230:          keys are names of pages which employ loncgi.pm
        !           231:          or lonstatusacc.pm for access control,
        !           232:          and corresponding values are descriptions of each page
        !           233: 
        !           234: =cut
        !           235: 
        !           236: #############################################
        !           237: #############################################
        !           238: sub serverstatus_titles {
        !           239:     my %titles = &Apache::lonlocal::texthash (
        !           240:                    'userstatus'        => 'User Status Summary',
        !           241:                    'lonstatus'         => 'Display Detailed Report',
        !           242:                    'loncron'           => 'Generate Detailed Report',
        !           243:                    'server-status'     => 'Apache Status Page',
        !           244:                    'codeversions'      => 'LON-CAPA Module Versions',
        !           245:                    'clusterstatus'     => 'Domain status',
        !           246:                    'metadata_keywords' => 'Display Metadata Keywords',
        !           247:                    'metadata_harvest'  => 'Harvest Metadata Searches',
        !           248:                    'takeoffline'       => 'Offline - replace Log-in page',
        !           249:                    'takeonline'        => 'Online - restore Log-in page',
        !           250:                    'showenv'           => "Show user environment",
        !           251:                  );
        !           252:     return \%titles;
        !           253: }
        !           254: 
        !           255: 
        !           256: 1;
        !           257: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>