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

Diff for /loncom/auth/loncacc.pm between versions 1.18 and 1.27

version 1.18, 2001/12/21 16:57:54 version 1.27, 2003/05/06 21:45:25
Line 31 Line 31
 # YEAR=2001  # YEAR=2001
 # 01/06,01/11,6/1,9/25,9/28,11/22,12/25,12/26,  # 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  # 01/06/01,05/04,05/05,05/09 Gerd Kortemeyer
 # 12/21 Scott Harrison  # YEAR=2002
 #  # 1/4 Gerd Kortemeyer
 ###  ###
   
 package Apache::loncacc;  package Apache::loncacc;
   
 use strict;  use strict;
 use Apache::Constants qw(:common :http :methods);  use Apache::Constants qw(:common :http :methods REDIRECT);
 use Apache::File;  use Apache::File;
 use CGI::Cookie();  use CGI::Cookie();
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
Line 47  sub constructaccess { Line 47  sub constructaccess {
     my ($url,$ownerdomain)=@_;      my ($url,$ownerdomain)=@_;
     my ($ownername)=($url=~/\/(?:\~|priv\/|home\/)(\w+)/);      my ($ownername)=($url=~/\/(?:\~|priv\/|home\/)(\w+)/);
     unless (($ownername) && ($ownerdomain)) { return ''; }      unless (($ownername) && ($ownerdomain)) { return ''; }
       # We do not allow editing of previous versions of files.
       if ($url=~/\.(\d+)\.(\w+)$/) { return ''; }
     if (($ownername eq $ENV{'user.name'}) &&      if (($ownername eq $ENV{'user.name'}) &&
         ($ownerdomain eq $ENV{'user.domain'})) {          ($ownerdomain eq $ENV{'user.domain'})) {
  return ($ownername,$ownerdomain);   return ($ownername,$ownerdomain);
Line 68  sub constructaccess { Line 69  sub constructaccess {
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
     my $requrl=$r->uri;      my $requrl=$r->uri;
       $ENV{'request.editurl'}=$requrl;
     my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));      my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
     my $lonid=$cookies{'lonID'};      my $lonid=$cookies{'lonID'};
     my $cookie;      my $cookie;
Line 97  sub handler { Line 99  sub handler {
                 $r->log_reason("Unauthorized $requrl", $r->filename);                   $r->log_reason("Unauthorized $requrl", $r->filename); 
         return HTTP_NOT_ACCEPTABLE;          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  # -------------------------------------------------------- Load POST parameters
   
   
         my $buffer;          my $buffer;
   
         $r->read($buffer,$r->header_in('Content-length'));          $r->read($buffer,$r->header_in('Content-length'),0);
   
  unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {   unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {
             my @pairs=split(/&/,$buffer);              my @pairs=split(/&/,$buffer);
Line 114  sub handler { Line 125  sub handler {
                $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;                 $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                $name  =~ tr/+/ /;                 $name  =~ tr/+/ /;
                $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;                 $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                $ENV{"form.$name"}=$value;         &Apache::loncommon::add_to_env("form.$name",$value);
             }               } 
         } else {          } else {
     my $contentsep=$1;      my $contentsep=$1;
Line 134  sub handler { Line 145  sub handler {
                         } else {                          } else {
                             $value=~s/\s+$//s;                              $value=~s/\s+$//s;
                         }                          }
                         $ENV{"form.$name"}=$value;   &Apache::loncommon::add_to_env("form.$name",$value);
                     }                      }
                     if ($i<$#lines) {                      if ($i<$#lines) {
  $i++;   $i++;
Line 162  sub handler { Line 173  sub handler {
                 }                  }
             }              }
  }   }
               $ENV{'request.method'}=$ENV{'REQUEST_METHOD'};
             $r->method_number(M_GET);              $r->method_number(M_GET);
     $r->method('GET');      $r->method('GET');
             $r->headers_in->unset('Content-length');              $r->headers_in->unset('Content-length');
Line 187  Apache::lonacc - Cookie Based Access Han Line 199  Apache::lonacc - Cookie Based Access Han
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
 Invoked (for various locations) by /etc/httpd/conf/srm.conf:  Invoked (for various locations) by /etc/httpd/conf/loncapa_apache.conf:
   
  PerlAccessHandler       Apache::loncacc   PerlAccessHandler       Apache::loncacc
   
Removed from v.1.18  
changed lines
  Added in v.1.27

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