--- loncom/auth/loncacc.pm 2011/11/12 19:37:40 1.59 +++ loncom/auth/loncacc.pm 2012/10/29 17:39:06 1.60 @@ -2,7 +2,7 @@ # Cookie Based Access Handler for Construction Area # (lonacc: 5/21/99,5/22,5/29,5/31 Gerd Kortemeyer) # -# $Id: loncacc.pm,v 1.59 2011/11/12 19:37:40 raeburn Exp $ +# $Id: loncacc.pm,v 1.60 2012/10/29 17:39:06 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -71,25 +71,6 @@ store where they wanted to go (first url =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 @@ -103,72 +84,6 @@ use Apache::lonnet; use Apache::lonacc; 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 { my $r = shift; my $requrl=$r->uri; @@ -191,7 +106,8 @@ sub handler { $env{'request.filename'} = $r->filename; 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 '')) { unless ($ownerhome eq 'no_host') { my @hosts = &Apache::lonnet::current_machine_ids();