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

Diff for /loncom/auth/loncacc.pm between versions 1.53 and 1.57

version 1.53, 2011/09/27 20:28:38 version 1.57, 2011/10/30 20:31:02
Line 42  Invoked (for various locations) by /etc/ Line 42  Invoked (for various locations) by /etc/
 =head1 INTRODUCTION  =head1 INTRODUCTION
   
 This module enables cookie based authentication for construction area  This module enables cookie based authentication for construction area
 and is used to control access for three (essentially equivalent) URIs.  and is used to control access for the following two types of URI 
   (one for files, and one for directories):
   
  <LocationMatch "^/priv.*">   <LocationMatch "^/priv.*">
  <LocationMatch "^/\~.*">   <LocationMatch "^/priv.*/$">
  <LocationMatch "^/\~.*/$">  
   
 Whenever the client sends the cookie back to the server,   Whenever the client sends the cookie back to the server, 
 if the cookie is missing or invalid, the user is re-challenged  if the cookie is missing or invalid, the user is re-challenged
Line 75  store where they wanted to go (first url Line 75  store where they wanted to go (first url
   
 =over  =over
   
 =item constructaccess($url,$ownerdomain)  =item constructaccess($url,$setpriv)
   
 See if the owner domain and name  See if the owner domain and name
 in the URL match those in the expected environment.  If so, return   in the URL match those in the expected environment.  If so, return 
 two element list ($ownername,$ownerdomain).  Else, return null string.  two element list ($ownername,$ownerdomain).  Else, return null string.
   If 'setpriv' is set to 'setpriv', it actually assigns the privileges.
 =back  =back
   
 =cut  =cut
Line 97  use Apache::lonacc; Line 97  use Apache::lonacc;
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
   
 sub constructaccess {  sub constructaccess {
     my ($url,$ownerdomain,$setpriv)=@_;      my ($url,$setpriv)=@_;
     my ($ownername)=($url=~/\/(?:\~|priv\/|home\/)($match_username)\//);  
     unless (($ownername) && ($ownerdomain)) { return ''; }  # We do not allow editing of previous versions of files
     # We do not allow editing of previous versions of files.  
     if ($url=~/\.(\d+)\.(\w+)$/) { return ''; }      if ($url=~/\.(\d+)\.(\w+)$/) { return ''; }
     my @possibledomains = &Apache::lonnet::current_machine_domains();  
     if ($ownername eq $env{'user.name'}) {  
  foreach my $domain (@possibledomains) {  
     if ($domain eq $env{'user.domain'}) {  
  return ($ownername,$domain);  
     }  
  }  
     }  
       
     foreach my $domain (@possibledomains) {  
  if (exists($env{'user.priv.ca./'.$domain.'/'.$ownername.'./'}) ||  
     exists($env{'user.priv.aa./'.$domain.'/'.$ownername.'./'}) ) {  
     return ($ownername,$domain);  
  }  
     }  
   
     my $then=$env{'user.login.time'};  # Get username and domain from URL
     my $update==$env{'user.update.time'};      my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
     if (!$update) {      my ($ownerdomain,$ownername)=($url=~ m{^(?:\Q$londocroot\E|)/priv/($match_domain)/($match_username)/});
         $update = $then;  
   # The URL does not really point to any authorspace, forget it
       unless (($ownername) && ($ownerdomain)) { return ''; }
     
   # Now we need to see if the user has access to the authorspace of
   # $ownername at $ownerdomain
   
       if (($ownername eq $env{'user.name'}) && ($ownerdomain eq $env{'user.domain'})) {
   # Real author for this?
          if (exists($env{'user.priv.au./'.$ownerdomain.'/./'})) {
             return ($ownername,$ownerdomain);
          }
       } else {
   # Co-author for this?
    if (exists($env{'user.priv.ca./'.$ownerdomain.'/'.$ownername.'./'}) ||
       exists($env{'user.priv.aa./'.$ownerdomain.'/'.$ownername.'./'}) ) {
       return ($ownername,$ownerdomain);
    }
     }      }
     my %dcroles = ();  # We don't have any access right now. If we are not possibly going to do anything about this,
     if (&is_active_dc($ownerdomain,$update)) {  # we might as well leave
      unless ($setpriv) { return ''; }
   
   # Backdoor access?
       my $allowed=&Apache::lonnet::allowed('eco',$ownerdomain);
   # Nope
       unless ($allowed) { return ''; }
   # Looks like we may have access, but could be locked by the owner of the construction space
       if ($allowed eq 'U') {
         my %blocked=&Apache::lonnet::get('environment',['domcoord.author'],          my %blocked=&Apache::lonnet::get('environment',['domcoord.author'],
                                          $ownerdomain,$ownername);                                           $ownerdomain,$ownername);
         unless ($blocked{'domcoord.author'} eq 'blocked') {  # Is blocked by owner
             if (grep(/^$ownerdomain$/,@possibledomains)) {          if ($blocked{'domcoord.author'} eq 'blocked') { return ''; }
                 if ($setpriv) {  
                     my $refresh=$env{'user.refresh.time'};  
                     if (!$refresh) {  
                         $refresh = $update;  
                     }  
                     my $now = time;  
                     &Apache::lonnet::check_adhoc_privs($ownerdomain,$ownername,  
                                                        $update,$refresh,$now,'ca',  
                                                        'constructaccess');  
                 }  
                 return($ownername,$ownerdomain);  
             }  
         }  
     }      }
     return '';      if (($allowed eq 'F') || ($allowed eq 'U')) {
 }  # Grant temporary access
           my $then=$env{'user.login.time'};
 sub is_active_dc {          my $update==$env{'user.update.time'};
     my ($ownerdomain,$update) = @_;          if (!$update) { $update = $then; }
     my $livedc;          my $refresh=$env{'user.refresh.time'};
     if ($env{'user.adv'}) {          if (!$refresh) { $refresh = $update; }
         my $domrole = $env{'user.role.dc./'.$ownerdomain.'/'};          my $now = time;
         if ($domrole) {          &Apache::lonnet::check_adhoc_privs($ownerdomain,$ownername,
             my ($tstart,$tend)=split(/\./,$domrole);                                             $update,$refresh,$now,'ca',
             $livedc = 1;                                             'constructaccess');
             if ($tstart && $tstart>$update) { undef($livedc); }          return($ownername,$ownerdomain);
             if ($tend   && $tend  <$update) { undef($livedc); }  
         }  
     }      }
     return $livedc;  # No business here
       return '';
 }  }
   
   
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
     my $requrl=$r->uri;      my $requrl=$r->uri;
Line 183  sub handler { Line 177  sub handler {
  $env{'request.state'}    = "construct";   $env{'request.state'}    = "construct";
  $env{'request.filename'} = $r->filename;   $env{'request.filename'} = $r->filename;
   
  unless (&constructaccess($requrl,$r->dir_config('lonDefDomain'),'setpriv')) {   unless (&constructaccess($requrl,'setpriv')) {
     $r->log_reason("Unauthorized $requrl", $r->filename);       $r->log_reason("Unauthorized $requrl", $r->filename); 
     return HTTP_NOT_ACCEPTABLE;      return HTTP_NOT_ACCEPTABLE;
  }   }
Removed from v.1.53  
changed lines
  Added in v.1.57

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