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

Diff for /loncom/auth/lonacc.pm between versions 1.60.2.1 and 1.109

version 1.60.2.1, 2005/02/21 18:22:04 version 1.109, 2007/04/26 18:31:53
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # YEAR=1999  
 # 5/21/99,5/22,5/29,5/31,6/15,16/11,22/11,  
 # YEAR=2000  
 # 01/06,01/13,05/31,06/01,09/06,09/25,09/28,10/30,11/6,  
 # 12/25,12/26,  
 # YEAR=2001  
 # 01/06/01,05/28,8/11,9/26,11/29 Gerd Kortemeyer  
 # YEAR=2002  
 # 1/4,2/25 Gerd Kortemeyer  
 #  
 ###  ###
   
 package Apache::lonacc;  package Apache::lonacc;
Line 45  use Apache::File; Line 35  use Apache::File;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon();  use Apache::loncommon();
 use Apache::lonlocal;  use Apache::lonlocal;
   use Apache::restrictedaccess();
   use Apache::blockedaccess(); 
 use CGI::Cookie();  use CGI::Cookie();
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
   use LONCAPA;
   
   sub cleanup {
       my ($r)=@_;
       if (! $r->is_initial_req()) { return DECLINED; }
       &Apache::lonnet::save_cache();
       &Apache::lontexconvert::jsMath_reset();
       return OK;
   }
   
   sub goodbye {
       my ($r)=@_;
       &Apache::lonnet::goodbye();
       return DONE;
   }
   
   ###############################################
   
   sub get_posted_cgi {
       my ($r) = @_;
   
       my $buffer;
       if ($r->header_in('Content-length')) {
    $r->read($buffer,$r->header_in('Content-length'),0);
       }
       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";
       }
    }
       }
   #
   # Digested POSTed values
   #
   # Remember the way this was originally done (GET or POST)
   #
       $env{'request.method'}=$ENV{'REQUEST_METHOD'};
   #
   # There may also be stuff in the query string
   # Tell subsequent handlers that this was GET, not POST, so they can access query string.
   # Also, unset POSTed content length to cover all tracks.
   #
   
       $r->method_number(M_GET);
   
       $r->method('GET');
       $r->headers_in->unset('Content-length');
   }
   
   # handle the case of the single sign on user, at this point $r->user 
   # will be set and valid now need to find the loncapa user info and possibly
   # balance them
   # returns OK if it was a SSO and user was handled
   #         undef if not SSO or no means to hanle the user
   sub sso_login {
       my ($r,$lonid,$handle) = @_;
   
       my $lonidsdir=$r->dir_config('lonIDsDir');
       if (!($r->user 
     && (!defined($env{'user.name'}) && !defined($env{'user.domain'}))
     && (!$lonid || !-e "$lonidsdir/$handle.id" || $handle eq ''))) {
    # not an SSO case or already logged in
    return undef;
       }
   
       my ($user) = ($r->user =~ m/([a-zA-Z0-9_\-@.]*)/);
   
       my $domain = $r->dir_config('lonDefDomain');
       my $home=&Apache::lonnet::homeserver($user,$domain);
       if ($home !~ /(con_lost|no_host|no_such_host)/) {
    &Apache::lonnet::logthis(" SSO authorized user $user ");
    if ($r->dir_config("lonBalancer") eq 'yes') {
       # login but immeaditly go to switch server to find us a new 
       # machine
       &Apache::lonauth::success($r,$user,$domain,$home,'noredirect');
               $env{'request.sso.login'} = 1;
               if (defined($r->dir_config("lonSSOReloginServer"))) {
                   $env{'request.sso.reloginserver'} =
                       $r->dir_config('lonSSOReloginServer');
               }
       $r->internal_redirect('/adm/switchserver');
       $r->set_handlers('PerlHandler'=> undef);
    } else {
       # need to login them in, so generate the need data that
       # migrate expects to do login
       my %info=('ip'        => $r->connection->remote_ip(),
         'domain'    => $domain,
         'username'  => $user,
         'server'    => $r->dir_config('lonHostID'),
         'sso.login' => 1
         );
               if (defined($r->dir_config("lonSSOReloginServer"))) {
                   $info{'sso.reloginserver'} = 
                       $r->dir_config('lonSSOReloginServer'); 
               }
       my $token = 
    &Apache::lonnet::tmpput(\%info,
    $r->dir_config('lonHostID'));
       $env{'form.token'} = $token;
       $r->internal_redirect('/adm/migrateuser');
       $r->set_handlers('PerlHandler'=> undef);
    }
    return OK;
       } elsif (defined($r->dir_config('lonSSOUserUnknownRedirect'))) {
    &Apache::lonnet::logthis(" SSO authorized unknown user $user ");
           $r->subprocess_env->set('SSOUserUnknown' => $user);
           $r->subprocess_env->set('SSOUserDomain' => $domain);
    $r->internal_redirect($r->dir_config('lonSSOUserUnknownRedirect'));
    $r->set_handlers('PerlHandler'=> undef);
    return OK;
       }
       return undef;
   }
   
 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'));      if (&Apache::lonnet::is_domainimage($requrl)) {
     if ($r->header_in('User-Agent')=~/NSDL\_Search\_Bot/) {          return OK;
        return OK;  
     }      }
       my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
     my $lonid=$cookies{'lonID'};      my $lonid=$cookies{'lonID'};
     my $cookie;      my $cookie;
       my $lonidsdir=$r->dir_config('lonIDsDir');
   
       my $handle;
     if ($lonid) {      if ($lonid) {
  my $handle=$lonid->value;   $handle=&LONCAPA::clean_handle($lonid->value);
         $handle=~s/\W//g;      }
         my $lonidsdir=$r->dir_config('lonIDsDir');  
         if ((-e "$lonidsdir/$handle.id") && ($handle ne '')) {      my $result = &sso_login($r,$lonid,$handle);
       if (defined($result)) {
    return $result
       }
   
   
       if ($r->dir_config("lonBalancer") eq 'yes') {
    $r->set_handlers('PerlResponseHandler'=>
    [\&Apache::switchserver::handler]);
       }
       
       if ($handle eq '') {
    $r->log_reason("Cookie $handle not valid", $r->filename); 
       } elsif ((-e "$lonidsdir/$handle.id") && ($handle ne '')) {
   
 # ------------------------------------------------------ Initialize Environment  # ------------------------------------------------------ Initialize Environment
   
             &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);   &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
   
 # --------------------------------------------------------- Initialize Language  # --------------------------------------------------------- Initialize Language
   
     &Apache::lonlocal::get_language_handle($r);   &Apache::lonlocal::get_language_handle($r);
   
       }
   
   # -------------------------------------------------- Should be a valid user now
       if ($env{'user.name'} ne '' && $env{'user.domain'} ne '') {
 # -------------------------------------------------------------- Resource State  # -------------------------------------------------------------- Resource State
   
             if ($requrl=~/^\/+(res|uploaded)\//) {   if ($requrl=~/^\/+(res|uploaded)\//) {
                $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);   $env{'request.noversionuri'} = &Apache::lonnet::deversion($requrl);
 # -------------------------------------------------------- Load POST parameters  # -------------------------------------------------------- Load POST parameters
   
     &Apache::loncommon::get_posted_cgi($r);   &Apache::lonacc::get_posted_cgi($r);
   
 # ---------------------------------------------------------------- Check access  # ---------------------------------------------------------------- Check access
    my $now = time;
             if ($requrl!~/^\/adm|public|prtspool\//) {   if ($requrl !~ m{^/(?:adm|public|prtspool)/}
  my $access=&Apache::lonnet::allowed('bre',$requrl);      || $requrl =~ /^\/adm\/.*\/(smppg|bulletinboard)(\?|$ )/x) {
                 if ($access eq '1') {      my $access=&Apache::lonnet::allowed('bre',$requrl);
    $ENV{'user.error.msg'}="$requrl:bre:0:0:Choose Course";      if ($access eq '1') {
            return HTTP_NOT_ACCEPTABLE;    $env{'user.error.msg'}="$requrl:bre:0:0:Choose Course";
                 }   return HTTP_NOT_ACCEPTABLE; 
                 if (($access ne '2') && ($access ne 'F')) {      }
    $ENV{'user.error.msg'}="$requrl:bre:1:1:Access Denied";      if ($access eq 'A') {
            return HTTP_NOT_ACCEPTABLE;    &Apache::restrictedaccess::setup_handler($r);
                 }   return OK;
       }
               if ($access eq 'B') {
                   &Apache::blockedaccess::setup_handler($r);
                   return OK;
             }              }
     if ($requrl =~ m|^/prtspool/|) {      if (($access ne '2') && ($access ne 'F')) {
  my $start='/prtspool/'.$ENV{'user.name'}.'_'.   $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
     $ENV{'user.domain'};   return HTTP_NOT_ACCEPTABLE; 
  if ($requrl !~ /^\Q$start\E/) {  
     $ENV{'user.error.msg'}="$requrl:bre:1:1:Access Denied";  
     return HTTP_NOT_ACCEPTABLE;  
  }  
     }      }
    }
    if ($requrl =~ m|^/prtspool/|) {
       my $start='/prtspool/'.$env{'user.name'}.'_'.
    $env{'user.domain'};
       if ($requrl !~ /^\Q$start\E/) {
    $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
    return HTTP_NOT_ACCEPTABLE;
       }
    }
    if ($requrl =~ m|^/zipspool/|) {
       my $start='/zipspool/zipout/'.$env{'user.name'}.
    $env{'user.domain'};
       if ($requrl !~ /^\Q$start\E/) {
    $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
    return HTTP_NOT_ACCEPTABLE;
       }
    }
    if ($env{'user.name'} eq 'public' && 
       $env{'user.domain'} eq 'public' &&
       $requrl !~ m{^/+(res|public|uploaded)/} &&
       $requrl !~ m{^/adm/[^/]+/[^/]+/aboutme/portfolio$ }x &&
       $requrl !~ m{^/+adm/(help|logout|restrictedaccess|randomlabel\.png)}) {
       $env{'request.querystring'}=$r->args;
       $env{'request.firsturl'}=$requrl;
       return FORBIDDEN;
    }
 # ------------------------------------------------------------- This is allowed  # ------------------------------------------------------------- This is allowed
           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\/.*\/(aboutme|navmaps|smppg|bulletinboard)(\?|$ )/x) ||
  ($requrl=~/^\/adm\/wrapper\//) ||   ($requrl=~/^\/adm\/wrapper\//) ||
  ($requrl=~m|\.problem/smpedit$|) ||   ($requrl=~m|^/adm/coursedocs/showdoc/|) ||
  ($requrl=~/^\/public\/.*\/syllabus$/)) {   ($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;
                 if ($query) {   if ($query) {
     &Apache::loncommon::get_unprocessed_cgi($query,['symb']);      &Apache::loncommon::get_unprocessed_cgi($query,['symb']);
                 }   }
                 if ($ENV{'form.symb'}) {   if ($env{'form.symb'}) {
     $symb=&Apache::lonnet::symbclean($ENV{'form.symb'});      $symb=&Apache::lonnet::symbclean($env{'form.symb'});
                     if ($requrl =~ m|^/adm/wrapper/|) {      if ($requrl =~ m|^/adm/wrapper/|
                         my ($map,$mid,$murl)=&Apache::lonnet::decode_symb($symb);   || $requrl =~ m|^/adm/coursedocs/showdoc/|) {
                         &Apache::lonnet::symblist($map,$murl => $mid,   my ($map,$mid,$murl)=&Apache::lonnet::decode_symb($symb);
                                                'last_known' => $murl);   &Apache::lonnet::symblist($map,$murl => [$murl,$mid],
                     } elsif ((&Apache::lonnet::symbverify($symb,$requrl)) ||    'last_known' =>[$murl,$mid]);
       } elsif ((&Apache::lonnet::symbverify($symb,$requrl)) ||
      (($requrl=~m|(.*)/smpedit$|) &&       (($requrl=~m|(.*)/smpedit$|) &&
       &Apache::lonnet::symbverify($symb,$1))) {        &Apache::lonnet::symbverify($symb,$1))) {
                       my ($map,$mid,$murl)=&Apache::lonnet::decode_symb($symb);   my ($map,$mid,$murl)=&Apache::lonnet::decode_symb($symb);
                       &Apache::lonnet::symblist($map,$murl => $mid,   &Apache::lonnet::symblist($map,$murl => [$murl,$mid],
                                                'last_known' => $murl);    'last_known' =>[$murl,$mid]);
     } else {      } else {
  $r->log_reason('Invalid symb for '.$requrl.': '.   $r->log_reason('Invalid symb for '.$requrl.': '.
                                        $symb);         $symb);
         $ENV{'user.error.msg'}=   $env{'user.error.msg'}=
                                 "$requrl:bre:1:1:Invalid Access";      "$requrl:bre:1:1:Invalid Access";
                  return HTTP_NOT_ACCEPTABLE;    return HTTP_NOT_ACCEPTABLE; 
                     }      }
                 } else {   } else {
             $symb=&Apache::lonnet::symbread($requrl);      $symb=&Apache::lonnet::symbread($requrl);
     if (&Apache::lonnet::is_on_map($requrl) && $symb &&      if (&Apache::lonnet::is_on_map($requrl) && $symb &&
  !&Apache::lonnet::symbverify($symb,$requrl)) {   !&Apache::lonnet::symbverify($symb,$requrl)) {
  $r->log_reason('Invalid symb for '.$requrl.': '.$symb);   $r->log_reason('Invalid symb for '.$requrl.': '.$symb);
         $ENV{'user.error.msg'}=   $env{'user.error.msg'}=
                                 "$requrl:bre:1:1:Invalid Access";      "$requrl:bre:1:1:Invalid Access";
                  return HTTP_NOT_ACCEPTABLE;    return HTTP_NOT_ACCEPTABLE; 
     }      }
                     my ($map,$mid,$murl)=split(/\_\_\_/,$symb);      if ($symb) {
     &Apache::lonnet::symblist($map,$murl => $mid,   my ($map,$mid,$murl)=
                                               'last_known' => $murl);      &Apache::lonnet::decode_symb($symb);
                 }   &Apache::lonnet::symblist($map,$murl =>[$murl,$mid],
                 $ENV{'request.symb'}=$symb;    'last_known' =>[$murl,$mid]);
                 &Apache::lonnet::courseacclog($symb);      }
             } else {   }
    $env{'request.symb'}=$symb;
    &Apache::lonnet::courseacclog($symb);
       } else {
 # ------------------------------------------------------- This is other content  # ------------------------------------------------------- This is other content
                 &Apache::lonnet::courseacclog($requrl);       &Apache::lonnet::courseacclog($requrl);    
             }      }
   }   }
             return OK;    return OK;
         } else {   
             $r->log_reason("Cookie $handle not valid", $r->filename)   
         };  
     }      }
   
 # -------------------------------------------- See if this is a public resource  # -------------------------------------------- See if this is a public resource
     if ($requrl=~m|^/public/|      if ($requrl=~m|^/+adm/+help/+|) {
  || (&Apache::lonnet::metadata($requrl,'copyright') eq 'public')) {    return OK;
         &Apache::lonnet::logthis('Granting public access: '.$requrl);      }
  &Apache::loncommon::get_posted_cgi($r);  # ------------------------------------ See if this is a viewable portfolio file
  $ENV{'user.name'}='public';      if (&Apache::lonnet::is_portfolio_url($requrl)) {
         $ENV{'user.domain'}='public';   my $access=&Apache::lonnet::allowed('bre',$requrl);
         $ENV{'request.state'} = "published";   if ($access eq 'A') {
         $ENV{'request.publicaccess'} = 1;      &Apache::restrictedaccess::setup_handler($r);
         $ENV{'request.filename'} = $r->filename;      return OK;
  my ($httpbrowser,  $clientbrowser, $clientversion,   }
     $clientmathml, $clientunicode, $clientos) =   if (($access ne '2') && ($access ne 'F')) {
  &Apache::loncommon::decode_user_agent($r);      $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
  $ENV{'browser.type'}=$clientbrowser;      return HTTP_NOT_ACCEPTABLE;
         $ENV{'browser.version'}=$clientversion;   }
         $ENV{'browser.mathml'}=$clientmathml;  
         $ENV{'browser.unicode'}=$clientunicode;  
         $ENV{'browser.os'}=$clientos;  
   
         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|email|menu|remote)/) ||  #        ($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.querystring'}=$r->args;   $env{'request.querystring'}=$r->args;
  $ENV{'request.firsturl'}=$requrl;   $env{'request.firsturl'}=$requrl;
        return FORBIDDEN;         return FORBIDDEN;
 #   } else {  #   } else {
 # --------------------------------------------------------------------- Goodbye  # --------------------------------------------------------------------- Goodbye
Removed from v.1.60.2.1  
changed lines
  Added in v.1.109

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.