Return to lonacc.pm CVS log

Up to [LON-CAPA] / loncom / auth

Logging of accesses and caching of symb

    1: # The LearningOnline Network
    2: # Cookie Based Access Handler
    3: #
    4: # $Id: lonacc.pm,v 1.23 2001/11/29 21:54:56 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: #
   28: # 5/21/99,5/22,5/29,5/31,6/15,16/11,22/11,
   29: # 01/06,01/13,05/31,06/01,09/06,09/25,09/28,10/30,11/6,
   30: # 12/25,12/26,
   31: # 01/06/01,05/28,8/11,9/26,11/29 Gerd Kortemeyer
   32: 
   33: package Apache::lonacc;
   34: 
   35: use strict;
   36: use Apache::Constants qw(:common :http :methods);
   37: use Apache::File;
   38: use Apache::lonnet;
   39: use CGI::Cookie();
   40: use Fcntl qw(:flock);
   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 '')) {
   53: 
   54: # ------------------------------------------- Transfer profile into environment
   55: 
   56:             my @profile;
   57: 	    {
   58:              my $idf=Apache::File->new("$lonidsdir/$handle.id");
   59:              flock($idf,LOCK_SH);
   60:              @profile=<$idf>;
   61:              $idf->close();
   62: 	    }
   63:             my $envi;
   64:             for ($envi=0;$envi<=$#profile;$envi++) {
   65: 		chomp($profile[$envi]);
   66: 		my ($envname,$envvalue)=split(/=/,$profile[$envi]);
   67:                 $ENV{$envname} = $envvalue;
   68:             }
   69:             $ENV{'user.environment'} = "$lonidsdir/$handle.id";
   70:             if ($requrl=~/^\/res\//) {
   71:                $ENV{'request.state'} = "published";
   72: 	    } else {
   73: 	       $ENV{'request.state'} = 'unknown';
   74:             }
   75:             $ENV{'request.filename'} = $r->filename;
   76: 
   77: # -------------------------------------------------------- Load POST parameters
   78: 
   79: 
   80:            
   81:         my $buffer;
   82: 
   83:         $r->read($buffer,$r->header_in('Content-length'));
   84: 
   85: 	unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {
   86:             my @pairs=split(/&/,$buffer);
   87:             my $pair;
   88:             foreach $pair (@pairs) {
   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;
   92:                $name  =~ tr/+/ /;
   93:                $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
   94:                $ENV{"form.$name"}=$value;
   95:             }
   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;
  111:                         } else {
  112:                             $value=~s/\s+$//s;
  113:                         }
  114:                         $ENV{"form.$name"}=$value;
  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: 	}
  142:             $r->method_number(M_GET);
  143: 	    $r->method('GET');
  144:             $r->headers_in->unset('Content-length');
  145: 
  146: # ---------------------------------------------------------------- Check access
  147: 
  148:             if ($requrl!~/^\/adm\//) {
  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:                 }
  158:             }
  159: # ------------------------------------------------------------- This is allowed
  160:           if ($ENV{'request.course.id'}) {
  161:             $requrl=~/\.(\w+)$/;
  162:             if (&Apache::lonnet::fileembstyle($1) eq 'ssi') {
  163: # ------------------------------------- This is serious stuff, get symb and log
  164: 		my $symb=&Apache::lonnet::symbread;
  165:                 $ENV{'request.symb'}=$symb;
  166:                 &Apache::lonnet::courseacclog($symb);
  167:             } else {
  168: # ------------------------------------------------------- This is other content
  169:                 &Apache::lonnet::courseacclog($requrl);    
  170:             }
  171: 	  }
  172:             return OK; 
  173:         } else { 
  174:             $r->log_reason("Cookie $handle not valid", $r->filename) 
  175:         };
  176:     }
  177: 
  178: # -------------------------------------------- See if this is a public resource
  179:     if (&Apache::lonnet::metadata($requrl,'copyright') eq 'public') {
  180:         &Apache::lonnet::logthis('Granting public access: '.$requrl);
  181: 	$ENV{'user.name'}='public';
  182:         $ENV{'user.domain'}='public';
  183:         $ENV{'request.state'} = "published";
  184:         $ENV{'request.publicaccess'} = 1;
  185:         $ENV{'request.filename'} = $r->filename;
  186:         return OK;
  187:     }
  188: # ----------------------------------------------- Store where they wanted to go
  189:     
  190:     $ENV{'request.firsturl'}=$requrl;
  191:     return FORBIDDEN;
  192: }
  193: 
  194: 1;
  195: __END__