Return to lonwebdavacc.pm CVS log

Up to [LON-CAPA] / loncom / auth

- Retrieval of requestor's IP address centralized in lonnet::get_requestor_ip()
- Domain configuration to allow domain's LON-CAPA nodes to operate behind a
  WAF/Reverse Proxy using aliased hostname (CNAME).
- Web requests from other nodes bypass the WAF as their requests are made
  directly to the server hostname (A record); same for internal LON-CAPA
  connections for lonc -> lond.

# The LearningOnline Network
# Authorization Handler for webDAV access to Authoring Space. 
#
# $Id: lonwebdavacc.pm,v 1.7 2020/12/18 15:23:03 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[\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[\w.\-\@]+/">

This module is only called following successful authentication. 
Successful authentication will have created a session file and
transferred the contents to the user's environment.

Note: because Apache Basic Auth is used for authentication 
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, calls Apache::lonnet::check_for_valid_session() 
to retrieve a valid sessionID (webDAV client needs to support
cookies for session retrieval to be successful). If a session is
found Apache::lonnet::transfer_profile_to_env() is called 
to populate %env.

=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 corresponding Authoring Space. 

=back

=head1 NOTABLE SUBROUTINES

=over

=item * sso_login()

=over 

=item *

Not currently used.

=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) = ($r->uri =~ m{^/webdav/($match_domain)/($match_username)/});
    my $author = "$aname:$adom";
    unless ($env{'user.environment'}) {
        my $handle = &Apache::lonnet::check_for_valid_session($r,'lonDAV');
        if ($handle ne '') {
            &Apache::lonnet::transfer_profile_to_env($sessiondir,$handle);
        } else {
            return FORBIDDEN;
        }
    }
    my $uhome=&Apache::lonnet::homeserver($env{'user.name'},$env{'user.domain'});
    if ($uhome =~ /^(con_lost|no_host|no_such_host)$/) {
        return FORBIDDEN;
    }

    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,$author) = @_;
    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($r,$sessiondir,$uname,$udom,
                                                $uhome,$now,$timetolive,$author);
    if ($handle ne '') {
        if (&Apache::lonnet::usertools_access($uname,$udom,'webdav')) {
            my ($webdav) =
                ($r->uri =~ m{^(/webdav/$match_domain/$match_username/)});
            my $ip = &Apache::lonnet::get_requestor_ip();
            &Apache::lonnet::log($udom,$uname,$uhome,
                                 "SSO log-in to $webdav from $ip");
            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 = &recurse_dir("$dirname/$item",$docroot,$numpub);
            }
        }
    }
    return $numpub;
}

1;