#
# LON-CAPA authorization for cgi-bin scripts
#
# $Id: lonauthcgi.pm,v 1.14 2015/05/04 15:43:57 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

lonauthcgi

=head1 SYNOPSIS

Provides subroutines for checking if access to cgi pages is allowed
based on IP address, or for logged-in users based on role and/or     
identity. Also provides subroutines to give a user an explanation 
when access is denied, and descriptions of various server status pages
generated by CGI scripts which use these subroutines for authorization. 

=head1 Subroutines

=over 4

=cut

#############################################
#############################################

package LONCAPA::lonauthcgi;

use strict;
use lib '/home/httpd/lib/perl';
use Socket;
use Apache::lonnet;
use Apache::lonlocal;
use LONCAPA;

#############################################
#############################################

=pod

=item check_ipbased_access()

Inputs: $page, the identifier of the page to be viewed,
        can be one of the keys in the hash from &serverstatus_titles()

        $ip, the IP address of the client requesting the page.

Returns: 1 if access is permitted for the requestor's IP.
         Access is allowed if one of the following is true:
         (a) the requestor IP is the loopback address.
         (b) the requestor IP is the IP of the current server.
         (c) the requestor IP is the IP of a manager,
             if the page to view is not "takeoffline" or "toggledebug" 
         (d) the requestor IP is the IP of a server belonging 
             to a domain included in domains hosted on this server.
         (e) Domain configurations for domains hosted on this server include
             the requestor's IP as one of the specified IPs with access
             to this page. (not applicable to 'ping' page).

=cut

#############################################
#############################################
sub check_ipbased_access {
    my ($page,$ip) = @_;
    my $allowed;
    if (!defined($ip)) {
        $ip = $ENV{'REMOTE_ADDR'};
    }
    if ($ip eq '127.0.0.1') {
        $allowed = 1;
        return $allowed;
    } else {
        my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
        my $host_ip = &Apache::lonnet::get_host_ip($lonhost);
        if (($host_ip ne '') && ($host_ip eq $ip)) {
            $allowed = 1;
            return $allowed;
        }
    }
    if (&is_manager_ip($ip)) {
        unless (($page eq 'toggledebug') || ($page eq 'takeoffline')) {
            $allowed = 1;
            return $allowed;
        }
    }
    if (&check_domain_ip($ip)) {
        $allowed = 1;
        return $allowed;
    }
    if ($page ne 'ping') {
        my @poss_domains = &Apache::lonnet::current_machine_domains();
        foreach my $dom (@poss_domains) {
            my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],$dom);
            if (ref($domconfig{'serverstatuses'}) eq 'HASH') {
                if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
                    if ($domconfig{'serverstatuses'}{$page}{'machines'} ne '') {
                        my @okmachines = split(/,/,$domconfig{'serverstatuses'}{$page}{'machines'});
                        if (grep(/^\Q$ip\E$/,@okmachines)) {
                            $allowed = 1;
                            last;
                        }
                    }
                }
            }
        }
    }
    return $allowed;
}

#############################################
#############################################

=pod

=item is_manager_ip()

Inputs: $remote_ip, the IP address of the client requesting the page.

Returns: 1 if the client IP address corresponds to that of a 
         machine listed in /home/httpd/lonTabs/managers.tab

=cut

#############################################
#############################################
sub is_manager_ip {
    my ($remote_ip) = @_;
    return if ($remote_ip eq '');
    my ($directory,$is_manager);
    foreach my $key (keys(%Apache::lonnet::managerstab)) {
        my $manager_ip;
        if ($key =~ /:/) {
            my ($cluname,$dnsname) = split(/:/,$key);
            my $ip = gethostbyname($dnsname);
            if (defined($ip)) {
                $manager_ip = inet_ntoa($ip);
            }
        } else {
            $manager_ip = &Apache::lonnet::get_host_ip($key);
        }
        if (defined($manager_ip)) {
            if ($remote_ip eq $manager_ip) {
                $is_manager = 1;
                last;
            }
        }
    }
    return $is_manager;
}

#############################################
#############################################

=pod

=item check_domain_ip()

Inputs: $remote_ip, the IP address of the client requesting the page.

Returns: 1 if the client IP address is for a machine in the cluster
         and domain in common for client machine and this machine.

=cut

#############################################
#############################################
sub check_domain_ip {
    my ($remote_ip) = @_;
    my %remote_doms;
    my $allowed;
    if ($remote_ip ne '') {
        if (&Apache::lonnet::hostname($remote_ip) ne '') {
            my @poss_domains = &Apache::lonnet::current_machine_domains();
            if (@poss_domains > 0) {
                my @remote_hosts = &Apache::lonnet::get_hosts_from_ip($remote_ip);
                foreach my $hostid (@remote_hosts) {
                    my $hostdom = &Apache::lonnet::host_domain($hostid);
                    if ($hostdom ne '') {
                        if (grep(/^\Q$hostdom\E$/,@poss_domains)) {
                            $allowed = 1;
                            last;
                        }
                    }
                }
            }
        }
    }
    return $allowed;
}

#############################################
#############################################

=pod

=item can_view()

Inputs: $page, the identifier of the page to be viewed,
        can be one of the keys in the hash from &serverstatus_titles()
        $domain (optional), a specific domain for which the page is needed.  

Returns: 1 if access to the page is permitted, or &-separated list of domains
         for which access is allowed, if $page is domconf, and not superuser.
         Access allowed if one of the following is true:
         (a) Requestor has LON-CAPA superuser role
         (b) Requestor's role is Domain Coordinator in requested domain 
             (if specified) or (if unspecified) in one of the domains
             hosted on this server
         (c) The domain configuration for the particular domain (if specified),
             or domain configurations for domains hosted on this server (if 
             specific domain not specified), include the requestor as one of
             the named users (username:domain) with access to the page.

         In the case of requests for the 'showenv' page (/adm/test), the domains tested
         are not the domains hosted on the server, but instead are a single domain - 
         the domain of the requestor.  In addition, if the requestor has an active 
         Domain Coordinator role for that domain, access is permitted, regardless of  
         the requestor's current role.

=cut

#############################################
#############################################
sub can_view {
    my ($page,$domain) = @_;
    my $allowed;
    if ($Apache::lonnet::env{'request.role'} =~ m{^su\./}) {
        $allowed = 1;
    } else {
        my @poss_domains;
        if ($page eq 'showenv') {
            @poss_domains = ($env{'user.domain'});
            my $envkey = 'user.role.dc./'.$poss_domains[0].'/';
            if (exists($Apache::lonnet::env{$envkey})) {
                my $livedc = 1;
                my $then = $Apache::lonnet::env{'user.login.time'};
                my ($tstart,$tend)=split(/\./,$Apache::lonnet::env{$envkey});
                if ($tstart && $tstart>$then) { $livedc = 0; }
                if ($tend   && $tend  <$then) { $livedc = 0; }
                if ($livedc) {
                    $allowed = 1;
                }
            }
        } else {
            @poss_domains = &Apache::lonnet::current_machine_domains();
            if ($domain ne '') {
                if (grep(/^\Q$domain\E$/,@poss_domains)) {
                    @poss_domains = ($domain);
                } else {
                    undef(@poss_domains); 
                }
            }
        }
        unless ($allowed) {
            my %alloweddoms;   
            foreach my $dom (@poss_domains) {
                my %domconfig = &Apache::lonnet::get_dom('configuration',['serverstatuses'],
                                                         $dom);
                if ($Apache::lonnet::env{'request.role'} eq "dc./$dom/") {
                    if ($page eq 'domconf') {
                        $alloweddoms{$dom} = 1;
                    } else {
                        $allowed = 1; 
                    }
                } elsif (ref($domconfig{'serverstatuses'}) eq 'HASH') {
                    if (ref($domconfig{'serverstatuses'}{$page}) eq 'HASH') {
                        if ($domconfig{'serverstatuses'}{$page}{'namedusers'} ne '') {
                            my @okusers = split(/,/,$domconfig{'serverstatuses'}{$page}{'namedusers'});
                            if (grep(/^\Q$Apache::lonnet::env{'user.name'}:$Apache::lonnet::env{'user.domain'}\E$/,@okusers)) {
                                if ($page eq 'domconf') {
                                    $alloweddoms{$dom} = 1;
                                } else {
                                    $allowed = 1;
                                }
                            }
                            unless ($page eq 'domconf') {
                                last if ($allowed);
                            }
                        }
                    }
                }
            }
            if (($page eq 'domconf') && (!$allowed))  {
                $allowed = join('&',sort(keys(%alloweddoms)));
            }
        }
    }
    return $allowed;
}

#############################################
#############################################

=pod

=item unauthorized_msg()

Inputs: $page, the identifier of the page to be viewed,
        can be one of the keys in the hash from &serverstatus_titles()

Returns: A string explaining why access was denied for the particular page.

=cut

#############################################
#############################################
sub unauthorized_msg {
    my ($page) = @_;
    my $titles = &serverstatus_titles();
    if ($page eq 'clusterstatus') {
        return &mt('Your current role does not permit you to view the requested server status page: [_1]',$titles->{$page});
    }
    my @poss_domains = &Apache::lonnet::current_machine_domains();
    if (@poss_domains == 1) {
        my $domdesc = &Apache::lonnet::domain($poss_domains[0]);
        return &mt('The configuration for domain: [_1] does not permit you to view the requested server status page: [_2].',"$domdesc ($poss_domains[0])",$titles->{$page});
    } elsif (@poss_domains > 1) {
        my $output = &mt('Configurations for the domains housed on this server: ').'<ul>';
        foreach my $dom (@poss_domains) {
            my $domdesc = &Apache::lonnet::domain($dom);
            $output .= '<li>'.&Apache::lonnet::domain($dom).'('.$dom.')</li>';
        }
        $output .= '</ul>'.&mt('do not permit you to view the requested server status page: [_1]',$titles->{$page});
        return $output;
    } else {
        return &mt('No domain information exists for this server');
    }
}

#############################################
#############################################

=pod

=item serverstatus_titles()

Inputs: none

Returns: a reference to a hash of pages, where in the hash
         keys are names of pages which employ loncgi.pm
         or lonstatusacc.pm for access control,
         and corresponding values are descriptions of each page

=cut

#############################################
#############################################
sub serverstatus_titles {
    my %titles = &Apache::lonlocal::texthash (
                   'userstatus'        => 'User Status Summary',
                   'lonstatus'         => 'Display Detailed Report',
                   'loncron'           => 'Generate Detailed Report',
                   'server-status'     => 'Apache Status Page',
                   'codeversions'      => 'LON-CAPA Module Versions',
                   'checksums'         => 'LON-CAPA Module Checking',
                   'diskusage'         => 'Course/Community Disk Usage',
                   'clusterstatus'     => 'Domain status',
                   'metadata_keywords' => 'Display Metadata Keywords',
                   'metadata_harvest'  => 'Harvest Metadata Searches',
                   'takeoffline'       => 'Offline - replace Log-in page',
                   'takeonline'        => 'Online - restore Log-in page',
                   'showenv'           => 'Show user environment',
                   'toggledebug'       => 'Toggle debug messages',
                   'ping'              => 'Cause server to ping another server',   
                   'domconf'           => 'Text Display of Domain Configuration',
                   'uniquecodes'       => 'Six-character Course Codes',
                   'coursecatalog'     => 'Course/Community Catalog with enrollment data',
                 );
    return \%titles;
}

=pod

=back

=cut

1;