[BACK]Return to loncacc.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / auth

Diff for /loncom/auth/loncacc.pm between versions 1.17 and 1.61

version 1.17, 2001/11/29 19:12:44 version 1.61, 2013/06/04 23:12:13
Line 1 Line 1
 # The LearningOnline Network  # The LearningOnline Network
 # Cookie Based Access Handler for Construction Area  # Cookie Based Access Handler for Authoring Spaces
 # (lonacc: 5/21/99,5/22,5/29,5/31 Gerd Kortemeyer)  # (lonacc: 5/21/99,5/22,5/29,5/31 Gerd Kortemeyer)
 #  #
 # $Id$  # $Id$
Line 26 Line 26
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # 6/15,16/11,22/11,  
 # 01/06,01/11,6/1,9/25,9/28,11/22,12/25,12/26,  
 # 01/06/01,05/04,05/05,05/09 Gerd Kortemeyer  
   
 package Apache::loncacc;  =pod
   
 use strict;  =head1 NAME
 use Apache::Constants qw(:common :http :methods);  
 use Apache::File;  
 use CGI::Cookie();  
 use Fcntl qw(:flock);  
   
 sub constructaccess {  Apache::lonacc - Cookie Based Access Handler for Authoring Spaces 
     my ($url,$ownerdomain)=@_;  
     my ($ownername)=($url=~/\/(?:\~|priv\/|home\/)(\w+)/);  
     unless (($ownername) && ($ownerdomain)) { return ''; }  
   
     if (($ownername eq $ENV{'user.name'}) &&  
         ($ownerdomain eq $ENV{'user.domain'})) {  
  return ($ownername,$ownerdomain);  
     }  
   
     my $capriv='user.priv.ca./'.  =head1 SYNOPSIS
                $ownerdomain.'/'.$ownername.'./'.  
        $ownerdomain.'/'.$ownername;  
     map {  
         if ($_ eq $capriv) {  
            return ($ownername,$ownerdomain);  
         }  
     } keys %ENV;  
   
     return '';  Invoked (for various locations) by /etc/httpd/conf/loncapa_apache.conf:
 }  
    PerlAccessHandler       Apache::loncacc
   
   =head1 INTRODUCTION
   
   This module enables cookie based authentication for construction area
   and is used to control access for the following two types of URI 
   (one for files, and one for directories):
   
    <LocationMatch "^/priv.*">
    <LocationMatch "^/priv.*/$">
   
   Whenever the client sends the cookie back to the server, 
   if the cookie is missing or invalid, the user is re-challenged
   for login information.
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   =head1 HANDLER SUBROUTINE
   
   This routine is called by Apache and mod_perl.
   
   =over 4
   
   =item *
   
   load POST parameters
   
   =item *
   
   store where they wanted to go (first url entered)
   
   =back
   
   =cut
   
   
   package Apache::loncacc;
   
   use strict;
   use Apache::Constants qw(:common :http :methods REDIRECT);
   use Fcntl qw(:flock);
   use Apache::lonlocal;
   use Apache::lonnet;
   use Apache::lonacc;
   use LONCAPA qw(:DEFAULT :match);
   
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
     my $requrl=$r->uri;      my $requrl=$r->uri;
     my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));      $env{'request.editurl'}=$requrl;
     my $lonid=$cookies{'lonID'};  
     my $cookie;  
     if ($lonid) {  
  my $handle=$lonid->value;  
         $handle=~s/\W//g;  
         my $lonidsdir=$r->dir_config('lonIDsDir');  
         if ((-e "$lonidsdir/$handle.id") && ($handle ne '')) {  
             my @profile;  
     {  
              my $idf=Apache::File->new("$lonidsdir/$handle.id");  
              flock($idf,LOCK_SH);  
              @profile=<$idf>;  
              $idf->close();  
     }  
             my $envi;  
             for ($envi=0;$envi<=$#profile;$envi++) {  
  chomp($profile[$envi]);  
  my ($envname,$envvalue)=split(/=/,$profile[$envi]);  
                 $ENV{$envname} = $envvalue;  
             }  
             $ENV{'user.environment'} = "$lonidsdir/$handle.id";  
             $ENV{'request.state'}    = "construct";  
             $ENV{'request.filename'} = $r->filename;  
   
             unless (&constructaccess($requrl,$r->dir_config('lonDefDomain'))) {  
                 $r->log_reason("Unauthorized $requrl", $r->filename);   
         return HTTP_NOT_ACCEPTABLE;  
             }  
   
 # -------------------------------------------------------- Load POST parameters      my $handle =  &Apache::lonnet::check_for_valid_session($r);
       if ($handle ne '') {
   
         my $buffer;  
   
         $r->read($buffer,$r->header_in('Content-length'));  # ------------------------------------------------------ Initialize Environment
           my $lonidsdir=$r->dir_config('lonIDsDir');
    &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
   
  unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {  # --------------------------------------------------------- Initialize Language
             my @pairs=split(/&/,$buffer);   
             my $pair;   &Apache::lonlocal::get_language_handle($r);
             foreach $pair (@pairs) {  
                my ($name,$value) = split(/=/,$pair);  # -------------------------------------------------------------- Resource State
                $value =~ tr/+/ /;  
                $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;   $env{'request.state'}    = "construct";
                $name  =~ tr/+/ /;   $env{'request.filename'} = $r->filename;
                $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  
                $ENV{"form.$name"}=$value;   my $allowed;
             }    my ($ownername,$ownerdom,$ownerhome) = 
         } else {              &Apache::lonnet::constructaccess($requrl,'setpriv');
     my $contentsep=$1;          if (($ownername ne '') && ($ownerdom ne '') && ($ownerhome ne '')) {
             my @lines = split (/\n/,$buffer);              unless ($ownerhome eq 'no_host') {
             my $name='';                  my @hosts = &Apache::lonnet::current_machine_ids();
             my $value='';                  if (grep(/^\Q$ownerhome\E$/,@hosts)) {
             my $fname='';                      $allowed = 1;
             my $fmime='';  
             my $i;  
             for ($i=0;$i<=$#lines;$i++) {  
  if ($lines[$i]=~/^$contentsep/) {  
     if ($name) {  
                         chomp($value);  
  if ($fname) {  
     $ENV{"form.$name.filename"}=$fname;  
                             $ENV{"form.$name.mimetype"}=$fmime;  
                         } else {  
                             $value=~s/\s+$//s;  
                         }  
                         $ENV{"form.$name"}=$value;  
                     }  
                     if ($i<$#lines) {  
  $i++;  
                         $lines[$i]=~  
  /Content\-Disposition\:\s*form\-data\;\s*name\=\"([^\"]+)\"/i;  
                         $name=$1;  
                         $value='';  
                         if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) {  
    $fname=$1;  
                            if   
                             ($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) {  
       $fmime=$1;  
                               $i++;  
    } else {  
                               $fmime='';  
                            }  
                         } else {  
     $fname='';  
                             $fmime='';  
                         }  
                         $i++;  
                     }  
                 } else {  
     $value.=$lines[$i]."\n";  
                 }                  }
             }              }
           }
   
           unless ($allowed) {
       $r->log_reason("Unauthorized $requrl", $r->filename); 
       return HTTP_NOT_ACCEPTABLE;
  }   }
             $r->method_number(M_GET);  
     $r->method('GET');  # -------------------------------------------------------- Load POST parameters
             $r->headers_in->unset('Content-length');  
    &Apache::lonacc::get_posted_cgi($r);
             return OK;   
         } else {    return OK; 
             $r->log_reason("Cookie $handle not valid", $r->filename)       } else {
         };   $r->log_reason("Cookie $handle not valid", $r->filename) 
     }      }
   
 # ----------------------------------------------- Store where they wanted to go  # ----------------------------------------------- Store where they wanted to go
   
     $ENV{'request.firsturl'}=$requrl;      $env{'request.firsturl'}=$requrl;
     return FORBIDDEN;      return FORBIDDEN;
 }  }
   
 1;  1;
 __END__  __END__
   
   
   
   
   
   
   
   
Removed from v.1.17  
changed lines
  Added in v.1.61

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