# The LearningOnline Network
# Authorization Handler for webDAV access to Authoring Space. 
#
# $Id: lonwebdavacc.pm,v 1.2 2014/06/23 20:27:46 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::lonwebdavacc - webDAV Authorization Handler

=head1 SYNOPSIS

Invoked for /+webdav/[\w\-]+/[\w\-]+/ by
/etc/httpd/conf/loncapa_apache.conf:

PerlAccessHandler       Apache::lonwebdavacc

=head1 INTRODUCTION

This module enables authorization for authoring space
and is used to control access for the following type of URI:

 <LocationMatch "^/webdav/[\w\-]+/[\w\-]+>

This module is only called following successful authentication. 
Unless lonOtherAuthen has been set, so Single Sign On can be used,
successful authentication will have created a session file and
transferred the contents to the user's environment.

In the case of SSO, there is no existing user environment, but  
$r->user will have been set to the user's username, following 
successful authentication.  For SSO, the webDAV session file
and environment are set up by a call to 
Apache::lonwebdavauth::init_webdav_env().

Note: because Apache Basic Auth is used for authentication (unless SSO)
webDAV access is only available for servers running Apache with SSL.

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 *

Checks if $env{'user.environment'} is defined.

=item *

If no %env, this was SSO authentication so call to &sso_login() to
create session, and return cookie. 

=item *

Checks if requested URL (of form /webdav/authordomain/authorname) is valid
and whether authenticated user has an active author or co-author
role in the corresonding Author Space. 

=back

=head1 NOTABLE SUBROUTINES

=over

=item * sso_login()

=over 

=item *

Called if no user.environment exists in %env.

=item *

Checks if $r->user contains a valid user.

=item *

Domain is set either from lonSSOUserDomain perlvar (if defined)
or from lonDefDomain perlvar.
 
=item *

For a valid user a new session file and is created, and the corresponding 
cookie is returned to the client in an Apache response header.

=back

=back

=cut

package Apache::lonwebdavacc;

use strict;
use GDBM_File;
use Apache::Constants qw(:common :http :methods);
use Apache::lonnet;
use Apache::londiff();
use LONCAPA qw(:DEFAULT :match);

sub handler {
    my $r = shift;
    my $timetolive = 600;
    my $now = time;
    my $sessiondir=$r->dir_config('lonDAVsessDir');

    my ($adom,$aname);
    unless ($env{'user.environment'}) {
        my $handle = &Apache::lonnet::check_for_valid_session($r,'lonDAV');
        if ($handle eq '') {
            $handle = &sso_login($r,$sessiondir,$now,$timetolive);
            if ($handle eq '') {
                return FORBIDDEN;
            }
        } else {
            &Apache::lonnet::transfer_profile_to_env($sessiondir,$handle);
        }
    }
    my $uhome=&Apache::lonnet::homeserver($env{'user.name'},$env{'user.domain'});
    if ($uhome =~ /^(con_lost|no_host|no_such_host)$/) {
        return FORBIDDEN;
    }

    ($adom,$aname) = ($r->uri =~ m{^/webdav/($match_domain)/($match_username)/});
    my $docroot = $r->dir_config('lonDocRoot');
    if ($adom eq '' || $aname eq '') {
        return FORBIDDEN;
    } elsif (!-d "$docroot/priv/$adom/$aname") {
        return FORBIDDEN;
    }
    my $allowed;  
    if (($env{'user.name'} eq $aname) && ($env{'user.domain'} eq $adom)) {
        if ($env{"user.role.au./$adom/"}) {
            $allowed = 1;
        }
    } else {
        if (($env{"user.role.ca./$adom/$aname"}) ||
            (env{"user.role.aa./$adom/$aname"})) {
            $allowed = 1;
        }
    }
    if ($allowed) {
        my $method = $r->method();
        if (($r->filename =~ /.+\.(log|bak|meta|save)$/) || ($r->filename =~ /\.\d+\.\w+$/) || 
            ($r->filename =~ m{/\.+[^_/]+$})) {
            if (($method eq 'MKCOL') || ($method eq 'PUT')) {
                return FORBIDDEN;
            } elsif ($method eq 'MOVE') {
                if (($r->filename =~ /\.\d+\.\w+$/) || ($r->filename =~ m{/\.+[^_/]+$})) {
                    return FORBIDDEN;
                }
            }
        }
        if (($method eq 'DELETE') || ($method eq 'MOVE')) {
            unless (($r->filename =~ m{/\._[^/]+$}) || ($r->filename =~ m{/\.DS_Store$})) {
                my $dirptr=16384;
                my ($cmode,$cmtime)=(stat($r->filename))[2,9];
                if (($cmode&$dirptr)) {
                    my $numpub = 0;
                    $numpub = &recurse_dir($r->filename,$r->dir_config('lonDocRoot'),$numpub);
                    if ($numpub) {
                        return FORBIDDEN;
                    }
                } else {
                    if ($r->filename =~ /^(.+)\.(log|bak|save|meta)$/) {
                        my $conjugate = $1;
                        my $type = $2; 
                        if (($type eq 'log') || ($type eq 'meta')) {
                            if (-e $conjugate) {
                                my $conjstatus = &pubstatus($conjugate,$r->dir_config('lonDocRoot'));
                                unless (($conjstatus eq 'unpublished') || ($conjstatus eq 'obsolete')) {
                                    return FORBIDDEN;
                                }
                            }
                        }
                    } else {
                        my $status = &pubstatus($r->filename,$r->dir_config('lonDocRoot'));
                        unless (($status eq 'unpublished') || ($status eq 'obsolete')) {
                            return FORBIDDEN;
                        }
                    }
                }
            }
        }
        return OK;
    }
    return FORBIDDEN;
}

sub sso_login {
    my ($r,$sessiondir,$now,$timetolive) = @_;
    my ($uname,$udom);
    my ($uname) = ($r->user =~ m/([a-zA-Z0-9_\-@.]*)/);
    unless ($uname =~ /^$match_username$/) {
        return;
    }
    $udom = $r->dir_config('lonSSOUserDomain');
    if ($udom eq '') {
        $udom = $r->dir_config('lonDefDomain');
    }
    unless (($udom =~ /^$match_domain$/)) {
        return;
    }
    my $uhome = &Apache::lonnet::homeserver($uname,$udom);
    if ($uhome =~ /^(con_lost|no_host|no_such_host)$/) {
        return;
    }
    my $handle = 
        &Apache::lonwebdavauth::init_webdav_env($sessiondir,$uname,$udom,
                                                $uhome,$now,$timetolive);
    if ($handle ne '') {
        my $cookie = "lonDAV=$handle; path=/webdav/; secure; HttpOnly;";
        $r->header_out('Set-cookie' => $cookie);
        $r->send_http_header;
    }
    return ($handle);
}

sub pubstatus {
    my ($fn,$docroot,$cmtime) = @_;
    my $privfn = $fn;
    my $thisdisfn = $fn;
    $thisdisfn=~s/^\Q$docroot\E\/priv//;
    my $resfn=$docroot.'/res'.$thisdisfn;
    my $targetfn = '/res'.$thisdisfn;
    my $status = 'unpublished';
    if (-e $resfn) {
        $status = 'published';
        my $same = 0;
        if ((stat($resfn))[9] >= $cmtime) {
            $same = 1;
        } else {
            if (&Apache::londiff::are_different_files($resfn,$privfn)) {
                $same = 0;
            } else {
                $same = 1;
            }
        }
        if ($same) {
            if (&Apache::lonnet::metadata($targetfn,'obsolete')) {
                $status = 'obsolete';
            }
        }
    }
    return $status;
}

sub recurse_dir {
    my ($dirname,$docroot,$numpub) = @_;
    $dirname =~ s{/$}{};
    my $dirptr=16384;
    if (opendir(my $dirh,$dirname)) {
        my @items = readdir($dirh);
        closedir($dirh);
        foreach my $item (@items) {
            next if ($item =~ /.+\.(log|bak|save|meta)$/);
            next if ($item =~ /^\.+/);
            my ($cmode,$cmtime)=(stat("$dirname/$item"))[2,9];
            if (!($cmode&$dirptr)) {
                if (&pubstatus("$dirname/$item",$docroot,$cmtime) eq 'published') {
                    $numpub ++;
                }
            } else {
                $numpub = &recursedir("$dirname/$item",$docroot,$numpub);
            }
        }
    }
    return $numpub;
}

1;