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

Diff for /loncom/auth/lonacc.pm between versions 1.37 and 1.61

version 1.37, 2002/11/06 22:43:27 version 1.61, 2005/02/07 23:37:44
Line 32 Line 32
 # 12/25,12/26,  # 12/25,12/26,
 # YEAR=2001  # YEAR=2001
 # 01/06/01,05/28,8/11,9/26,11/29 Gerd Kortemeyer  # 01/06/01,05/28,8/11,9/26,11/29 Gerd Kortemeyer
 # 12/15 Scott Harrison  
 # YEAR=2002  # YEAR=2002
 # 1/4,2/25 Gerd Kortemeyer  # 1/4,2/25 Gerd Kortemeyer
 #  #
Line 45  use Apache::Constants qw(:common :http : Line 44  use Apache::Constants qw(:common :http :
 use Apache::File;  use Apache::File;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon();  use Apache::loncommon();
   use Apache::lonlocal;
 use CGI::Cookie();  use CGI::Cookie();
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
   
Line 60  sub handler { Line 60  sub handler {
         my $lonidsdir=$r->dir_config('lonIDsDir');          my $lonidsdir=$r->dir_config('lonIDsDir');
         if ((-e "$lonidsdir/$handle.id") && ($handle ne '')) {          if ((-e "$lonidsdir/$handle.id") && ($handle ne '')) {
   
 # ------------------------------------------- Transfer profile into environment  # ------------------------------------------------------ Initialize Environment
   
             my @profile;              &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
     {  
              my $idf=Apache::File->new("$lonidsdir/$handle.id");  # --------------------------------------------------------- Initialize Language
              flock($idf,LOCK_SH);  
              @profile=<$idf>;      &Apache::lonlocal::get_language_handle($r);
              $idf->close();  
     }  # -------------------------------------------------------------- Resource State
             my $envi;  
             for ($envi=0;$envi<=$#profile;$envi++) {              if ($requrl=~/^\/+(res|uploaded)\//) {
  chomp($profile[$envi]);  
  my ($envname,$envvalue)=split(/=/,$profile[$envi]);  
                 $ENV{$envname} = $envvalue;  
             }  
             $ENV{'user.environment'} = "$lonidsdir/$handle.id";  
             if ($requrl=~/^\/res\//) {  
                $ENV{'request.state'} = "published";                 $ENV{'request.state'} = "published";
     } else {      } else {
        $ENV{'request.state'} = 'unknown';         $ENV{'request.state'} = 'unknown';
             }              }
             $ENV{'request.filename'} = $r->filename;              $ENV{'request.filename'} = $r->filename;
               $ENV{'request.noversionuri'} = &Apache::lonnet::deversion($requrl);
 # -------------------------------------------------------- Load POST parameters  # -------------------------------------------------------- Load POST parameters
   
       &Apache::loncommon::get_posted_cgi($r);
              
         my $buffer;  
   
         $r->read($buffer,$r->header_in('Content-length'));  
  unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {  
             my @pairs=split(/&/,$buffer);  
             my $pair;  
             foreach $pair (@pairs) {  
                my ($name,$value) = split(/=/,$pair);  
                $value =~ tr/+/ /;  
                $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  
                $name  =~ tr/+/ /;  
                $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  
        &Apache::loncommon::add_to_env("form.$name",$value);  
             }  
         } else {  
     my $contentsep=$1;  
             my @lines = split (/\n/,$buffer);  
             my $name='';  
             my $value='';  
             my $fname='';  
             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;  
                         }  
  &Apache::loncommon::add_to_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";  
                 }  
             }  
  }  
     $ENV{'request.method'}=$ENV{'REQUEST_METHOD'};  
             $r->method_number(M_GET);  
     $r->method('GET');  
             $r->headers_in->unset('Content-length');  
   
 # ---------------------------------------------------------------- Check access  # ---------------------------------------------------------------- Check access
   
Line 177  sub handler { Line 106  sub handler {
           if ($ENV{'request.course.id'}) {            if ($ENV{'request.course.id'}) {
     &Apache::lonnet::countacc($requrl);      &Apache::lonnet::countacc($requrl);
             $requrl=~/\.(\w+)$/;              $requrl=~/\.(\w+)$/;
             if (&Apache::loncommon::fileembstyle($1) eq 'ssi') {              if ((&Apache::loncommon::fileembstyle($1) eq 'ssi') ||
    ($requrl=~/^\/adm\/.*\/(aboutme|navmaps|smppg|bulletinboard)(\?|$)/) ||
    ($requrl=~/^\/adm\/wrapper\//) ||
    ($requrl=~m|\.problem/smpedit$|) ||
    ($requrl=~/^\/public\/.*\/syllabus$/)) {
 # ------------------------------------- This is serious stuff, get symb and log  # ------------------------------------- This is serious stuff, get symb and log
  my $query=$r->args;   my $query=$r->args;
                 my $symb;                  my $symb;
Line 186  sub handler { Line 119  sub handler {
                 }                  }
                 if ($ENV{'form.symb'}) {                  if ($ENV{'form.symb'}) {
     $symb=&Apache::lonnet::symbclean($ENV{'form.symb'});      $symb=&Apache::lonnet::symbclean($ENV{'form.symb'});
                     if (&Apache::lonnet::symbverify($symb,$requrl)) {                      if ($requrl =~ m|^/adm/wrapper/|) {
                       my ($map,$mid,$murl)=split(/\_\_\_/,$symb);                          my ($map,$mid,$murl)=&Apache::lonnet::decode_symb($symb);
                           &Apache::lonnet::symblist($map,$murl => $mid,
                                                  'last_known' => $murl);
                       } elsif ((&Apache::lonnet::symbverify($symb,$requrl)) ||
        (($requrl=~m|(.*)/smpedit$|) &&
         &Apache::lonnet::symbverify($symb,$1))) {
                         my ($map,$mid,$murl)=&Apache::lonnet::decode_symb($symb);
                       &Apache::lonnet::symblist($map,$murl => $mid,                        &Apache::lonnet::symblist($map,$murl => $mid,
                                                'last_known' => $murl);                                                 'last_known' => $murl);
     } else {      } else {
Line 198  sub handler { Line 137  sub handler {
                  return HTTP_NOT_ACCEPTABLE;                    return HTTP_NOT_ACCEPTABLE; 
                     }                      }
                 } else {                  } else {
             $symb=&Apache::lonnet::symbread;              $symb=&Apache::lonnet::symbread($requrl);
       if (&Apache::lonnet::is_on_map($requrl) && $symb &&
    !&Apache::lonnet::symbverify($symb,$requrl)) {
    $r->log_reason('Invalid symb for '.$requrl.': '.$symb);
           $ENV{'user.error.msg'}=
                                   "$requrl:bre:1:1:Invalid Access";
                    return HTTP_NOT_ACCEPTABLE; 
       }
       if ($symb) {
    my ($map,$mid,$murl)=split(/\_\_\_/,$symb);
    &Apache::lonnet::symblist($map,$murl => $mid,
     'last_known' => $murl);
       }
                 }                  }
                 $ENV{'request.symb'}=$symb;                  $ENV{'request.symb'}=$symb;
                 &Apache::lonnet::courseacclog($symb);                  &Apache::lonnet::courseacclog($symb);
Line 217  sub handler { Line 168  sub handler {
     if ($requrl=~m|^/public/|      if ($requrl=~m|^/public/|
  || (&Apache::lonnet::metadata($requrl,'copyright') eq 'public')) {   || (&Apache::lonnet::metadata($requrl,'copyright') eq 'public')) {
         &Apache::lonnet::logthis('Granting public access: '.$requrl);          &Apache::lonnet::logthis('Granting public access: '.$requrl);
    &Apache::loncommon::get_posted_cgi($r);
  $ENV{'user.name'}='public';   $ENV{'user.name'}='public';
         $ENV{'user.domain'}='public';          $ENV{'user.domain'}='public';
         $ENV{'request.state'} = "published";          $ENV{'request.state'} = "published";
         $ENV{'request.publicaccess'} = 1;          $ENV{'request.publicaccess'} = 1;
         $ENV{'request.filename'} = $r->filename;          $ENV{'request.filename'} = $r->filename;
    my ($httpbrowser,  $clientbrowser, $clientversion,
       $clientmathml, $clientunicode, $clientos) =
    &Apache::loncommon::decode_user_agent($r);
    $ENV{'browser.type'}=$clientbrowser;
           $ENV{'browser.version'}=$clientversion;
           $ENV{'browser.mathml'}=$clientmathml;
           $ENV{'browser.unicode'}=$clientunicode;
           $ENV{'browser.os'}=$clientos;
   
         return OK;          return OK;
     }      }
 # -------------------------------------------------------------- Not authorized  # -------------------------------------------------------------- Not authorized
     $requrl=~/\.(\w+)$/;      $requrl=~/\.(\w+)$/;
     if ((&Apache::loncommon::fileembstyle($1) eq 'ssi') ||      if ((&Apache::loncommon::fileembstyle($1) eq 'ssi') ||
         ($requrl=~/^\/adm\/(roles|logout)/) ||          ($requrl=~/^\/adm\/(roles|logout|email|menu|remote)/) ||
         ($requrl=~m|^/prtspool/|)) {          ($requrl=~m|^/prtspool/|)) {
 # -------------------------- Store where they wanted to go and get login screen  # -------------------------- Store where they wanted to go and get login screen
        $ENV{'request.firsturl'}=$requrl;   $ENV{'request.querystring'}=$r->args;
    $ENV{'request.firsturl'}=$requrl;
        return FORBIDDEN;         return FORBIDDEN;
    } else {     } else {
 # --------------------------------------------------------------------- Goodbye  # --------------------------------------------------------------------- Goodbye
Removed from v.1.37  
changed lines
  Added in v.1.61

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