Return to loncacc.pm CVS log

Up to [LON-CAPA] / loncom / auth

GPL

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