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

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.58    ! raeburn     5: # $Id: loncacc.pm,v 1.57 2011/10/30 20:31:02 raeburn 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
1.57      raeburn    45: and is used to control access for the following two types of URI 
                     46: (one for files, and one for directories):
1.47      jms        47: 
                     48:  <LocationMatch "^/priv.*">
1.57      raeburn    49:  <LocationMatch "^/priv.*/$">
1.47      jms        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.55      www        78: =item constructaccess($url,$setpriv)
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 
1.58    ! raeburn    82: three element list ($ownername,$ownerdomain,$ownerhome).  
        !            83: 
        !            84: Otherwise return the null string.
        !            85: 
        !            86: If second argument 'setpriv' is true, it assigns the privileges,
        !            87: and returns the same three element list, unless the owner has
        !            88: blocked "ad hoc" Domain Coordinator access to the Author Space,
        !            89: in which case the null string is returned.
        !            90: 
1.47      jms        91: =back
                     92: 
                     93: =cut
                     94: 
                     95: 
1.1       albertel   96: package Apache::loncacc;
                     97: 
                     98: use strict;
1.26      www        99: use Apache::Constants qw(:common :http :methods REDIRECT);
1.45      albertel  100: use Fcntl qw(:flock);
1.30      www       101: use Apache::lonlocal;
1.38      albertel  102: use Apache::lonnet;
1.45      albertel  103: use Apache::lonacc;
1.43      albertel  104: use LONCAPA qw(:DEFAULT :match);
1.1       albertel  105: 
1.15      www       106: sub constructaccess {
1.54      www       107:     my ($url,$setpriv)=@_;
                    108: 
                    109: # We do not allow editing of previous versions of files
                    110:     if ($url=~/\.(\d+)\.(\w+)$/) { return ''; }
                    111: 
                    112: # Get username and domain from URL
1.57      raeburn   113:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.58    ! raeburn   114:     my ($ownername,$ownerdomain,$ownerhome);
        !           115: 
        !           116:     ($ownerdomain,$ownername) = 
        !           117:         ($url=~ m{^(?:\Q$londocroot\E|)/priv/($match_domain)/($match_username)/});
1.54      www       118: 
                    119: # The URL does not really point to any authorspace, forget it
1.15      www       120:     unless (($ownername) && ($ownerdomain)) { return ''; }
1.58    ! raeburn   121: 
1.54      www       122: # Now we need to see if the user has access to the authorspace of
                    123: # $ownername at $ownerdomain
                    124: 
                    125:     if (($ownername eq $env{'user.name'}) && ($ownerdomain eq $env{'user.domain'})) {
                    126: # Real author for this?
1.58    ! raeburn   127:        $ownerhome = $env{'user.home'};
1.54      www       128:        if (exists($env{'user.priv.au./'.$ownerdomain.'/./'})) {
1.58    ! raeburn   129:           return ($ownername,$ownerdomain,$ownerhome);
1.54      www       130:        }
                    131:     } else {
                    132: # Co-author for this?
                    133: 	if (exists($env{'user.priv.ca./'.$ownerdomain.'/'.$ownername.'./'}) ||
                    134: 	    exists($env{'user.priv.aa./'.$ownerdomain.'/'.$ownername.'./'}) ) {
1.58    ! raeburn   135: 	    $ownerhome = &Apache::lonnet::homeserver($ownername,$ownerdomain);
        !           136: 	    return ($ownername,$ownerdomain,$ownerhome);
1.39      www       137: 	}
1.20      www       138:     }
1.54      www       139: # We don't have any access right now. If we are not possibly going to do anything about this,
                    140: # we might as well leave
                    141:    unless ($setpriv) { return ''; }
                    142: 
                    143: # Backdoor access?
                    144:     my $allowed=&Apache::lonnet::allowed('eco',$ownerdomain);
                    145: # Nope
                    146:     unless ($allowed) { return ''; }
                    147: # Looks like we may have access, but could be locked by the owner of the construction space
                    148:     if ($allowed eq 'U') {
1.49      raeburn   149:         my %blocked=&Apache::lonnet::get('environment',['domcoord.author'],
                    150:                                          $ownerdomain,$ownername);
1.54      www       151: # Is blocked by owner
                    152:         if ($blocked{'domcoord.author'} eq 'blocked') { return ''; }
1.49      raeburn   153:     }
1.54      www       154:     if (($allowed eq 'F') || ($allowed eq 'U')) {
                    155: # Grant temporary access
                    156:         my $then=$env{'user.login.time'};
                    157:         my $update==$env{'user.update.time'};
                    158:         if (!$update) { $update = $then; }
                    159:         my $refresh=$env{'user.refresh.time'};
                    160:         if (!$refresh) { $refresh = $update; }
                    161:         my $now = time;
                    162:         &Apache::lonnet::check_adhoc_privs($ownerdomain,$ownername,
                    163:                                            $update,$refresh,$now,'ca',
                    164:                                            'constructaccess');
1.58    ! raeburn   165:         $ownerhome = &Apache::lonnet::homeserver($ownername,$ownerdomain);
        !           166:         return($ownername,$ownerdomain,$ownerhome);
1.54      www       167:     }
                    168: # No business here
1.15      www       169:     return '';
                    170: }
                    171: 
1.1       albertel  172: sub handler {
                    173:     my $r = shift;
                    174:     my $requrl=$r->uri;
1.38      albertel  175:     $env{'request.editurl'}=$requrl;
1.46      albertel  176: 
                    177:     my $handle =  &Apache::lonnet::check_for_valid_session($r);
                    178:     if ($handle ne '') {
1.28      www       179: 
                    180: # ------------------------------------------------------ Initialize Environment
1.46      albertel  181:         my $lonidsdir=$r->dir_config('lonIDsDir');
                    182: 	&Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
1.30      www       183: 
                    184: # --------------------------------------------------------- Initialize Language
                    185:  
1.46      albertel  186: 	&Apache::lonlocal::get_language_handle($r);
1.28      www       187: 
                    188: # -------------------------------------------------------------- Resource State
                    189: 
1.46      albertel  190: 	$env{'request.state'}    = "construct";
                    191: 	$env{'request.filename'} = $r->filename;
1.15      www       192: 
1.58    ! raeburn   193: 	my $allowed;
        !           194: 	my ($ownername,$ownerdom,$ownerhome) = &constructaccess($requrl,'setpriv');
        !           195:         if (($ownername ne '') && ($ownerdom ne '') && ($ownerhome ne '')) {
        !           196:             unless ($ownerhome eq 'no_host') {
        !           197:                 my @hosts = &Apache::lonnet::current_machine_domains();
        !           198:                 if (grep(/^\Q$ownerhome\E$/,@hosts)) {
        !           199:                     $allowed = 1;
        !           200:                 }
        !           201:             }
        !           202:         }
        !           203: 
        !           204:         unless ($allowed) {
1.46      albertel  205: 	    $r->log_reason("Unauthorized $requrl", $r->filename); 
                    206: 	    return HTTP_NOT_ACCEPTABLE;
                    207: 	}
1.9       www       208: 
                    209: # -------------------------------------------------------- Load POST parameters
                    210: 
1.46      albertel  211: 	&Apache::lonacc::get_posted_cgi($r);
1.8       www       212: 
1.46      albertel  213: 	return OK; 
1.58    ! raeburn   214:     } else {
1.46      albertel  215: 	$r->log_reason("Cookie $handle not valid", $r->filename) 
1.1       albertel  216:     }
1.6       www       217: 
                    218: # ----------------------------------------------- Store where they wanted to go
                    219: 
1.38      albertel  220:     $env{'request.firsturl'}=$requrl;
1.1       albertel  221:     return FORBIDDEN;
                    222: }
                    223: 
                    224: 1;
                    225: __END__
                    226: 

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