Return to lonauthcgi.pm CVS log

Up to [LON-CAPA] / loncom / cgi

- Display of Course/Community Catalog with enrollment data added to "server
  status" pages for which access can be IP-based or available to specified
  authenticated users (DC role not required).

    1: #
    2: # LON-CAPA authorization for cgi-bin scripts
    3: #
    4: # $Id: lonauthcgi.pm,v 1.14 2015/05/04 15:43:57 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: lonauthcgi
   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 Socket;
   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.
   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
   84:              the requestor's IP as one of the specified IPs with access
   85:              to this page. (not applicable to 'ping' page).
   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:     }
   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)) {
  104:             $allowed = 1;
  105:             return $allowed;
  106:         }
  107:     }
  108:     if (&is_manager_ip($ip)) {
  109:         unless (($page eq 'toggledebug') || ($page eq 'takeoffline')) {
  110:             $allowed = 1;
  111:             return $allowed;
  112:         }
  113:     }
  114:     if (&check_domain_ip($ip)) {
  115:         $allowed = 1;
  116:         return $allowed;
  117:     }
  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: 
  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: #############################################
  154: sub is_manager_ip {
  155:     my ($remote_ip) = @_;
  156:     return if ($remote_ip eq '');
  157:     my ($directory,$is_manager);
  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:         }
  175:     }
  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 '') {
  200:         if (&Apache::lonnet::hostname($remote_ip) ne '') {
  201:             my @poss_domains = &Apache::lonnet::current_machine_domains();
  202:             if (@poss_domains > 0) {
  203:                 my @remote_hosts = &Apache::lonnet::get_hosts_from_ip($remote_ip);
  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;
  210:                         }
  211:                     }
  212:                 }
  213:             }
  214:         }
  215:     }
  216:     return $allowed;
  217: }
  218: 
  219: #############################################
  220: #############################################
  221: 
  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()
  228:         $domain (optional), a specific domain for which the page is needed.  
  229: 
  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.
  232:          Access allowed if one of the following is true:
  233:          (a) Requestor has LON-CAPA superuser role
  234:          (b) Requestor's role is Domain Coordinator in requested domain 
  235:              (if specified) or (if unspecified) in one of the domains
  236:              hosted on this server
  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.
  241: 
  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.
  247: 
  248: =cut
  249: 
  250: #############################################
  251: #############################################
  252: sub can_view {
  253:     my ($page,$domain) = @_;
  254:     my $allowed;
  255:     if ($Apache::lonnet::env{'request.role'} =~ m{^su\./}) {
  256:         $allowed = 1;
  257:     } else {
  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();
  274:             if ($domain ne '') {
  275:                 if (grep(/^\Q$domain\E$/,@poss_domains)) {
  276:                     @poss_domains = ($domain);
  277:                 } else {
  278:                     undef(@poss_domains); 
  279:                 }
  280:             }
  281:         }
  282:         unless ($allowed) {
  283:             my %alloweddoms;   
  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/") {
  288:                     if ($page eq 'domconf') {
  289:                         $alloweddoms{$dom} = 1;
  290:                     } else {
  291:                         $allowed = 1; 
  292:                     }
  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)) {
  298:                                 if ($page eq 'domconf') {
  299:                                     $alloweddoms{$dom} = 1;
  300:                                 } else {
  301:                                     $allowed = 1;
  302:                                 }
  303:                             }
  304:                             unless ($page eq 'domconf') {
  305:                                 last if ($allowed);
  306:                             }
  307:                         }
  308:                     }
  309:                 }
  310:             }
  311:             if (($page eq 'domconf') && (!$allowed))  {
  312:                 $allowed = join('&',sort(keys(%alloweddoms)));
  313:             }
  314:         }
  315:     }
  316:     return $allowed;
  317: }
  318: 
  319: #############################################
  320: #############################################
  321: 
  322: =pod
  323: 
  324: =item unauthorized_msg()
  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',
  383:                    'checksums'         => 'LON-CAPA Module Checking',
  384:                    'diskusage'         => 'Course/Community Disk Usage',
  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',
  390:                    'showenv'           => 'Show user environment',
  391:                    'toggledebug'       => 'Toggle debug messages',
  392:                    'ping'              => 'Cause server to ping another server',   
  393:                    'domconf'           => 'Text Display of Domain Configuration',
  394:                    'uniquecodes'       => 'Six-character Course Codes',
  395:                    'coursecatalog'     => 'Course/Community Catalog with enrollment data',
  396:                  );
  397:     return \%titles;
  398: }
  399: 
  400: =pod
  401: 
  402: =back
  403: 
  404: =cut
  405: 
  406: 1;