Return to lontrans.pm CVS log

Up to [LON-CAPA] / loncom

- Dual SSO and non-SSO login from /adm/login for use with additional SSO
  mechanisms besides Shibboleth.
  - Default is to use /adm/sso for "authentication" URL.
  - Different authentication URL can be set with lonOtherAuthenUrl perlvar.
  - Update documentation for lonshibauth.pm and lonshibacc.pm
  - Wording change for WAF/Proxy domain configuration
  - If Apache config contains lonSSOEmailOK set to 1, default removal
    of @ "internet domain" from username for SSO authenticated users in
    lonshibacc.pm is skipped.
  - &alias_shibboleth() routine in lonnet.pm renamed alias_sso().

# The LearningOnline Network
# URL translation for User Files
#
# $Id: lontrans.pm,v 1.38 2021/12/06 03:31:54 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/
#

package Apache::lontrans;

use strict;
use Apache::Constants qw(:common :remotehost);
use Apache::lonnet;
use Apache::loncommon;
use Apache::File();
use LONCAPA qw(:DEFAULT :match);

sub handler {
    my $r = shift;
    # FIXME line remove when mod_perl fixes BUG#4948
    $r->notes->set('error-notes' => '');
    my $hdrhost = $r->headers_in->get('Host');
    if ($r->uri=~m{^/raw/}) {
        if ($hdrhost) {
            unless ($hdrhost =~ /^internal\-/) {
                my $remote_ip = &Apache::lonnet::get_requestor_ip($r,REMOTE_NOLOOKUP,1);
                my $lonhost = $r->dir_config('lonHostID');
                if (&redirect_raw($remote_ip,$lonhost)) {
                    my $location = 'https://internal-'.$hdrhost.$r->uri;
                    $r->headers_out->set(Location => $location);
                    return REDIRECT;
                }
            }
        }
    }
    my $alias = &Apache::lonnet::get_proxy_alias();
    if ($alias) {
        my $lonhost = $r->dir_config('lonHostID');
        my $hostname = &Apache::lonnet::hostname($lonhost);
        my $ssourl = '/adm/sso';
        if ($r->dir_config('lonOtherAuthenUrl') ne '') {
            $ssourl = $r->dir_config('lonOtherAuthenUrl');
        }
        if (($hdrhost eq $alias) || ($hdrhost eq $hostname)) {
            my $proxyinfo = &Apache::lonnet::get_proxy_settings($r->dir_config('lonDefDomain'));
            my ($vpnint,$vpnext);
            if (ref($proxyinfo) eq 'HASH') {
                $vpnint = $proxyinfo->{'vpnint'};
                $vpnext = $proxyinfo->{'vpnext'};
            }
            my ($redirect,$remote_ip);
            if ($hdrhost eq $alias) {
                $remote_ip = &Apache::lonnet::get_requestor_ip($r,REMOTE_NOLOOKUP);
                if (($vpnext && &Apache::lonnet::ip_match($remote_ip,$vpnext)) &&
                    ($r->uri !~ m{^/adm/(lti|launch)/})) {
                    $redirect = $hostname;
                }
                if ($r->uri eq $ssourl) {
                    if (&Apache::lonnet::alias_sso($lonhost)) {
                        undef($redirect);
                    } else {
                        $redirect = $hostname;
                    }
                }
                if ($redirect eq $hdrhost) {
                    undef($redirect);
                }
            } elsif ($hdrhost eq $hostname) {
                $remote_ip = &Apache::lonnet::get_requestor_ip($r,REMOTE_NOLOOKUP,1);
                unless (($remote_ip eq '127.0.0.1') || ($remote_ip eq '::1') ||
                        ($remote_ip eq &Apache::lonnet::get_host_ip($lonhost)) ||
                        ($r->uri=~m{^/adm/(lti|launch)/}) ||
                        ($vpnint && &Apache::lonnet::ip_match($remote_ip,$vpnint))) {
                    $redirect = $alias;
                    if (($r->uri=~m{^/raw/}) || ($r->uri=~m{^/adm/dns/})) {
                        my %iphost = &Apache::lonnet::get_iphost();
                        if (exists($iphost{$remote_ip})) {
                            undef($redirect);
                        }
                    } elsif ($r->uri eq $ssourl) {
                        unless (&Apache::lonnet::alias_sso($lonhost)) {
                            undef($redirect);
                        }
                    }
                }
            }
            if ($redirect) {
                my $uri = $r->uri;
                if (($uri eq '/adm/switchserver') || ($uri =~ m{^/Shibboleth.sso/})) {
                    return DECLINED;
                }
                unless (($uri eq '/adm/migrateuser') || ($uri eq $ssourl)) {
                    my %user;
                    my $handle = &Apache::lonnet::check_for_valid_session($r,undef,\%user);
                    if (($handle) && ($user{'name'} ne '') && ($user{'domain'} ne '')) {
                        unless (($user{'name'} eq 'public') && ($user{'domain'} eq 'public')) {
                            my $dest = '/adm/migrateuser';
                            my $token = &set_token($r,$dest,$remote_ip,\%user);
                            unless ($token eq '') {
                                $r->internal_redirect("$dest?token=$token");
                                $r->set_handlers('PerlHandler'=> undef);
                                return DECLINED;
                            }
                        }
                    }
                }
                my $protocol = 'http';
                my $port = $r->get_server_port();
                if ($port eq '443') {
                    $protocol = 'https';
                }
                if ($uri =~ m{^(/adm/css/)(.+)(.css)$}) {
                    $uri = $1.&escape($2).$3;
                }
                my $location = $protocol.'://'.$redirect.$uri;
                if ($r->uri =~ m{^/tiny/$match_domain/\w+$}) {
                    my $token = &set_token($r,$r->uri);
                    unless ($token eq '') {
                        $location .= '?ttoken='.$token;
                    }
                } elsif ($r->args) {
                    $location .= '?'.$r->args;
                }
                $r->header_out(Location => $location);
                return REDIRECT;
            }
        }
    }
    if ($r->uri =~ m{^/tiny/$match_domain/\w+$}) {
        my $token = &set_token($r,$r->uri);
        unless ($token eq '') {
            $r->args('ttoken='.$token);
        }
    }
    if ($r->uri=~m|^(/raw)?/uploaded/|) {
        my $fn = $r->uri();
        $fn=~s/^\/raw//;
        my (undef,undef,$udom,$uname,@ufile)=split(/\//,$fn);
	if (@ufile) { $ufile[-1]=~s/^[\~\.]+//; }
        my $chome=&Apache::lonnet::homeserver($uname,$udom);
	my $allowed=0;
	my @ids=&Apache::lonnet::current_machine_ids();
	foreach my $id (@ids) { if ($id eq $chome) { $allowed=1; } }
	if ($allowed) {
	    $r->filename(&propath($udom,$uname).
			 '/userfiles/'.(join('/',@ufile)));
        }
        return OK;
    } elsif ($r->uri =~ m{^\Q/adm/wrapper/ext/https:/\E[^/]}) {
        my $uri = $r->uri;
        $uri =~ s{^(\Q/adm/wrapper/ext/https:/\E)}{$1/};
        $r->uri($uri);
    }
    return DECLINED;
}

sub redirect_raw {
    my ($remote_ip,$lonhost) = @_;
    my @remhostids = &Apache::lonnet::get_hosts_from_ip($remote_ip);
    my $redirect;
    while (@remhostids) {
        my $try_server = pop(@remhostids);
        my $remhostname = &Apache::lonnet::hostname($try_server);
        if ($remhostname) {
            my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$try_server);
            my ($remmajor,$remminor) = ($remoterev =~ /^(\d+)\.(\d+)/);
            if (($remmajor > 2) || (($remmajor == 2) && $remminor >= 12)) {
                my $internet_names = &Apache::lonnet::get_internet_names($try_server);
                if (ref($internet_names) eq 'ARRAY') {
                    my $intdom = &Apache::lonnet::internet_dom($lonhost);
                    unless (grep(/^\Q$intdom\E$/,@{$internet_names})) {
                        my $lonhostname = &Apache::lonnet::hostname($lonhost);
                        my $serverhomeID = &Apache::lonnet::get_server_homeID($lonhostname);
                        my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                        my %domdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
                        my $replication = $domdefaults{'replication'};
                        if (ref($replication) eq 'HASH') {
                            my $remhomeID = &Apache::lonnet::get_server_homeID($remhostname);
                            my $remhomedom = &Apache::lonnet::host_domain($remhomeID);
                            my $remprimary = &Apache::lonnet::domain($remhomedom,'primary');
                            my $remintdom = &Apache::lonnet::internet_dom($remprimary);
                            if (ref($replication->{'certreq'}) eq 'ARRAY') {
                                if (grep(/^\Q$remintdom\E$/,@{$replication->{'certreq'}})) {
                                    $redirect = 0;
                                } else {
                                    $redirect = 1;
                                }
                            }
                            if (ref($replication->{'nocertreq'}) eq 'ARRAY') {
                                if (grep(/^\Q$remintdom\E$/,@{$replication->{'nocertreq'}})) {
                                    $redirect = 1;
                                } else {
                                    $redirect = 0;
                                }
                            }
                        }
                    }
                }
            }
            last;
        }
    }
    return $redirect;
}

sub set_token {
    my ($r,$dest,$remote_ip,$userref) = @_;
    my (%info,%user);
    if ($dest eq '/adm/migrateuser') {
        return unless (ref($userref) eq 'HASH');
        %user = %{$userref};
        %info = ('ip' => $remote_ip,
                 'domain'    => $user{'domain'},
                 'username'  => $user{'name'},
                 'server'    => $r->dir_config('lonHostID'),
                );
    }
    if ($r->args) {
        foreach my $pair (split(/&/,$r->args)) {
            my ($name,$value) = split(/=/,$pair);
            $name = &LONCAPA::unescape($name);
            next unless (($name eq 'role') || ($name eq 'symb') ||
                         ($name eq 'ltoken') || ($name eq 'linkkey') ||
                         ($name eq 'ttoken'));
            $value =~ tr/+/ /;
            $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
            $info{$name} = $value;
        }
        if ($info{'ttoken'}) {
            my %current = &Apache::lonnet::tmpget($info{'ttoken'});
            delete($info{'ttoken'});
            if ($current{'origurl'} eq $r->uri) {
                return if (keys(%current));
            }
        }
    }
#
# To be able to support deep-linking for a shortened URL, i.e.,
# /tiny/$dom/$id with (a) linkkey included in POSTed data and
# data and (b) non-Shibboleth SSO in use, ltoken (or linkprot
# if sending to /adm/migrateuser), or linkkey are written to a
# .tmp file in /home/httpd/perl/tmp and the query string is
# replaced with ttoken=tokenid.  This does mean other POSTed
# data will be discarded.
#
    if ($r->uri =~ m{^/tiny/$match_domain/\w+$}) {
        unless (($info{'ltoken'}) || ($info{'linkkey'} ne '')) {
            &Apache::lonacc::get_posted_cgi($r,['linkkey']);
            if ($env{'form.linkkey'} ne '') {
                $info{'linkkey'} = $env{'form.linkkey'};
            }
        }
    }
    if ($dest eq '/adm/migrateuser') {
        if ($info{'ltoken'}) {
            my %link_info = &Apache::lonnet::tmpget($info{'ltoken'});
            if ($link_info{'linkprot'}) {
                $info{'linkprot'} = $link_info{'linkprot'};
            }
            &Apache::lonnet::tmpdel($info{'ltoken'});;
            delete($info{'ltoken'});
        }
        unless ($info{'role'}) {
            if ($user{'role'} ne '') {
                $info{'role'} = $user{'role'};
            }
        }
        unless ($info{'symb'}) {
            unless ($r->uri eq '/adm/roles') {
                $info{'origurl'} = $r->uri;
            }
        }
    }
    if (($dest eq '/adm/migrateuser') || (keys(%info) > 0)) {
        unless ($dest eq '/adm/migrateuser') {
            $info{'origurl'} = $r->uri;
        }
        my $token = &Apache::lonnet::tmpput(\%info,$r->dir_config('lonHostID'),'link');
        unless (($token eq 'con_lost') || ($token eq 'refused') ||
                ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
            return $token;
        }
    }
    return;
}

1;
__END__

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.