Return to loncacc.pm CVS log

Up to [LON-CAPA] / loncom / auth

Respects Co Author

    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)
    4: # 6/15,16/11,22/11,
    5: # 01/06,01/11,6/1,9/25,9/28,11/22,12/25,12/26,
    6: # 01/06/01,05/04,05/05 Gerd Kortemeyer
    7: 
    8: package Apache::loncacc;
    9: 
   10: use strict;
   11: use Apache::Constants qw(:common :http :methods);
   12: use Apache::File;
   13: use CGI::Cookie();
   14: use Fcntl qw(:flock);
   15: 
   16: sub constructaccess {
   17:     my ($url,$ownerdomain)=@_;
   18:     my ($ownername)=($url=~/\/(?:\~|priv\/)(\w+)/);
   19:     unless (($ownername) && ($ownerdomain)) { return ''; }
   20: 
   21:     if (($ownername eq $ENV{'user.name'}) &&
   22:         ($ownerdomain eq $ENV{'user.domain'})) {
   23: 	return ($ownername,$ownerdomain);
   24:     }
   25: 
   26:     my $capriv='user.priv.ca./'.
   27:                $ownerdomain.'/'.$ownername.'./'.
   28: 	       $ownerdomain.'/'.$ownername;
   29:     map {
   30:         if ($_ eq $capriv) {
   31:            return ($ownername,$ownerdomain);
   32:         }
   33:     } keys %ENV;
   34: 
   35:     return '';
   36: }
   37: 
   38: sub handler {
   39:     my $r = shift;
   40:     my $requrl=$r->uri;
   41:     my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
   42:     my $lonid=$cookies{'lonID'};
   43:     my $cookie;
   44:     if ($lonid) {
   45: 	my $handle=$lonid->value;
   46:         $handle=~s/\W//g;
   47:         my $lonidsdir=$r->dir_config('lonIDsDir');
   48:         if ((-e "$lonidsdir/$handle.id") && ($handle ne '')) {
   49:             my @profile;
   50: 	    {
   51:              my $idf=Apache::File->new("$lonidsdir/$handle.id");
   52:              flock($idf,LOCK_SH);
   53:              @profile=<$idf>;
   54:              $idf->close();
   55: 	    }
   56:             my $envi;
   57:             for ($envi=0;$envi<=$#profile;$envi++) {
   58: 		chomp($profile[$envi]);
   59: 		my ($envname,$envvalue)=split(/=/,$profile[$envi]);
   60:                 $ENV{$envname} = $envvalue;
   61:             }
   62:             $ENV{'user.environment'} = "$lonidsdir/$handle.id";
   63:             $ENV{'request.state'}    = "construct";
   64:             $ENV{'request.filename'} = $r->filename;
   65: 
   66:             unless (&constructaccess($requrl,$r->dir_config('lonDefDomain'))) {
   67:                 $r->log_reason("Unauthorized $requrl", $r->filename); 
   68: 	        return HTTP_NOT_ACCEPTABLE;
   69:             }
   70: 
   71: # -------------------------------------------------------- Load POST parameters
   72: 
   73: 
   74:         my $buffer;
   75: 
   76:         $r->read($buffer,$r->header_in('Content-length'));
   77: 
   78: 	unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {
   79:             my @pairs=split(/&/,$buffer);
   80:             my $pair;
   81:             foreach $pair (@pairs) {
   82:                my ($name,$value) = split(/=/,$pair);
   83:                $value =~ tr/+/ /;
   84:                $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
   85:                $name  =~ tr/+/ /;
   86:                $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
   87:                $ENV{"form.$name"}=$value;
   88:             } 
   89:         } else {
   90: 	    my $contentsep=$1;
   91:             my @lines = split (/\n/,$buffer);
   92:             my $name='';
   93:             my $value='';
   94:             my $fname='';
   95:             my $fmime='';
   96:             my $i;
   97:             for ($i=0;$i<=$#lines;$i++) {
   98: 		if ($lines[$i]=~/^$contentsep/) {
   99: 		    if ($name) {
  100:                         chomp($value);
  101: 			if ($fname) {
  102: 			    $ENV{"form.$name.filename"}=$fname;
  103:                             $ENV{"form.$name.mimetype"}=$fmime;
  104:                         } else {
  105:                             $value=~s/\s+$//s;
  106:                         }
  107:                         $ENV{"form.$name"}=$value;
  108:                     }
  109:                     if ($i<$#lines) {
  110: 			$i++;
  111:                         $lines[$i]=~
  112: 		 /Content\-Disposition\:\s*form\-data\;\s*name\=\"([^\"]+)\"/i;
  113:                         $name=$1;
  114:                         $value='';
  115:                         if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) {
  116: 			   $fname=$1;
  117:                            if 
  118:                             ($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) {
  119: 			      $fmime=$1;
  120:                               $i++;
  121: 			   } else {
  122:                               $fmime='';
  123:                            }
  124:                         } else {
  125: 			    $fname='';
  126:                             $fmime='';
  127:                         }
  128:                         $i++;
  129:                     }
  130:                 } else {
  131: 		    $value.=$lines[$i]."\n";
  132:                 }
  133:             }
  134: 	}
  135:             $r->method_number(M_GET);
  136: 	    $r->method('GET');
  137:             $r->headers_in->unset('Content-length');
  138: 
  139:             return OK; 
  140:         } else { 
  141:             $r->log_reason("Cookie $handle not valid", $r->filename) 
  142:         };
  143:     }
  144: 
  145: # ----------------------------------------------- Store where they wanted to go
  146: 
  147:     $ENV{'request.firsturl'}=$requrl;
  148:     return FORBIDDEN;
  149: }
  150: 
  151: 1;
  152: __END__
  153: 
  154: 
  155: 
  156: 
  157: 
  158: 
  159: 
  160: