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

Diff for /loncom/auth/loncacc.pm between versions 1.31.4.1 and 1.48

version 1.31.4.1, 2004/02/10 19:23:11 version 1.48, 2008/11/19 17:38:21
Line 26 Line 26
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # YEAR=2000  
 # 6/15,16/11,22/11,  
 # YEAR=2001  
 # 01/06,01/11,6/1,9/25,9/28,11/22,12/25,12/26,  
 # 01/06/01,05/04,05/05,05/09 Gerd Kortemeyer  
 # YEAR=2002  
 # 1/4 Gerd Kortemeyer  
 ###  
   
 package Apache::loncacc;  =pod
   
 use strict;  
 use Apache::Constants qw(:common :http :methods REDIRECT);  
 use Apache::File;  
 use CGI::Cookie();  
 use Fcntl qw(:flock);  
 use Apache::lonlocal;  
 use Apache::lonnet();  
   
   
 sub constructaccess {  
     my ($url,$ownerdomain)=@_;  
     my ($ownername)=($url=~/\/(?:\~|priv\/|home\/)(\w+)/);  
     unless (($ownername) && ($ownerdomain)) { return ''; }  
     # We do not allow editing of previous versions of files.  
     if ($url=~/\.(\d+)\.(\w+)$/) { return ''; }  
     my @possibledomains = &Apache::lonnet::current_machine_domains();  
     &Apache::lonnet::logthis("got domains of ".join(':',@possibledomains));  
     if ($ownername eq $ENV{'user.name'}) {  
  foreach my $domain (@possibledomains) {  
     if ($domain eq $ENV{'user.domain'}) {  
  return ($ownername,$domain);  
     }  
  }  
     }  
       
   
     foreach my $domain (@possibledomains) {  
  my $capriv='user.priv.ca./'.$domain.'/'.$ownername.'./';  
  foreach (keys %ENV) {  
     if ($_ eq $capriv) {  
  return ($ownername,$domain);  
     }  
  }  
     }  
     return '';  
 }  
   
 sub handler {  
     my $r = shift;  
     my $requrl=$r->uri;  
     $ENV{'request.editurl'}=$requrl;  
     my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));  
     my $lonid=$cookies{'lonID'};  
     my $cookie;  
     if ($lonid) {  
  my $handle=$lonid->value;  
         $handle=~s/\W//g;  
         my $lonidsdir=$r->dir_config('lonIDsDir');  
         if ((-e "$lonidsdir/$handle.id") && ($handle ne '')) {  
   
 # ------------------------------------------------------ Initialize Environment  
   
             &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);  
   
 # --------------------------------------------------------- Initialize Language  
    
      &Apache::lonlocal::get_language_handle($r);  
   
 # -------------------------------------------------------------- Resource State  
   
             $ENV{'request.state'}    = "construct";  
             $ENV{'request.filename'} = $r->filename;  
   
             unless (&constructaccess($requrl,$r->dir_config('lonDefDomain'))) {  
                 $r->log_reason("Unauthorized $requrl", $r->filename);   
         return HTTP_NOT_ACCEPTABLE;  
             }  
 # Construction space needs Remote to work  
             if ($ENV{'environment.remote'} eq 'off') {  
         $r->content_type('text/html');  
                 $r->header_out(Location =>   
                     'http://'.$r->server->server_hostname.  
                     '/adm/remote?action=launch&url='.  
                     &Apache::lonnet::escape($requrl));  
                 return REDIRECT;  
             }  
   
 # -------------------------------------------------------- Load POST parameters  
   
     &Apache::loncommon::get_posted_cgi($r);  
   
             return OK;   
         } else {   
             $r->log_reason("Cookie $handle not valid", $r->filename)   
         };  
     }  
   
 # ----------------------------------------------- Store where they wanted to go  
   
     $ENV{'request.firsturl'}=$requrl;  
     return FORBIDDEN;  
 }  
   
 1;  
 __END__  
   
 =head1 NAME  =head1 NAME
   
Line 177  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 190  two element list ($ownername,$ownerdomai Line 86  two element list ($ownername,$ownerdomai
 =cut  =cut
   
   
   package Apache::loncacc;
   
   use strict;
   use Apache::Constants qw(:common :http :methods REDIRECT);
   use Fcntl qw(:flock);
   use Apache::lonlocal;
   use Apache::lonnet;
   use Apache::lonacc;
   use LONCAPA qw(:DEFAULT :match);
   
   sub constructaccess {
       my ($url,$ownerdomain)=@_;
       my ($ownername)=($url=~/\/(?:\~|priv\/|home\/)($match_username)\//);
       unless (($ownername) && ($ownerdomain)) { return ''; }
       # We do not allow editing of previous versions of files.
       if ($url=~/\.(\d+)\.(\w+)$/) { return ''; }
       my @possibledomains = &Apache::lonnet::current_machine_domains();
       if ($ownername eq $env{'user.name'}) {
    foreach my $domain (@possibledomains) {
       if ($domain eq $env{'user.domain'}) {
    return ($ownername,$domain);
       }
    }
       }
       
       foreach my $domain (@possibledomains) {
    if (exists($env{'user.priv.ca./'.$domain.'/'.$ownername.'./'}) ||
       exists($env{'user.priv.aa./'.$domain.'/'.$ownername.'./'}) ) {
       return ($ownername,$domain);
    }
       }
       return '';
   }
   
   sub handler {
       my $r = shift;
       my $requrl=$r->uri;
       $env{'request.editurl'}=$requrl;
   
       my $handle =  &Apache::lonnet::check_for_valid_session($r);
       if ($handle ne '') {
   
   # ------------------------------------------------------ Initialize Environment
           my $lonidsdir=$r->dir_config('lonIDsDir');
    &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
   
   # --------------------------------------------------------- Initialize Language
    
    &Apache::lonlocal::get_language_handle($r);
   
   # -------------------------------------------------------------- Resource State
   
    $env{'request.state'}    = "construct";
    $env{'request.filename'} = $r->filename;
   
    unless (&constructaccess($requrl,$r->dir_config('lonDefDomain'))) {
       $r->log_reason("Unauthorized $requrl", $r->filename); 
       return HTTP_NOT_ACCEPTABLE;
    }
   
   # -------------------------------------------------------- Load POST parameters
   
    &Apache::lonacc::get_posted_cgi($r);
   
    return OK; 
       } else { 
    $r->log_reason("Cookie $handle not valid", $r->filename) 
       }
   
   # ----------------------------------------------- Store where they wanted to go
   
       $env{'request.firsturl'}=$requrl;
       return FORBIDDEN;
   }
   
   1;
   __END__
   
   
   
   
   
   
Removed from v.1.31.4.1  
changed lines
  Added in v.1.48

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