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

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

version 1.57, 2011/10/30 20:31:02 version 1.60, 2012/10/29 17:39:06
Line 71  store where they wanted to go (first url Line 71  store where they wanted to go (first url
   
 =back  =back
   
 =head1 OTHERSUBROUTINES  
   
 =over  
   
 =item constructaccess($url,$setpriv)  
   
 See if the owner domain and name  
 in the URL match those in the expected environment.  If so, return   
 two element list ($ownername,$ownerdomain).  Else, return null string.  
 If 'setpriv' is set to 'setpriv', it actually assigns the privileges.  
 =back  
   
 =cut  =cut
   
   
Line 96  use Apache::lonnet; Line 84  use Apache::lonnet;
 use Apache::lonacc;  use Apache::lonacc;
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
   
 sub constructaccess {  
     my ($url,$setpriv)=@_;  
   
 # We do not allow editing of previous versions of files  
     if ($url=~/\.(\d+)\.(\w+)$/) { return ''; }  
   
 # Get username and domain from URL  
     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};  
     my ($ownerdomain,$ownername)=($url=~ m{^(?:\Q$londocroot\E|)/priv/($match_domain)/($match_username)/});  
   
 # 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);  
  }  
     }  
 # We don't have any access right now. If we are not possibly going to do anything about this,  
 # 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'],  
                                          $ownerdomain,$ownername);  
 # Is blocked by owner  
         if ($blocked{'domcoord.author'} eq 'blocked') { return ''; }  
     }  
     if (($allowed eq 'F') || ($allowed eq 'U')) {  
 # Grant temporary access  
         my $then=$env{'user.login.time'};  
         my $update==$env{'user.update.time'};  
         if (!$update) { $update = $then; }  
         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);  
     }  
 # No business here  
     return '';  
 }  
   
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
     my $requrl=$r->uri;      my $requrl=$r->uri;
Line 177  sub handler { Line 105  sub handler {
  $env{'request.state'}    = "construct";   $env{'request.state'}    = "construct";
  $env{'request.filename'} = $r->filename;   $env{'request.filename'} = $r->filename;
   
  unless (&constructaccess($requrl,'setpriv')) {   my $allowed;
    my ($ownername,$ownerdom,$ownerhome) = 
               &Apache::lonnet::constructaccess($requrl,'setpriv');
           if (($ownername ne '') && ($ownerdom ne '') && ($ownerhome ne '')) {
               unless ($ownerhome eq 'no_host') {
                   my @hosts = &Apache::lonnet::current_machine_ids();
                   if (grep(/^\Q$ownerhome\E$/,@hosts)) {
                       $allowed = 1;
                   }
               }
           }
   
           unless ($allowed) {
     $r->log_reason("Unauthorized $requrl", $r->filename);       $r->log_reason("Unauthorized $requrl", $r->filename); 
     return HTTP_NOT_ACCEPTABLE;      return HTTP_NOT_ACCEPTABLE;
  }   }
Line 187  sub handler { Line 127  sub handler {
  &Apache::lonacc::get_posted_cgi($r);   &Apache::lonacc::get_posted_cgi($r);
   
  return OK;    return OK; 
     } else {       } else {
  $r->log_reason("Cookie $handle not valid", $r->filename)    $r->log_reason("Cookie $handle not valid", $r->filename) 
     }      }
   
Line 200  sub handler { Line 140  sub handler {
 1;  1;
 __END__  __END__
   
   
   
   
   
   
   
   
Removed from v.1.57  
changed lines
  Added in v.1.60

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