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

1.1       albertel    1: # The LearningOnline Network
                      2: # Cookie Based Access Handler
1.22    ! www         3: #
        !             4: # $Id: gplheader.pl,v 1.1 2001/11/29 18:19:27 www 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: #
1.4       www        28: # 5/21/99,5/22,5/29,5/31,6/15,16/11,22/11,
1.14      www        29: # 01/06,01/13,05/31,06/01,09/06,09/25,09/28,10/30,11/6,
1.17      www        30: # 12/25,12/26,
1.21      www        31: # 01/06/01,05/28,8/11,9/26 Gerd Kortemeyer
1.1       albertel   32: 
                     33: package Apache::lonacc;
                     34: 
                     35: use strict;
1.8       www        36: use Apache::Constants qw(:common :http :methods);
1.2       www        37: use Apache::File;
1.6       www        38: use Apache::lonnet;
1.1       albertel   39: use CGI::Cookie();
1.16      www        40: use Fcntl qw(:flock);
1.1       albertel   41: 
                     42: sub handler {
                     43:     my $r = shift;
                     44:     my $requrl=$r->uri;
                     45:     my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
                     46:     my $lonid=$cookies{'lonID'};
                     47:     my $cookie;
                     48:     if ($lonid) {
                     49: 	my $handle=$lonid->value;
                     50:         $handle=~s/\W//g;
                     51:         my $lonidsdir=$r->dir_config('lonIDsDir');
                     52:         if ((-e "$lonidsdir/$handle.id") && ($handle ne '')) {
1.6       www        53: 
                     54: # ------------------------------------------- Transfer profile into environment
                     55: 
1.2       www        56:             my @profile;
                     57: 	    {
                     58:              my $idf=Apache::File->new("$lonidsdir/$handle.id");
1.16      www        59:              flock($idf,LOCK_SH);
1.2       www        60:              @profile=<$idf>;
1.16      www        61:              $idf->close();
1.2       www        62: 	    }
                     63:             my $envi;
                     64:             for ($envi=0;$envi<=$#profile;$envi++) {
                     65: 		chomp($profile[$envi]);
                     66: 		my ($envname,$envvalue)=split(/=/,$profile[$envi]);
1.9       www        67:                 $ENV{$envname} = $envvalue;
1.2       www        68:             }
1.9       www        69:             $ENV{'user.environment'} = "$lonidsdir/$handle.id";
1.18      www        70:             if ($requrl=~/^\/res\//) {
1.17      www        71:                $ENV{'request.state'} = "published";
                     72: 	    } else {
                     73: 	       $ENV{'request.state'} = 'unknown';
                     74:             }
1.9       www        75:             $ENV{'request.filename'} = $r->filename;
1.12      www        76: 
1.6       www        77: # -------------------------------------------------------- Load POST parameters
                     78: 
1.8       www        79: 
                     80:            
1.14      www        81:         my $buffer;
1.6       www        82: 
1.14      www        83:         $r->read($buffer,$r->header_in('Content-length'));
                     84: 
                     85: 	unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {
1.5       www        86:             my @pairs=split(/&/,$buffer);
1.6       www        87:             my $pair;
1.5       www        88:             foreach $pair (@pairs) {
1.6       www        89:                my ($name,$value) = split(/=/,$pair);
                     90:                $value =~ tr/+/ /;
                     91:                $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.10      www        92:                $name  =~ tr/+/ /;
                     93:                $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.9       www        94:                $ENV{"form.$name"}=$value;
1.6       www        95:             }
1.14      www        96:         } else {
                     97: 	    my $contentsep=$1;
                     98:             my @lines = split (/\n/,$buffer);
                     99:             my $name='';
                    100:             my $value='';
                    101:             my $fname='';
                    102:             my $fmime='';
                    103:             my $i;
                    104:             for ($i=0;$i<=$#lines;$i++) {
                    105: 		if ($lines[$i]=~/^$contentsep/) {
                    106: 		    if ($name) {
                    107:                         chomp($value);
                    108: 			if ($fname) {
                    109: 			    $ENV{"form.$name.filename"}=$fname;
                    110:                             $ENV{"form.$name.mimetype"}=$fmime;
1.15      www       111:                         } else {
                    112:                             $value=~s/\s+$//s;
1.14      www       113:                         }
1.15      www       114:                         $ENV{"form.$name"}=$value;
1.14      www       115:                     }
                    116:                     if ($i<$#lines) {
                    117: 			$i++;
                    118:                         $lines[$i]=~
                    119: 		 /Content\-Disposition\:\s*form\-data\;\s*name\=\"([^\"]+)\"/i;
                    120:                         $name=$1;
                    121:                         $value='';
                    122:                         if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) {
                    123: 			   $fname=$1;
                    124:                            if 
                    125:                             ($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) {
                    126: 			      $fmime=$1;
                    127:                               $i++;
                    128: 			   } else {
                    129:                               $fmime='';
                    130:                            }
                    131:                         } else {
                    132: 			    $fname='';
                    133:                             $fmime='';
                    134:                         }
                    135:                         $i++;
                    136:                     }
                    137:                 } else {
                    138: 		    $value.=$lines[$i]."\n";
                    139:                 }
                    140:             }
                    141: 	}
1.8       www       142:             $r->method_number(M_GET);
                    143: 	    $r->method('GET');
                    144:             $r->headers_in->unset('Content-length');
1.6       www       145: 
                    146: # ---------------------------------------------------------------- Check access
                    147: 
                    148:             if ($requrl!~/^\/adm\//) {
1.7       www       149: 		my $access=&Apache::lonnet::allowed('bre',$requrl);
                    150:                 if ($access eq '1') {
                    151: 		   $ENV{'user.error.msg'}="$requrl:bre:0:0:Choose Course";
                    152: 	           return HTTP_NOT_ACCEPTABLE; 
                    153:                 }
                    154:                 if (($access ne '2') && ($access ne 'F')) {
                    155: 		   $ENV{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
                    156: 	           return HTTP_NOT_ACCEPTABLE; 
                    157:                 }
1.5       www       158:             } 
1.2       www       159:             return OK; 
1.1       albertel  160:         } else { 
1.5       www       161:             $r->log_reason("Cookie $handle not valid", $r->filename) 
1.1       albertel  162:         };
                    163:     }
1.6       www       164: 
1.21      www       165: # -------------------------------------------- See if this is a public resource
                    166:     if (&Apache::lonnet::metadata($requrl,'copyright') eq 'public') {
                    167:         &Apache::lonnet::logthis('Granting public access: '.$requrl);
                    168: 	$ENV{'user.name'}='public';
                    169:         $ENV{'user.domain'}='public';
                    170:         $ENV{'request.state'} = "published";
                    171:         $ENV{'request.publicaccess'} = 1;
                    172:         $ENV{'request.filename'} = $r->filename;
                    173:         return OK;
                    174:     }
1.6       www       175: # ----------------------------------------------- Store where they wanted to go
1.21      www       176:     
1.6       www       177:     $ENV{'request.firsturl'}=$requrl;
1.1       albertel  178:     return FORBIDDEN;
                    179: }
                    180: 
                    181: 1;
                    182: __END__

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