# The LearningOnline Network
# 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 $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# 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;

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,$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;
    $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;

	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); 
	    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__