Annotation of loncom/auth/loncacc.pm, revision 1.49

1.1       albertel    1: # The LearningOnline Network
                      2: # Cookie Based Access Handler for Construction Area
                      3: # (lonacc: 5/21/99,5/22,5/29,5/31 Gerd Kortemeyer)
1.20      www         4: #
1.49    ! raeburn     5: # $Id: loncacc.pm,v 1.48 2008/11/19 17:38:21 jms Exp $
1.20      www         6: #
                      7: # Copyright Michigan State University Board of Trustees
                      8: #
                      9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                     10: #
                     11: # LON-CAPA is free software; you can redistribute it and/or modify
                     12: # it under the terms of the GNU General Public License as published by
                     13: # the Free Software Foundation; either version 2 of the License, or
                     14: # (at your option) any later version.
                     15: #
                     16: # LON-CAPA is distributed in the hope that it will be useful,
                     17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     19: # GNU General Public License for more details.
                     20: #
                     21: # You should have received a copy of the GNU General Public License
                     22: # along with LON-CAPA; if not, write to the Free Software
                     23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     24: #
                     25: # /home/httpd/html/adm/gpl.txt
                     26: #
                     27: # http://www.lon-capa.org/
                     28: #
1.1       albertel   29: 
1.47      jms        30: =pod
                     31: 
                     32: =head1 NAME
                     33: 
                     34: Apache::lonacc - Cookie Based Access Handler for Construction Area
                     35: 
                     36: =head1 SYNOPSIS
                     37: 
                     38: Invoked (for various locations) by /etc/httpd/conf/loncapa_apache.conf:
                     39: 
                     40:  PerlAccessHandler       Apache::loncacc
                     41: 
                     42: =head1 INTRODUCTION
                     43: 
                     44: This module enables cookie based authentication for construction area
                     45: and is used to control access for three (essentially equivalent) URIs.
                     46: 
                     47:  <LocationMatch "^/priv.*">
                     48:  <LocationMatch "^/\~.*">
                     49:  <LocationMatch "^/\~.*/$">
                     50: 
                     51: Whenever the client sends the cookie back to the server, 
                     52: if the cookie is missing or invalid, the user is re-challenged
                     53: for login information.
                     54: 
                     55: This is part of the LearningOnline Network with CAPA project
                     56: described at http://www.lon-capa.org.
                     57: 
                     58: =head1 HANDLER SUBROUTINE
                     59: 
                     60: This routine is called by Apache and mod_perl.
                     61: 
                     62: =over 4
                     63: 
                     64: =item *
                     65: 
                     66: load POST parameters
                     67: 
                     68: =item *
                     69: 
                     70: store where they wanted to go (first url entered)
                     71: 
                     72: =back
                     73: 
                     74: =head1 OTHERSUBROUTINES
                     75: 
1.48      jms        76: =over
1.47      jms        77: 
1.48      jms        78: =item constructaccess($url,$ownerdomain)
1.47      jms        79: 
1.48      jms        80: See if the owner domain and name
1.47      jms        81: in the URL match those in the expected environment.  If so, return 
                     82: two element list ($ownername,$ownerdomain).  Else, return null string.
                     83: 
                     84: =back
                     85: 
                     86: =cut
                     87: 
                     88: 
1.1       albertel   89: package Apache::loncacc;
                     90: 
                     91: use strict;
1.26      www        92: use Apache::Constants qw(:common :http :methods REDIRECT);
1.45      albertel   93: use Fcntl qw(:flock);
1.30      www        94: use Apache::lonlocal;
1.38      albertel   95: use Apache::lonnet;
1.45      albertel   96: use Apache::lonacc;
1.43      albertel   97: use LONCAPA qw(:DEFAULT :match);
1.1       albertel   98: 
1.15      www        99: sub constructaccess {
1.49    ! raeburn   100:     my ($url,$ownerdomain,$setpriv)=@_;
1.45      albertel  101:     my ($ownername)=($url=~/\/(?:\~|priv\/|home\/)($match_username)\//);
1.15      www       102:     unless (($ownername) && ($ownerdomain)) { return ''; }
1.24      matthew   103:     # We do not allow editing of previous versions of files.
                    104:     if ($url=~/\.(\d+)\.(\w+)$/) { return ''; }
1.33      albertel  105:     my @possibledomains = &Apache::lonnet::current_machine_domains();
1.38      albertel  106:     if ($ownername eq $env{'user.name'}) {
1.33      albertel  107: 	foreach my $domain (@possibledomains) {
1.38      albertel  108: 	    if ($domain eq $env{'user.domain'}) {
1.33      albertel  109: 		return ($ownername,$domain);
                    110: 	    }
                    111: 	}
1.15      www       112:     }
1.45      albertel  113:     
1.33      albertel  114:     foreach my $domain (@possibledomains) {
1.40      albertel  115: 	if (exists($env{'user.priv.ca./'.$domain.'/'.$ownername.'./'}) ||
                    116: 	    exists($env{'user.priv.aa./'.$domain.'/'.$ownername.'./'}) ) {
                    117: 	    return ($ownername,$domain);
1.39      www       118: 	}
1.20      www       119:     }
1.49    ! raeburn   120: 
        !           121:     my $then=$env{'user.login.time'};
        !           122:     my %dcroles = ();
        !           123:     if (&is_active_dc($ownerdomain,$then)) {
        !           124:         my %blocked=&Apache::lonnet::get('environment',['domcoord.author'],
        !           125:                                          $ownerdomain,$ownername);
        !           126:         unless ($blocked{'domcoord.author'} eq 'blocked') {
        !           127:             if (grep(/^$ownerdomain$/,@possibledomains)) {
        !           128:                 if ($setpriv) {
        !           129:                     my $now = time;
        !           130:                     &Apache::lonnet::check_adhoc_privs($ownerdomain,$ownername,
        !           131:                                                        $then,$now,'ca');
        !           132:                 }
        !           133:                 return($ownername,$ownerdomain);
        !           134:             }
        !           135:         }
        !           136:     }
1.15      www       137:     return '';
                    138: }
                    139: 
1.49    ! raeburn   140: sub is_active_dc {
        !           141:     my ($ownerdomain,$then) = @_;
        !           142:     my $livedc;
        !           143:     if ($env{'user.adv'}) {
        !           144:         my $domrole = $env{'user.role.dc./'.$ownerdomain.'/'};
        !           145:         if ($domrole) {
        !           146:             my ($tstart,$tend)=split(/\./,$domrole);
        !           147:             $livedc = 1;
        !           148:             if ($tstart && $tstart>$then) { undef($livedc); }
        !           149:             if ($tend   && $tend  <$then) { undef($livedc); }
        !           150:         }
        !           151:     }
        !           152:     return $livedc;
        !           153: }
        !           154: 
        !           155: 
1.1       albertel  156: sub handler {
                    157:     my $r = shift;
                    158:     my $requrl=$r->uri;
1.38      albertel  159:     $env{'request.editurl'}=$requrl;
1.46      albertel  160: 
                    161:     my $handle =  &Apache::lonnet::check_for_valid_session($r);
                    162:     if ($handle ne '') {
1.28      www       163: 
                    164: # ------------------------------------------------------ Initialize Environment
1.46      albertel  165:         my $lonidsdir=$r->dir_config('lonIDsDir');
                    166: 	&Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
1.30      www       167: 
                    168: # --------------------------------------------------------- Initialize Language
                    169:  
1.46      albertel  170: 	&Apache::lonlocal::get_language_handle($r);
1.28      www       171: 
                    172: # -------------------------------------------------------------- Resource State
                    173: 
1.46      albertel  174: 	$env{'request.state'}    = "construct";
                    175: 	$env{'request.filename'} = $r->filename;
1.15      www       176: 
1.49    ! raeburn   177: 	unless (&constructaccess($requrl,$r->dir_config('lonDefDomain')),'setpriv') {
1.46      albertel  178: 	    $r->log_reason("Unauthorized $requrl", $r->filename); 
                    179: 	    return HTTP_NOT_ACCEPTABLE;
                    180: 	}
1.9       www       181: 
                    182: # -------------------------------------------------------- Load POST parameters
                    183: 
1.46      albertel  184: 	&Apache::lonacc::get_posted_cgi($r);
1.8       www       185: 
1.46      albertel  186: 	return OK; 
                    187:     } else { 
                    188: 	$r->log_reason("Cookie $handle not valid", $r->filename) 
1.1       albertel  189:     }
1.6       www       190: 
                    191: # ----------------------------------------------- Store where they wanted to go
                    192: 
1.38      albertel  193:     $env{'request.firsturl'}=$requrl;
1.1       albertel  194:     return FORBIDDEN;
                    195: }
                    196: 
                    197: 1;
                    198: __END__
                    199: 
                    200: 
                    201: 
                    202: 
                    203: 
                    204: 
                    205: 
                    206: 

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