--- loncom/auth/loncacc.pm 2003/05/13 00:52:46 1.28
+++ loncom/auth/loncacc.pm 2009/04/11 21:42:58 1.49
@@ -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.28 2003/05/13 00:52:46 www Exp $
+# $Id: loncacc.pm,v 1.49 2009/04/11 21:42:58 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -26,100 +26,8 @@
#
# 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;
-
-use strict;
-use Apache::Constants qw(:common :http :methods REDIRECT);
-use Apache::File;
-use CGI::Cookie();
-use Fcntl qw(:flock);
-
-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 ''; }
- if (($ownername eq $ENV{'user.name'}) &&
- ($ownerdomain eq $ENV{'user.domain'})) {
- return ($ownername,$ownerdomain);
- }
-
- my $capriv='user.priv.ca./'.
- $ownerdomain.'/'.$ownername.'./'.
- $ownerdomain.'/'.$ownername;
- foreach (keys %ENV) {
- if ($_ eq $capriv) {
- return ($ownername,$ownerdomain);
- }
- }
-
- 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);
-
-# -------------------------------------------------------------- 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__
+=pod
=head1 NAME
@@ -165,11 +73,11 @@ store where they wanted to go (first url
=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
two element list ($ownername,$ownerdomain). Else, return null string.
@@ -178,6 +86,119 @@ two element list ($ownername,$ownerdomai
=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,$setpriv)=@_;
+ 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);
+ }
+ }
+
+ 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 '';
+}
+
+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 {
+ 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')),'setpriv') {
+ $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__
+
+
+
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.