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

Diff for /loncom/auth/loncacc.pm between versions 1.47 and 1.49

version 1.47, 2008/11/12 20:01:09 version 1.49, 2009/04/11 21:42:58
Line 73  store where they wanted to go (first url Line 73  store where they wanted to go (first url
   
 =head1 OTHERSUBROUTINES  =head1 OTHERSUBROUTINES
   
 =over 4  =over
   
 =item *  =item constructaccess($url,$ownerdomain)
   
 constructaccess($url,$ownerdomain) : 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.
   
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)=@_;      my ($url,$ownerdomain,$setpriv)=@_;
     my ($ownername)=($url=~/\/(?:\~|priv\/|home\/)($match_username)\//);      my ($ownername)=($url=~/\/(?:\~|priv\/|home\/)($match_username)\//);
     unless (($ownername) && ($ownerdomain)) { return ''; }      unless (($ownername) && ($ownerdomain)) { return ''; }
     # We do not allow editing of previous versions of files.      # We do not allow editing of previous versions of files.
Line 117  sub constructaccess { Line 117  sub constructaccess {
     return ($ownername,$domain);      return ($ownername,$domain);
  }   }
     }      }
   
       my $then=$env{'user.login.time'};
       my %dcroles = ();
       if (&is_active_dc($ownerdomain,$then)) {
           my %blocked=&Apache::lonnet::get('environment',['domcoord.author'],
                                            $ownerdomain,$ownername);
           unless ($blocked{'domcoord.author'} eq 'blocked') {
               if (grep(/^$ownerdomain$/,@possibledomains)) {
                   if ($setpriv) {
                       my $now = time;
                       &Apache::lonnet::check_adhoc_privs($ownerdomain,$ownername,
                                                          $then,$now,'ca');
                   }
                   return($ownername,$ownerdomain);
               }
           }
       }
     return '';      return '';
 }  }
   
   sub is_active_dc {
       my ($ownerdomain,$then) = @_;
       my $livedc;
       if ($env{'user.adv'}) {
           my $domrole = $env{'user.role.dc./'.$ownerdomain.'/'};
           if ($domrole) {
               my ($tstart,$tend)=split(/\./,$domrole);
               $livedc = 1;
               if ($tstart && $tstart>$then) { undef($livedc); }
               if ($tend   && $tend  <$then) { undef($livedc); }
           }
       }
       return $livedc;
   }
   
   
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
     my $requrl=$r->uri;      my $requrl=$r->uri;
Line 141  sub handler { Line 174  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'))) {   unless (&constructaccess($requrl,$r->dir_config('lonDefDomain')),'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.47  
changed lines
  Added in v.1.49

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