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

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

version 1.59, 2011/11/12 19:37:40 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   
 three element list ($ownername,$ownerdomain,$ownerhome).    
   
 Otherwise return the null string.  
   
 If second argument 'setpriv' is true, it assigns the privileges,  
 and returns the same three element list, unless the owner has  
 blocked "ad hoc" Domain Coordinator access to the Author Space,  
 in which case the null string is returned.  
   
 =back  
   
 =cut  =cut
   
   
Line 103  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 ($ownername,$ownerdomain,$ownerhome);  
   
     ($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?  
        $ownerhome = $env{'user.home'};  
        if (exists($env{'user.priv.au./'.$ownerdomain.'/./'})) {  
           return ($ownername,$ownerdomain,$ownerhome);  
        }  
     } else {  
 # Co-author for this?  
  if (exists($env{'user.priv.ca./'.$ownerdomain.'/'.$ownername.'./'}) ||  
     exists($env{'user.priv.aa./'.$ownerdomain.'/'.$ownername.'./'}) ) {  
     $ownerhome = &Apache::lonnet::homeserver($ownername,$ownerdomain);  
     return ($ownername,$ownerdomain,$ownerhome);  
  }  
     }  
 # 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');  
         $ownerhome = &Apache::lonnet::homeserver($ownername,$ownerdomain);  
         return($ownername,$ownerdomain,$ownerhome);  
     }  
 # No business here  
     return '';  
 }  
   
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
     my $requrl=$r->uri;      my $requrl=$r->uri;
Line 191  sub handler { Line 106  sub handler {
  $env{'request.filename'} = $r->filename;   $env{'request.filename'} = $r->filename;
   
  my $allowed;   my $allowed;
  my ($ownername,$ownerdom,$ownerhome) = &constructaccess($requrl,'setpriv');   my ($ownername,$ownerdom,$ownerhome) = 
               &Apache::lonnet::constructaccess($requrl,'setpriv');
         if (($ownername ne '') && ($ownerdom ne '') && ($ownerhome ne '')) {          if (($ownername ne '') && ($ownerdom ne '') && ($ownerhome ne '')) {
             unless ($ownerhome eq 'no_host') {              unless ($ownerhome eq 'no_host') {
                 my @hosts = &Apache::lonnet::current_machine_ids();                  my @hosts = &Apache::lonnet::current_machine_ids();
Removed from v.1.59  
changed lines
  Added in v.1.60

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