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

1.1       raeburn     1: #
                      2: # LON-CAPA authorization for cgi-bin scripts
                      3: #
1.7     ! raeburn     4: # $Id: lonauthcgi.pm,v 1.6 2010/04/14 18:06:22 raeburn Exp $
1.1       raeburn     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';
1.7     ! raeburn    58: use Socket;
1.1       raeburn    59: use Apache::lonnet;
                     60: use Apache::lonlocal;
                     61: use LONCAPA;
1.7     ! raeburn    62: use LONCAPA::Configuration();
1.1       raeburn    63: 
                     64: #############################################
                     65: #############################################
                     66: 
                     67: =pod
                     68: 
                     69: =item check_ipbased_access()
                     70: 
                     71: Inputs: $page, the identifier of the page to be viewed,
                     72:         can be one of the keys in the hash from &serverstatus_titles()
                     73: 
                     74:         $ip, the IP address of the client requesting the page.
                     75: 
                     76: Returns: 1 if access is permitted for the requestor's IP.
                     77:          Access is allowed if on of the following is true:
                     78:          (a) the requestor IP is the loopback address
                     79:          (b) Domain configurations for domains hosted on this server include
                     80:              the requestor's IP as one of the specified IPs with access
                     81:              to this page. (does not apply to 'ping' page type)
                     82: 
                     83: =cut
                     84: 
                     85: #############################################
                     86: #############################################
                     87: sub check_ipbased_access {
                     88:     my ($page,$ip) = @_;
                     89:     my $allowed;
                     90:     if (!defined($ip)) {
                     91:         $ip = $ENV{'REMOTE_ADDR'};
                     92:     }
                     93:     if (($page ne 'lonstatus') && ($page ne 'serverstatus')) {
                     94:         if ($ip eq '127.0.0.1') {
                     95:             $allowed = 1;
                     96:             return $allowed;
                     97:         }
                     98:     }
1.7     ! raeburn    99:     if (&is_manager_ip($ip)) {
        !           100:         $allowed = 1;
        !           101:         return $allowed;
        !           102:     }
1.1       raeburn   103:     if ($page ne 'ping') {
                    104:         my @poss_domains = &Apache::lonnet::current_machine_domains();
                    105:         foreach my $dom (@poss_domains) {
                    106:             my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],$dom);
                    107:             if (ref($domconfig{'serverstatuses'}) eq 'HASH') {
                    108:                 if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
                    109:                     if ($domconfig{'serverstatuses'}{$page}{'machines'} ne '') {
                    110:                         my @okmachines = split(/,/,$domconfig{'serverstatuses'}{$page}{'machines'});
                    111:                         if (grep(/^\Q$ip\E$/,@okmachines)) {
                    112:                             $allowed = 1;
                    113:                             last;
                    114:                         }
                    115:                     }
                    116:                 }
                    117:             }
                    118:         }
                    119:     }
                    120:     return $allowed;
                    121: }
                    122: 
                    123: #############################################
                    124: #############################################
                    125: 
1.7     ! raeburn   126: sub is_manager_ip {
        !           127:     my ($remote_ip) = @_;
        !           128:     return if ($remote_ip eq '');
        !           129:     my ($directory,$is_manager);
        !           130:     my $config=LONCAPA::Configuration::read_conf();
        !           131:     if (ref($config) eq 'HASH') {
        !           132:         $directory = $config->{'lonTabDir'};
        !           133:     }
        !           134:     if (defined($directory)) {
        !           135:         if (open(MANAGERS, "$directory/managers.tab")) {
        !           136:             while(my $host = <MANAGERS>) {
        !           137:                 chomp($host);
        !           138:                 next if ($host =~ /^\#/);
        !           139:                 my $ip = &Apache::lonnet::get_host_ip($host);
        !           140:                 if (defined($ip)) {
        !           141:                     if ($remote_ip eq $ip) {
        !           142:                         $is_manager = 1;
        !           143:                         last;
        !           144:                     }
        !           145:                 } else {
        !           146:                     my ($cluname,$dnsname) = split(/:/, $host);
        !           147:                     $ip = gethostbyname($dnsname);
        !           148:                     if (defined($ip)) {
        !           149:                         my $hostip = inet_ntoa($ip);
        !           150:                         if ($hostip = $remote_ip) {
        !           151:                             $is_manager = 1;
        !           152:                         }
        !           153:                     }
        !           154:                 }
        !           155:             }
        !           156:             close(MANAGERS);
        !           157:         }
        !           158:     }
        !           159:     return $is_manager;
        !           160: }
        !           161: 
        !           162: #############################################
        !           163: #############################################
        !           164: 
1.1       raeburn   165: =pod
                    166: 
                    167: =item can_view()
                    168: 
                    169: Inputs: $page, the identifier of the page to be viewed,
                    170:         can be one of the keys in the hash from &serverstatus_titles()
                    171: 
                    172: Returns: 1 if access to the page is permitted.
                    173:          Access allowed if one of the following is true:
                    174:          (a) Requestor has LON-CAPA superuser role
                    175:          (b) Requestor's role is Domain Coordinator in one of the domains
                    176:              hosted on this server
                    177:          (c) Domain configurations for domains hosted on this server include
                    178:              the requestor as one of the named users (username:domain) with access
                    179:              to the page.
                    180: 
1.3       raeburn   181:          In the case of requests for the 'ping' page, access is also allowed if
1.1       raeburn   182:          at least one domain hosted on requestor's server is also hosted on this server.
                    183: 
1.3       raeburn   184:          In the case of requests for the 'showenv' page (/adm/test), the domains tested
                    185:          are not the domains hosted on the server, but instead are a single domain - 
                    186:          the domain of the requestor.  In addition, if the requestor has an active 
                    187:          Domain Coordinator role for that domain, access is permitted, regardless of  
                    188:          the requestor's current role.
1.1       raeburn   189: =cut
                    190: 
                    191: #############################################
                    192: #############################################
                    193: sub can_view {
                    194:     my ($page) = @_;
                    195:     my $allowed;
                    196:     if ($Apache::lonnet::env{'request.role'} =~ m{^su\./}) {
                    197:         $allowed = 1;
                    198:     } elsif ($page eq 'ping') {
                    199:         my @poss_domains = &Apache::lonnet::current_machine_domains();
                    200:         my @hostids= &Apache::lonnet::get_hosts_from_ip($ENV{'REMOTE_ADDR'});
                    201:         foreach my $hostid (@hostids) {
                    202:             my $hostdom = &Apache::lonnet::host_domain($hostid);
                    203:             if (grep(/^\Q$hostdom\E$/,@poss_domains)) {
                    204:                 $allowed = 1;
                    205:                 last;
                    206:             }
                    207:         }
                    208:     } else {
1.3       raeburn   209:         my @poss_domains;
                    210:         if ($page eq 'showenv') {
                    211:             @poss_domains = ($env{'user.domain'});
                    212:             my $envkey = 'user.role.dc./'.$poss_domains[0].'/';
                    213:             if (exists($Apache::lonnet::env{$envkey})) {
                    214:                 my $livedc = 1;
                    215:                 my $then = $Apache::lonnet::env{'user.login.time'};
                    216:                 my ($tstart,$tend)=split(/\./,$Apache::lonnet::env{$envkey});
                    217:                 if ($tstart && $tstart>$then) { $livedc = 0; }
                    218:                 if ($tend   && $tend  <$then) { $livedc = 0; }
                    219:                 if ($livedc) {
                    220:                     $allowed = 1;
                    221:                 }
                    222:             }
                    223:         } else {
                    224:             @poss_domains = &Apache::lonnet::current_machine_domains();
                    225:         }
                    226:         unless ($allowed) {
                    227:             foreach my $dom (@poss_domains) {
                    228:                 my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],
                    229:                                                          $dom);
                    230:                 if ($Apache::lonnet::env{'request.role'} eq "dc./$dom/") {
                    231:                     $allowed = 1;
                    232:                 } elsif (ref($domconfig{'serverstatuses'}) eq 'HASH') {
                    233:                     if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
                    234:                         if ($domconfig{'serverstatuses'}{$page}{'namedusers'} ne '') {
                    235:                             my @okusers = split(/,/,$domconfig{'serverstatuses'}{$page}{'namedusers'});
                    236:                             if (grep(/^\Q$Apache::lonnet::env{'user.name'}:$Apache::lonnet::env{'user.domain'}\E$/,@okusers)) {
                    237:                                 $allowed = 1;
                    238:                             }
1.1       raeburn   239:                         }
                    240:                     }
                    241:                 }
1.4       raeburn   242:                 last if $allowed;
1.1       raeburn   243:             }
                    244:         }
                    245:     }
                    246:     return $allowed;
                    247: }
                    248: 
                    249: #############################################
                    250: #############################################
                    251: 
                    252: =pod
                    253: 
                    254: =unauthorized_msg()
                    255: 
                    256: Inputs: $page, the identifier of the page to be viewed,
                    257:         can be one of the keys in the hash from &serverstatus_titles()
                    258: 
                    259: Returns: A string explaining why access was denied for the particular page.
                    260: 
                    261: =cut
                    262: 
                    263: #############################################
                    264: #############################################
                    265: sub unauthorized_msg {
                    266:     my ($page) = @_;
                    267:     my $titles = &serverstatus_titles();
                    268:     if ($page eq 'clusterstatus') {
                    269:         return &mt('Your current role does not permit you to view the requested server status page: [_1]',$titles->{$page});
                    270:     }
                    271:     my @poss_domains = &Apache::lonnet::current_machine_domains();
                    272:     if (@poss_domains == 1) {
                    273:         my $domdesc = &Apache::lonnet::domain($poss_domains[0]);
                    274:         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});
                    275:     } elsif (@poss_domains > 1) {
                    276:         my $output = &mt('Configurations for the domains housed on this server: ').'<ul>';
                    277:         foreach my $dom (@poss_domains) {
                    278:             my $domdesc = &Apache::lonnet::domain($dom);
                    279:             $output .= '<li>'.&Apache::lonnet::domain($dom).'('.$dom.')</li>';
                    280:         }
                    281:         $output .= '</ul>'.&mt('do not permit you to view the requested server status page: [_1]',$titles->{$page});
                    282:         return $output;
                    283:     } else {
                    284:         return &mt('No domain information exists for this server');
                    285:     }
                    286: }
                    287: 
                    288: #############################################
                    289: #############################################
                    290: 
                    291: =pod
                    292: 
                    293: =item serverstatus_titles()
                    294: 
                    295: Inputs: none
                    296: 
                    297: Returns: a reference to a hash of pages, where in the hash
                    298:          keys are names of pages which employ loncgi.pm
                    299:          or lonstatusacc.pm for access control,
                    300:          and corresponding values are descriptions of each page
                    301: 
                    302: =cut
                    303: 
                    304: #############################################
                    305: #############################################
                    306: sub serverstatus_titles {
                    307:     my %titles = &Apache::lonlocal::texthash (
                    308:                    'userstatus'        => 'User Status Summary',
                    309:                    'lonstatus'         => 'Display Detailed Report',
                    310:                    'loncron'           => 'Generate Detailed Report',
                    311:                    'server-status'     => 'Apache Status Page',
                    312:                    'codeversions'      => 'LON-CAPA Module Versions',
                    313:                    'clusterstatus'     => 'Domain status',
                    314:                    'metadata_keywords' => 'Display Metadata Keywords',
                    315:                    'metadata_harvest'  => 'Harvest Metadata Searches',
                    316:                    'takeoffline'       => 'Offline - replace Log-in page',
                    317:                    'takeonline'        => 'Online - restore Log-in page',
1.6       raeburn   318:                    'showenv'           => 'Show user environment',
                    319:                    'toggledebug'       => 'Toggle debug messages',
1.1       raeburn   320:                  );
                    321:     return \%titles;
                    322: }
                    323: 
                    324: 
                    325: 1;
                    326: 

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