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

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.22    ! www         5: # $Id: loncacc.pm,v 1.21 2002/02/26 21:01:33 albertel 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: #
                     29: # YEAR=2000
1.4       www        30: # 6/15,16/11,22/11,
1.20      www        31: # YEAR=2001
1.15      www        32: # 01/06,01/11,6/1,9/25,9/28,11/22,12/25,12/26,
1.16      www        33: # 01/06/01,05/04,05/05,05/09 Gerd Kortemeyer
1.20      www        34: # 12/21 Scott Harrison
                     35: # YEAR=2002
                     36: # 1/4 Gerd Kortemeyer
                     37: ###
1.1       albertel   38: 
                     39: package Apache::loncacc;
                     40: 
                     41: use strict;
1.8       www        42: use Apache::Constants qw(:common :http :methods);
1.7       www        43: use Apache::File;
1.1       albertel   44: use CGI::Cookie();
1.14      www        45: use Fcntl qw(:flock);
1.1       albertel   46: 
1.15      www        47: sub constructaccess {
                     48:     my ($url,$ownerdomain)=@_;
1.16      www        49:     my ($ownername)=($url=~/\/(?:\~|priv\/|home\/)(\w+)/);
1.15      www        50:     unless (($ownername) && ($ownerdomain)) { return ''; }
                     51: 
                     52:     if (($ownername eq $ENV{'user.name'}) &&
                     53:         ($ownerdomain eq $ENV{'user.domain'})) {
                     54: 	return ($ownername,$ownerdomain);
                     55:     }
                     56: 
                     57:     my $capriv='user.priv.ca./'.
                     58:                $ownerdomain.'/'.$ownername.'./'.
                     59: 	       $ownerdomain.'/'.$ownername;
1.20      www        60:     foreach (keys %ENV) {
1.15      www        61:         if ($_ eq $capriv) {
                     62:            return ($ownername,$ownerdomain);
                     63:         }
1.20      www        64:     }
1.15      www        65: 
                     66:     return '';
                     67: }
                     68: 
1.1       albertel   69: sub handler {
                     70:     my $r = shift;
                     71:     my $requrl=$r->uri;
1.22    ! www        72:     $ENV{'request.editurl'}=$requrl;
1.1       albertel   73:     my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
                     74:     my $lonid=$cookies{'lonID'};
                     75:     my $cookie;
                     76:     if ($lonid) {
                     77: 	my $handle=$lonid->value;
                     78:         $handle=~s/\W//g;
                     79:         my $lonidsdir=$r->dir_config('lonIDsDir');
                     80:         if ((-e "$lonidsdir/$handle.id") && ($handle ne '')) {
1.2       www        81:             my @profile;
                     82: 	    {
                     83:              my $idf=Apache::File->new("$lonidsdir/$handle.id");
1.14      www        84:              flock($idf,LOCK_SH);
1.2       www        85:              @profile=<$idf>;
1.14      www        86:              $idf->close();
1.2       www        87: 	    }
                     88:             my $envi;
                     89:             for ($envi=0;$envi<=$#profile;$envi++) {
                     90: 		chomp($profile[$envi]);
                     91: 		my ($envname,$envvalue)=split(/=/,$profile[$envi]);
1.9       www        92:                 $ENV{$envname} = $envvalue;
1.2       www        93:             }
1.9       www        94:             $ENV{'user.environment'} = "$lonidsdir/$handle.id";
                     95:             $ENV{'request.state'}    = "construct";
                     96:             $ENV{'request.filename'} = $r->filename;
1.15      www        97: 
                     98:             unless (&constructaccess($requrl,$r->dir_config('lonDefDomain'))) {
                     99:                 $r->log_reason("Unauthorized $requrl", $r->filename); 
                    100: 	        return HTTP_NOT_ACCEPTABLE;
                    101:             }
1.9       www       102: 
                    103: # -------------------------------------------------------- Load POST parameters
                    104: 
                    105: 
1.12      www       106:         my $buffer;
1.8       www       107: 
1.12      www       108:         $r->read($buffer,$r->header_in('Content-length'));
                    109: 
                    110: 	unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {
1.5       www       111:             my @pairs=split(/&/,$buffer);
1.9       www       112:             my $pair;
1.5       www       113:             foreach $pair (@pairs) {
1.9       www       114:                my ($name,$value) = split(/=/,$pair);
1.6       www       115:                $value =~ tr/+/ /;
                    116:                $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.10      www       117:                $name  =~ tr/+/ /;
                    118:                $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.21      albertel  119: 	       &Apache::loncommon::add_to_env("form.$name",$value);
1.5       www       120:             } 
1.12      www       121:         } else {
                    122: 	    my $contentsep=$1;
                    123:             my @lines = split (/\n/,$buffer);
                    124:             my $name='';
                    125:             my $value='';
                    126:             my $fname='';
                    127:             my $fmime='';
                    128:             my $i;
                    129:             for ($i=0;$i<=$#lines;$i++) {
                    130: 		if ($lines[$i]=~/^$contentsep/) {
                    131: 		    if ($name) {
                    132:                         chomp($value);
                    133: 			if ($fname) {
                    134: 			    $ENV{"form.$name.filename"}=$fname;
                    135:                             $ENV{"form.$name.mimetype"}=$fmime;
1.13      www       136:                         } else {
                    137:                             $value=~s/\s+$//s;
1.12      www       138:                         }
1.21      albertel  139: 			&Apache::loncommon::add_to_env("form.$name",$value);
1.12      www       140:                     }
                    141:                     if ($i<$#lines) {
                    142: 			$i++;
                    143:                         $lines[$i]=~
                    144: 		 /Content\-Disposition\:\s*form\-data\;\s*name\=\"([^\"]+)\"/i;
                    145:                         $name=$1;
                    146:                         $value='';
                    147:                         if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) {
                    148: 			   $fname=$1;
                    149:                            if 
                    150:                             ($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) {
                    151: 			      $fmime=$1;
                    152:                               $i++;
                    153: 			   } else {
                    154:                               $fmime='';
                    155:                            }
                    156:                         } else {
                    157: 			    $fname='';
                    158:                             $fmime='';
                    159:                         }
                    160:                         $i++;
                    161:                     }
                    162:                 } else {
                    163: 		    $value.=$lines[$i]."\n";
                    164:                 }
                    165:             }
                    166: 	}
1.20      www       167:             $ENV{'request.method'}=$ENV{'REQUEST_METHOD'};
1.8       www       168:             $r->method_number(M_GET);
                    169: 	    $r->method('GET');
                    170:             $r->headers_in->unset('Content-length');
                    171: 
1.1       albertel  172:             return OK; 
                    173:         } else { 
                    174:             $r->log_reason("Cookie $handle not valid", $r->filename) 
                    175:         };
                    176:     }
1.6       www       177: 
                    178: # ----------------------------------------------- Store where they wanted to go
                    179: 
                    180:     $ENV{'request.firsturl'}=$requrl;
1.1       albertel  181:     return FORBIDDEN;
                    182: }
                    183: 
                    184: 1;
                    185: __END__
                    186: 
1.20      www       187: =head1 NAME
                    188: 
                    189: Apache::lonacc - Cookie Based Access Handler for Construction Area
                    190: 
                    191: =head1 SYNOPSIS
                    192: 
                    193: Invoked (for various locations) by /etc/httpd/conf/srm.conf:
                    194: 
                    195:  PerlAccessHandler       Apache::loncacc
                    196: 
                    197: =head1 INTRODUCTION
                    198: 
                    199: This module enables cookie based authentication for construction area
                    200: and is used to control access for three (essentially equivalent) URIs.
                    201: 
                    202:  <LocationMatch "^/priv.*">
                    203:  <LocationMatch "^/\~.*">
                    204:  <LocationMatch "^/\~.*/$">
                    205: 
                    206: Whenever the client sends the cookie back to the server, 
                    207: if the cookie is missing or invalid, the user is re-challenged
                    208: for login information.
                    209: 
                    210: This is part of the LearningOnline Network with CAPA project
                    211: described at http://www.lon-capa.org.
                    212: 
                    213: =head1 HANDLER SUBROUTINE
                    214: 
                    215: This routine is called by Apache and mod_perl.
                    216: 
                    217: =over 4
                    218: 
                    219: =item *
                    220: 
                    221: load POST parameters
                    222: 
                    223: =item *
                    224: 
                    225: store where they wanted to go (first url entered)
                    226: 
                    227: =back
                    228: 
                    229: =head1 OTHERSUBROUTINES
                    230: 
                    231: =over 4
                    232: 
                    233: =item *
                    234: 
                    235: constructaccess($url,$ownerdomain) : See if the owner domain and name
                    236: in the URL match those in the expected environment.  If so, return 
                    237: two element list ($ownername,$ownerdomain).  Else, return null string.
                    238: 
                    239: =back
                    240: 
                    241: =cut
1.1       albertel  242: 
                    243: 
                    244: 
                    245: 
                    246: 
                    247: 
                    248: 

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