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

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

version 1.46, 2007/10/02 01:09:59 version 1.59, 2011/11/12 19:37:40
Line 27 Line 27
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
   
   =pod
   
   =head1 NAME
   
   Apache::lonacc - Cookie Based Access Handler for Construction Area
   
   =head1 SYNOPSIS
   
   Invoked (for various locations) by /etc/httpd/conf/loncapa_apache.conf:
   
    PerlAccessHandler       Apache::loncacc
   
   =head1 INTRODUCTION
   
   This module enables cookie based authentication for construction area
   and is used to control access for the following two types of URI 
   (one for files, and one for directories):
   
    <LocationMatch "^/priv.*">
    <LocationMatch "^/priv.*/$">
   
   Whenever the client sends the cookie back to the server, 
   if the cookie is missing or invalid, the user is re-challenged
   for login information.
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   =head1 HANDLER SUBROUTINE
   
   This routine is called by Apache and mod_perl.
   
   =over 4
   
   =item *
   
   load POST parameters
   
   =item *
   
   store where they wanted to go (first url entered)
   
   =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
   
   
 package Apache::loncacc;  package Apache::loncacc;
   
 use strict;  use strict;
Line 38  use Apache::lonacc; Line 104  use Apache::lonacc;
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
   
 sub constructaccess {  sub constructaccess {
     my ($url,$ownerdomain)=@_;      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'}) {  # Get username and domain from URL
  foreach my $domain (@possibledomains) {      my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
     if ($domain eq $env{'user.domain'}) {      my ($ownername,$ownerdomain,$ownerhome);
  return ($ownername,$domain);  
     }      ($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,
     foreach my $domain (@possibledomains) {  # we might as well leave
  if (exists($env{'user.priv.ca./'.$domain.'/'.$ownername.'./'}) ||     unless ($setpriv) { return ''; }
     exists($env{'user.priv.aa./'.$domain.'/'.$ownername.'./'}) ) {  
     return ($ownername,$domain);  # 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 '';      return '';
 }  }
   
Line 82  sub handler { Line 190  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'))) {   my $allowed;
    my ($ownername,$ownerdom,$ownerhome) = &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 92  sub handler { Line 211  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 105  sub handler { Line 224  sub handler {
 1;  1;
 __END__  __END__
   
 =head1 NAME  
   
 Apache::lonacc - Cookie Based Access Handler for Construction Area  
   
 =head1 SYNOPSIS  
   
 Invoked (for various locations) by /etc/httpd/conf/loncapa_apache.conf:  
   
  PerlAccessHandler       Apache::loncacc  
   
 =head1 INTRODUCTION  
   
 This module enables cookie based authentication for construction area  
 and is used to control access for three (essentially equivalent) URIs.  
   
  <LocationMatch "^/priv.*">  
  <LocationMatch "^/\~.*">  
  <LocationMatch "^/\~.*/$">  
   
 Whenever the client sends the cookie back to the server,   
 if the cookie is missing or invalid, the user is re-challenged  
 for login information.  
   
 This is part of the LearningOnline Network with CAPA project  
 described at http://www.lon-capa.org.  
   
 =head1 HANDLER SUBROUTINE  
   
 This routine is called by Apache and mod_perl.  
   
 =over 4  
   
 =item *  
   
 load POST parameters  
   
 =item *  
   
 store where they wanted to go (first url entered)  
   
 =back  
   
 =head1 OTHERSUBROUTINES  
   
 =over 4  
   
 =item *  
   
 constructaccess($url,$ownerdomain) : 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.  
   
 =back  
   
 =cut  
   
   
   
   
   
   
   
Removed from v.1.46  
changed lines
  Added in v.1.59

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