File:  [LON-CAPA] / loncom / cgi / lonauthcgi.pm
Revision 1.7: download - view: text, annotated - select for diffs
Fri Oct 14 20:50:54 2011 UTC (12 years, 7 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD
- IP-based access to status information for manager in manager.tab

    1: #
    2: # LON-CAPA authorization for cgi-bin scripts
    3: #
    4: # $Id: lonauthcgi.pm,v 1.7 2011/10/14 20:50:54 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 Socket;
   59: use Apache::lonnet;
   60: use Apache::lonlocal;
   61: use LONCAPA;
   62: use LONCAPA::Configuration();
   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:     }
   99:     if (&is_manager_ip($ip)) {
  100:         $allowed = 1;
  101:         return $allowed;
  102:     }
  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: 
  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: 
  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: 
  181:          In the case of requests for the 'ping' page, access is also allowed if
  182:          at least one domain hosted on requestor's server is also hosted on this server.
  183: 
  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.
  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 {
  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:                             }
  239:                         }
  240:                     }
  241:                 }
  242:                 last if $allowed;
  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',
  318:                    'showenv'           => 'Show user environment',
  319:                    'toggledebug'       => 'Toggle debug messages',
  320:                  );
  321:     return \%titles;
  322: }
  323: 
  324: 
  325: 1;
  326: 

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