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

1.1       raeburn     1: #
                      2: # LON-CAPA authorization for cgi-bin scripts
                      3: #
1.14.2.1! raeburn     4: # $Id: lonauthcgi.pm,v 1.14 2015/05/04 15:43:57 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: 
1.8       raeburn    35: lonauthcgi
1.1       raeburn    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;
                     62: 
                     63: #############################################
                     64: #############################################
                     65: 
                     66: =pod
                     67: 
                     68: =item check_ipbased_access()
                     69: 
                     70: Inputs: $page, the identifier of the page to be viewed,
                     71:         can be one of the keys in the hash from &serverstatus_titles()
                     72: 
                     73:         $ip, the IP address of the client requesting the page.
                     74: 
                     75: Returns: 1 if access is permitted for the requestor's IP.
1.8       raeburn    76:          Access is allowed if one of the following is true:
                     77:          (a) the requestor IP is the loopback address.
                     78:          (b) the requestor IP is the IP of the current server.
                     79:          (c) the requestor IP is the IP of a manager,
                     80:              if the page to view is not "takeoffline" or "toggledebug" 
                     81:          (d) the requestor IP is the IP of a server belonging 
                     82:              to a domain included in domains hosted on this server.
                     83:          (e) Domain configurations for domains hosted on this server include
1.1       raeburn    84:              the requestor's IP as one of the specified IPs with access
1.8       raeburn    85:              to this page. (not applicable to 'ping' page).
1.1       raeburn    86: 
                     87: =cut
                     88: 
                     89: #############################################
                     90: #############################################
                     91: sub check_ipbased_access {
                     92:     my ($page,$ip) = @_;
                     93:     my $allowed;
                     94:     if (!defined($ip)) {
                     95:         $ip = $ENV{'REMOTE_ADDR'};
                     96:     }
1.8       raeburn    97:     if ($ip eq '127.0.0.1') {
                     98:         $allowed = 1;
                     99:         return $allowed;
                    100:     } else {
                    101:         my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                    102:         my $host_ip = &Apache::lonnet::get_host_ip($lonhost);
                    103:         if (($host_ip ne '') && ($host_ip eq $ip)) {
1.1       raeburn   104:             $allowed = 1;
                    105:             return $allowed;
                    106:         }
                    107:     }
1.7       raeburn   108:     if (&is_manager_ip($ip)) {
1.8       raeburn   109:         unless (($page eq 'toggledebug') || ($page eq 'takeoffline')) {
                    110:             $allowed = 1;
                    111:             return $allowed;
                    112:         }
                    113:     }
                    114:     if (&check_domain_ip($ip)) {
1.7       raeburn   115:         $allowed = 1;
                    116:         return $allowed;
                    117:     }
1.1       raeburn   118:     if ($page ne 'ping') {
                    119:         my @poss_domains = &Apache::lonnet::current_machine_domains();
                    120:         foreach my $dom (@poss_domains) {
                    121:             my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],$dom);
                    122:             if (ref($domconfig{'serverstatuses'}) eq 'HASH') {
                    123:                 if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
                    124:                     if ($domconfig{'serverstatuses'}{$page}{'machines'} ne '') {
                    125:                         my @okmachines = split(/,/,$domconfig{'serverstatuses'}{$page}{'machines'});
                    126:                         if (grep(/^\Q$ip\E$/,@okmachines)) {
                    127:                             $allowed = 1;
                    128:                             last;
                    129:                         }
                    130:                     }
                    131:                 }
                    132:             }
                    133:         }
                    134:     }
                    135:     return $allowed;
                    136: }
                    137: 
                    138: #############################################
                    139: #############################################
                    140: 
1.8       raeburn   141: =pod
                    142: 
                    143: =item is_manager_ip()
                    144: 
                    145: Inputs: $remote_ip, the IP address of the client requesting the page.
                    146: 
                    147: Returns: 1 if the client IP address corresponds to that of a 
                    148:          machine listed in /home/httpd/lonTabs/managers.tab
                    149: 
                    150: =cut
                    151: 
                    152: #############################################
                    153: #############################################
1.7       raeburn   154: sub is_manager_ip {
                    155:     my ($remote_ip) = @_;
                    156:     return if ($remote_ip eq '');
                    157:     my ($directory,$is_manager);
1.8       raeburn   158:     foreach my $key (keys(%Apache::lonnet::managerstab)) {
                    159:         my $manager_ip;
                    160:         if ($key =~ /:/) {
                    161:             my ($cluname,$dnsname) = split(/:/,$key);
                    162:             my $ip = gethostbyname($dnsname);
                    163:             if (defined($ip)) {
                    164:                 $manager_ip = inet_ntoa($ip);
                    165:             }
                    166:         } else {
                    167:             $manager_ip = &Apache::lonnet::get_host_ip($key);
                    168:         }
                    169:         if (defined($manager_ip)) {
                    170:             if ($remote_ip eq $manager_ip) {
                    171:                 $is_manager = 1;
                    172:                 last;
                    173:             }
                    174:         }
1.7       raeburn   175:     }
1.8       raeburn   176:     return $is_manager;
                    177: }
                    178: 
                    179: #############################################
                    180: #############################################
                    181: 
                    182: =pod
                    183: 
                    184: =item check_domain_ip()
                    185: 
                    186: Inputs: $remote_ip, the IP address of the client requesting the page.
                    187: 
                    188: Returns: 1 if the client IP address is for a machine in the cluster
                    189:          and domain in common for client machine and this machine.
                    190: 
                    191: =cut
                    192: 
                    193: #############################################
                    194: #############################################
                    195: sub check_domain_ip {
                    196:     my ($remote_ip) = @_;
                    197:     my %remote_doms;
                    198:     my $allowed;
                    199:     if ($remote_ip ne '') {
1.14.2.1! raeburn   200:         my @remote_hosts = &Apache::lonnet::get_hosts_from_ip($remote_ip);
        !           201:         if (@remote_hosts) {
1.8       raeburn   202:             my @poss_domains = &Apache::lonnet::current_machine_domains();
                    203:             if (@poss_domains > 0) {
                    204:                 foreach my $hostid (@remote_hosts) {
                    205:                     my $hostdom = &Apache::lonnet::host_domain($hostid);
                    206:                     if ($hostdom ne '') {
                    207:                         if (grep(/^\Q$hostdom\E$/,@poss_domains)) {
                    208:                             $allowed = 1;
                    209:                             last;
1.7       raeburn   210:                         }
                    211:                     }
                    212:                 }
                    213:             }
                    214:         }
                    215:     }
1.8       raeburn   216:     return $allowed;
1.7       raeburn   217: }
                    218: 
                    219: #############################################
                    220: #############################################
                    221: 
1.1       raeburn   222: =pod
                    223: 
                    224: =item can_view()
                    225: 
                    226: Inputs: $page, the identifier of the page to be viewed,
                    227:         can be one of the keys in the hash from &serverstatus_titles()
1.9       raeburn   228:         $domain (optional), a specific domain for which the page is needed.  
1.1       raeburn   229: 
1.9       raeburn   230: Returns: 1 if access to the page is permitted, or &-separated list of domains
                    231:          for which access is allowed, if $page is domconf, and not superuser.
1.1       raeburn   232:          Access allowed if one of the following is true:
                    233:          (a) Requestor has LON-CAPA superuser role
1.9       raeburn   234:          (b) Requestor's role is Domain Coordinator in requested domain 
                    235:              (if specified) or (if unspecified) in one of the domains
1.1       raeburn   236:              hosted on this server
1.9       raeburn   237:          (c) The domain configuration for the particular domain (if specified),
                    238:              or domain configurations for domains hosted on this server (if 
                    239:              specific domain not specified), include the requestor as one of
                    240:              the named users (username:domain) with access to the page.
1.1       raeburn   241: 
1.3       raeburn   242:          In the case of requests for the 'showenv' page (/adm/test), the domains tested
                    243:          are not the domains hosted on the server, but instead are a single domain - 
                    244:          the domain of the requestor.  In addition, if the requestor has an active 
                    245:          Domain Coordinator role for that domain, access is permitted, regardless of  
                    246:          the requestor's current role.
1.8       raeburn   247: 
1.1       raeburn   248: =cut
                    249: 
                    250: #############################################
                    251: #############################################
                    252: sub can_view {
1.9       raeburn   253:     my ($page,$domain) = @_;
1.1       raeburn   254:     my $allowed;
                    255:     if ($Apache::lonnet::env{'request.role'} =~ m{^su\./}) {
                    256:         $allowed = 1;
                    257:     } else {
1.3       raeburn   258:         my @poss_domains;
                    259:         if ($page eq 'showenv') {
                    260:             @poss_domains = ($env{'user.domain'});
                    261:             my $envkey = 'user.role.dc./'.$poss_domains[0].'/';
                    262:             if (exists($Apache::lonnet::env{$envkey})) {
                    263:                 my $livedc = 1;
                    264:                 my $then = $Apache::lonnet::env{'user.login.time'};
                    265:                 my ($tstart,$tend)=split(/\./,$Apache::lonnet::env{$envkey});
                    266:                 if ($tstart && $tstart>$then) { $livedc = 0; }
                    267:                 if ($tend   && $tend  <$then) { $livedc = 0; }
                    268:                 if ($livedc) {
                    269:                     $allowed = 1;
                    270:                 }
                    271:             }
                    272:         } else {
                    273:             @poss_domains = &Apache::lonnet::current_machine_domains();
1.9       raeburn   274:             if ($domain ne '') {
                    275:                 if (grep(/^\Q$domain\E$/,@poss_domains)) {
                    276:                     @poss_domains = ($domain);
                    277:                 } else {
                    278:                     undef(@poss_domains); 
                    279:                 }
                    280:             }
1.3       raeburn   281:         }
                    282:         unless ($allowed) {
1.11      raeburn   283:             my %alloweddoms;   
1.3       raeburn   284:             foreach my $dom (@poss_domains) {
                    285:                 my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],
                    286:                                                          $dom);
                    287:                 if ($Apache::lonnet::env{'request.role'} eq "dc./$dom/") {
1.9       raeburn   288:                     if ($page eq 'domconf') {
1.11      raeburn   289:                         $alloweddoms{$dom} = 1;
1.9       raeburn   290:                     } else {
                    291:                         $allowed = 1; 
                    292:                     }
1.3       raeburn   293:                 } elsif (ref($domconfig{'serverstatuses'}) eq 'HASH') {
                    294:                     if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
                    295:                         if ($domconfig{'serverstatuses'}{$page}{'namedusers'} ne '') {
                    296:                             my @okusers = split(/,/,$domconfig{'serverstatuses'}{$page}{'namedusers'});
                    297:                             if (grep(/^\Q$Apache::lonnet::env{'user.name'}:$Apache::lonnet::env{'user.domain'}\E$/,@okusers)) {
1.9       raeburn   298:                                 if ($page eq 'domconf') {
1.11      raeburn   299:                                     $alloweddoms{$dom} = 1;
1.9       raeburn   300:                                 } else {
                    301:                                     $allowed = 1;
                    302:                                 }
                    303:                             }
                    304:                             unless ($page eq 'domconf') {
                    305:                                 last if ($allowed);
1.3       raeburn   306:                             }
1.1       raeburn   307:                         }
                    308:                     }
                    309:                 }
                    310:             }
1.11      raeburn   311:             if (($page eq 'domconf') && (!$allowed))  {
                    312:                 $allowed = join('&',sort(keys(%alloweddoms)));
                    313:             }
1.1       raeburn   314:         }
                    315:     }
                    316:     return $allowed;
                    317: }
                    318: 
                    319: #############################################
                    320: #############################################
                    321: 
                    322: =pod
                    323: 
1.8       raeburn   324: =item unauthorized_msg()
1.1       raeburn   325: 
                    326: Inputs: $page, the identifier of the page to be viewed,
                    327:         can be one of the keys in the hash from &serverstatus_titles()
                    328: 
                    329: Returns: A string explaining why access was denied for the particular page.
                    330: 
                    331: =cut
                    332: 
                    333: #############################################
                    334: #############################################
                    335: sub unauthorized_msg {
                    336:     my ($page) = @_;
                    337:     my $titles = &serverstatus_titles();
                    338:     if ($page eq 'clusterstatus') {
                    339:         return &mt('Your current role does not permit you to view the requested server status page: [_1]',$titles->{$page});
                    340:     }
                    341:     my @poss_domains = &Apache::lonnet::current_machine_domains();
                    342:     if (@poss_domains == 1) {
                    343:         my $domdesc = &Apache::lonnet::domain($poss_domains[0]);
                    344:         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});
                    345:     } elsif (@poss_domains > 1) {
                    346:         my $output = &mt('Configurations for the domains housed on this server: ').'<ul>';
                    347:         foreach my $dom (@poss_domains) {
                    348:             my $domdesc = &Apache::lonnet::domain($dom);
                    349:             $output .= '<li>'.&Apache::lonnet::domain($dom).'('.$dom.')</li>';
                    350:         }
                    351:         $output .= '</ul>'.&mt('do not permit you to view the requested server status page: [_1]',$titles->{$page});
                    352:         return $output;
                    353:     } else {
                    354:         return &mt('No domain information exists for this server');
                    355:     }
                    356: }
                    357: 
                    358: #############################################
                    359: #############################################
                    360: 
                    361: =pod
                    362: 
                    363: =item serverstatus_titles()
                    364: 
                    365: Inputs: none
                    366: 
                    367: Returns: a reference to a hash of pages, where in the hash
                    368:          keys are names of pages which employ loncgi.pm
                    369:          or lonstatusacc.pm for access control,
                    370:          and corresponding values are descriptions of each page
                    371: 
                    372: =cut
                    373: 
                    374: #############################################
                    375: #############################################
                    376: sub serverstatus_titles {
                    377:     my %titles = &Apache::lonlocal::texthash (
                    378:                    'userstatus'        => 'User Status Summary',
                    379:                    'lonstatus'         => 'Display Detailed Report',
                    380:                    'loncron'           => 'Generate Detailed Report',
                    381:                    'server-status'     => 'Apache Status Page',
                    382:                    'codeversions'      => 'LON-CAPA Module Versions',
1.10      raeburn   383:                    'checksums'         => 'LON-CAPA Module Checking',
1.13      raeburn   384:                    'diskusage'         => 'Course/Community Disk Usage',
1.1       raeburn   385:                    'clusterstatus'     => 'Domain status',
                    386:                    'metadata_keywords' => 'Display Metadata Keywords',
                    387:                    'metadata_harvest'  => 'Harvest Metadata Searches',
                    388:                    'takeoffline'       => 'Offline - replace Log-in page',
                    389:                    'takeonline'        => 'Online - restore Log-in page',
1.6       raeburn   390:                    'showenv'           => 'Show user environment',
                    391:                    'toggledebug'       => 'Toggle debug messages',
1.9       raeburn   392:                    'ping'              => 'Cause server to ping another server',   
                    393:                    'domconf'           => 'Text Display of Domain Configuration',
1.12      raeburn   394:                    'uniquecodes'       => 'Six-character Course Codes',
1.14      raeburn   395:                    'coursecatalog'     => 'Course/Community Catalog with enrollment data',
1.1       raeburn   396:                  );
                    397:     return \%titles;
                    398: }
                    399: 
1.8       raeburn   400: =pod
                    401: 
                    402: =back
                    403: 
                    404: =cut
1.1       raeburn   405: 
                    406: 1;

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