#!/usr/bin/perl
$|=1;
# Script to complete processing of course/community requests
# for unofficial courses, textbook courses and communities 
# queued pending validation, once validated.
#  
# $Id: createpending.pl,v 1.1 2014/04/16 15:36:38 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

createpending.pl

=head1 SYNOPSIS

CGI script to process pending course/community requests 
and output URL which user will return to if course 
creation successful.

Data expected by createpending.pl are the same fields
as included for a POST to the external validation site,
as specified in the domain configuration for
course request validation, which can be some or all of: 

1. courseID (domain_coursenum)
2. requester's username:domain
3. course type
4. course description

Both 1 and 2 are required, whereas 3 and 4 are optional.

The data can be passed either in a query string or as
POSTed form variables.

=head1 Subroutines

=over 4

=cut

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

use strict;

use lib '/home/httpd/lib/perl/';
use LONCAPA::loncgi;
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonuserutils();
use Apache::loncoursequeueadmin();
use Apache::lonlocal;
use LONCAPA;
use IO::Socket;

&main();
exit 0;

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

=pod

=item main()

Inputs: None

Returns: Nothing

Description: Main program. Determines if requesting IP is the IP 
             of the validation server. Side effect is to
             print content (with text/plain HTTP header).
             Content is URL course requester should use
             to access the course, when course creation
             is successful.

=cut

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

sub main {
    my $query = CGI->new();

    my @okdoms = &Apache::lonnet::current_machine_domains();

    my $perlvar = &LONCAPA::Configuration::read_conf();
    my $lonidsdir;
    if (ref($perlvar) eq 'HASH') {
        $lonidsdir = $perlvar->{'lonIDsDir'};
    }
    undef($perlvar);

    my ($cdom,$cnum);
    if ($query->param('course')) {
        my $course = $query->param('course'); 
        $course =~ s/^\s+|\s+$//g;
        if ($course =~ /^($LONCAPA::match_domain)_($LONCAPA::match_courseid)$/) {
            my $possdom = $1;
            my $domdesc = &Apache::lonnet::domain($possdom);
            unless ($domdesc eq '') {
                $cdom = $possdom;
            }
        } else {
            print &LONCAPA::loncgi::cgi_header('text/plain',1);
            return;
        }
    }

    if ($cdom eq '') {
        print &LONCAPA::loncgi::cgi_header('text/plain',1);
        return;
    }

    if (!grep(/^\Q$cdom\E$/,@okdoms)) {
        print &LONCAPA::loncgi::cgi_header('text/plain',1);
        return;
    }

    my %domconfig = &Apache::lonnet::get_dom('configuration',['requestcourses'],$cdom);
    my $remote_ip = $ENV{'REMOTE_ADDR'};
    my $allowed;

    if (ref($domconfig{'requestcourses'}) eq 'HASH') {
        if (ref($domconfig{'requestcourses'}{'validation'}) eq 'HASH') {
            if ($domconfig{'requestcourses'}{'validation'}{'url'} =~ m{^https?://([^/]+)/}) {
                my $ip = gethostbyname($1);
                if ($ip ne '') {
                    my $validator_ip = inet_ntoa($ip);
                    if (($validator_ip ne '') && ($remote_ip eq $validator_ip)) {
                        $allowed = 1;
                    }
                }
            } elsif ($domconfig{'requestcourses'}{'validation'}{'url'} =~ m{^/}) {
                if ($remote_ip ne '') {
                    if (($remote_ip eq '127.0.0.1') || ($remote_ip eq $ENV{'SERVER_ADDR'})) {
                        $allowed = 1;
                    }
                }
            }
        }
    }

    my (%params,@fields,$numrequired);
    if ($allowed) {
        &Apache::lonlocal::get_language_handle();
        my ($validreq,@fields);
        if (ref($domconfig{'requestcourses'}) eq 'HASH') {
            if (ref($domconfig{'requestcourses'}{'validation'}) eq 'HASH') {
                if (ref($domconfig{'requestcourses'}{'validation'}{'fields'}) eq 'ARRAY') {
                    $numrequired = scalar(@{$domconfig{'requestcourses'}{'validation'}{'fields'}});
                    foreach my $field (@{$domconfig{'requestcourses'}{'validation'}{'fields'}}) {
                        $params{$field} = $query->param($field);
                        if ($field eq 'owner') {
                            if ($query->param($field) =~ /^(LONCAPA::match_username):($LONCAPA::match_domain)$$/) {
                                $params{$field} = $query->param($field);
                            }
                        }
                        if ($field eq 'course') {
                            if ($query->param($field) =~ /^(?:LONCAPA::match_domain)_(?:LONCAPA::match_courseid)$/) {
                                $params{$field} = $query->param($field);
                            }
                        }
                        if ($field eq 'coursetype') {
                            if ($query->param($field) =~ /^(unofficial|community|textbook)$/) {
                                $params{$field} = $query->param($field);
                            }
                        }
                        if ($field eq 'description') {
                            $params{$field} = $query->param($field);
                        }
                    }
                    if ($numrequired == scalar(keys(%params))) {
                        $validreq = 1;
                    }
                }
            }
        }
        print &LONCAPA::loncgi::cgi_header('text/plain',1);
        if ($validreq) {
            $params{'token'} = $query->param('token');
            my ($url,$code) = &process_courserequest($cdom,$lonidsdir,\%params);
            if ($url) {
                print("$url\n$code");
            }
        }
    } else {
        print &LONCAPA::loncgi::cgi_header('text/plain',1);
    }
    return;
}

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

=pod

=item process_courserequest()

Inputs: $dom - domain of course to be created
        $lonidsdir - Path to directory containing session files for users.
                     Perl var lonIDsDir is read from loncapa_apache.conf
                     in &main() and passed as third arg to process_courserequest().
        $params - references to hash of key=value pairs from input
                  (either query string or POSTed). Keys which will be
                  used are fields specified in domain configuration
                  for validation of pending unofficial courses, textbook courses,
                  and communities.

Returns: $url,$code - If processing of the pending course request succeeds,
                      a URL is returned which may be used by the requester to access
                      the new course. If a six character code was also set, that is
                      returned as a second item.

Description: Processes a pending course creation request, given the username 
             and domain of the requester and the courseID of the new course. 

=cut

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

sub process_courserequest {
    my ($dom,$lonidsdir,$params) = @_;
    return () unless (ref($params) eq 'HASH');

    my $cid = $params->{'course'};
    my $owner = $params->{'owner'};
    my $token = $params->{'token'};
    my ($ownername,$ownerdom) = split(/:/,$owner);
    my $ownerhome = &Apache::lonnet::homeserver($ownername,$ownerdom);
    return () if ($ownerhome eq 'no_host');
    return () if ($cid eq '');
    my ($cdom,$cnum) = split(/_/,$cid); 
    my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
    return () unless ($chome eq 'no_host');
    my ($url,$code);
    my $confname = &Apache::lonnet::get_domainconfiguser($cdom);
    my %queuehash = &Apache::lonnet::get('courserequestqueue',
                                         [$cnum.'_pending'],$cdom,$confname);
    return () unless (ref($queuehash{$cnum.'_pending'}) eq 'HASH');
    my ($crstype,$lonhost,$hostname,$handle);
    $crstype = $queuehash{$cnum.'_pending'}{'crstype'};
    $lonhost = $queuehash{$cnum.'_pending'}{'lonhost'};
    if ($lonhost ne '') {
        $hostname = &Apache::lonnet::hostname($lonhost);
    }
    my $savedtoken = $queuehash{$cnum.'_pending'}{'token'};
    my $process;
    if ($token ne '') {
        if ($token eq $savedtoken) {
            $process = 1;
        }
    }
    return () unless ($process);

    my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
    my ($logmsg,$newusermsg,$addresult,$enrollcount,$response,$keysmsg,%longroles,$code,
        $dcname,$dcdom);
    my $type = 'Course';
    my $now = time;
    if ($crstype eq 'community') {
        $type = 'Community';
    }
    my @roles = &Apache::lonuserutils::roles_by_context('course','',$type);
    foreach my $role (@roles) {
        $longroles{$role}=&Apache::lonnet::plaintext($role,$type);
    }
    my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
    my %permissionflags = ();
    &set_permissions(\%permissionflags,\@permissions);
    my %domconfig = &Apache::lonnet::get_dom('configuration',['requestcourses'],$cdom);
    if (ref($domconfig{'requestcourses'}) eq 'HASH') {
        if (ref($domconfig{'requestcourses'}{'validation'}) eq 'HASH') { 
            if ($domconfig{'requestcourses'}{'validation'}{'dc'}) {
                ($dcname,$dcdom) = split(/:/,$domconfig{'requestcourses'}{'validation'}{'dc'});
            }
        }
    }
    my %history = &Apache::lonnet::restore($cid,'courserequests',$ownerdom,$ownername);
    if (ref($history{'details'}) eq 'HASH') {
        my %reqhash = (
                        reqtime   => $now,
                        crstype   => $crstype,
                        details   => $history{'details'},
                      );
        my %customitems;
        my $fullname = &Apache::loncommon::plainname($ownername,$ownerdom);
        my $inprocess = &Apache::lonnet::auto_crsreq_update($cdom,$cnum,$crstype,'process',
                                                            $ownername,$ownerdom,$fullname,
                                                            $history{'details'}{'cdescr'});
        if (ref($inprocess) eq 'HASH') {
            foreach my $key (keys(%{$inprocess})) {
                if (exists($history{'details'}{$key})) {
                    $customitems{$key} = $history{'details'}{$key};
                }
            }
        }
        &set_dc_env($dcname,$dcdom,$dcdom,$ownername,$ownerdom,$crstype);
        my ($result,$postprocess) = &Apache::loncoursequeueadmin::course_creation($cdom,$cnum,
                                        'domain',$history{'details'},\$logmsg,\$newusermsg,
                                        \$addresult,\$enrollcount,\$response,\$keysmsg,\%domdefs,
                                        \%longroles,\$code,\%customitems);
        &unset_dc_env($dcname,$dcdom,$ownername,$ownerdom,$crstype);
        if ($result eq 'created') {
            my $disposition = 'created';
            my $reqstatus = 'created';
            if (($code) || ((ref($postprocess) eq 'HASH') &&
                (($postprocess->{'createdweb'}) || ($postprocess->{'createdmsg'})))) {
                my $addmsg = [];
                my $recipient = $ownername.':'.$ownerdom;
                my $sender = $recipient;
                if ($code) {
                    push(@{$addmsg},{
                                      mt   => 'Students can automatically select your course: "[_1]" by entering this code: [_2]',
                                      args => [$history{'details'}{'cdescr'},$code],
                                    });
                }
                if (ref($postprocess) eq 'HASH') {
                    if (ref($postprocess->{'createdmsg'}) eq 'ARRAY') {
                        foreach my $item (@{$postprocess->{'createdmsg'}}) {
                            if (ref($item) eq 'HASH') {
                                if ($item->{'mt'} ne '') {
                                    push(@{$addmsg},$item);
                                }
                            }
                        }
                    }
                }
                if (scalar(@{$addmsg}) > 0) {
                    my $type = 'createdcrsreq';
                    if ($code) {
                        $type = 'uniquecode';
                    }
                    &Apache::loncoursequeueadmin::send_selfserve_notification($recipient,$addmsg,$cdom.'_'.$cnum,
                                                                              $history{'details'}{'cdescr'},
                                                                              $now,$type,$sender);
                }
            }
            if ($code) {
                $reqhash{'code'} = $code;
            }
            my $creationresult = 'created';
            my ($storeresult,$updateresult) =
                &Apache::loncoursequeueadmin::update_coursereq_status(\%reqhash,$cdom,
                                              $cnum,$reqstatus,'request',$ownerdom,$ownername);
#
# check for session for this user
# if session, construct URL point at check for new roles.
#
            if ($lonhost) {    
                my @hosts = &Apache::lonnet::current_machine_ids();
                if (grep(/^\Q$lonhost\E$/,@hosts) && ($handle) && ($hostname)) {
                    if ($lonidsdir ne '') {
                        if (-e "$lonidsdir/$handle.id") {
                            my $protocol = $Apache::lonnet::protocol{$lonhost};
                            $protocol = 'http' if ($protocol ne 'https');
                            $url = $protocol.'://'.$hostname.'/adm/roles?state=doupdate';
                        }
                    }
                }
#
# otherwise point at default portal, or if non specified, at /adm/login?querystring where 
# querystring contains role=st./$cdom/$cnum
#
                if ($url eq '') {
                    my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
                    if ($domdefaults{'portal_def'}) {
                        $url = $domdefaults{'portal_def'};
                    } else {
                        my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
                        my $hostname = &Apache::lonnet::hostname($chome);
                        my $protocol = $Apache::lonnet::protocol{$chome};
                        $protocol = 'http' if ($protocol ne 'https');
                        my $role = 'cc';
                        if ($crstype eq 'community') {
                            $role = 'co';
                        }
                        $url = $protocol.'://'.$hostname.'/adm/login?role='.$role.'./'.$cdom.'/'.$cnum;
                    }
                }
            }
        }
    }
    &unset_permissions(\%permissionflags);
    return ($url,$code);
}

sub set_permissions {
    my ($permissionflags,$permissions) = @_;
    foreach my $allowtype (@{$permissions}) {
        unless($env{"allowed.$allowtype"}) {
            $env{"allowed.$allowtype"} = 'F';
            $permissionflags->{$allowtype} = 1;
        }
    }
}

sub unset_permissions {
    my ($permissionflags) = @_;
    foreach my $allowtype (keys(%{$permissionflags})) {
        delete($env{"allowed.$allowtype"});
    }
}

sub set_dc_env {
    my ($dcname,$dcdom,$defdom,$ownername,$ownerdom,$crstype) = @_;
    $env{'user.name'} = $dcname;
    $env{'user.domain'} = $dcdom;
    $env{'user.home'} = &Apache::lonnet::homeserver($dcname,$dcdom);
    if ($defdom ne '') {
        $env{'request.role.domain'} = $defdom;
    }
    if (($dcname eq $ownername) && ($dcdom eq $ownerdom)) {
        $env{'environment.canrequest.'.$crstype} = 1;
    }
    return;
}

sub unset_dc_env {
    my ($dcname,$dcdom,$ownername,$ownerdom,$crstype) = @_;
    delete($env{'user.name'});
    delete($env{'user.domain'});
    delete($env{'user.home'});
    if ($env{'request.role.domain'}) {
        delete($env{'request.role.domain'});
    }
    if (($dcname eq $ownername) && ($dcdom eq $ownerdom)) {
        delete($env{'environment.canrequest.'.$crstype});
    }
    return;
}

=pod

=back

=cut