File:  [LON-CAPA] / loncom / interface / createaccount.pm
Revision 1.87: download - view: text, annotated - select for diffs
Tue Oct 18 23:28:00 2022 UTC (19 months, 3 weeks ago) by raeburn
Branches: MAIN
CVS tags: HEAD
- Hint to browsers to not autofill password fields.

# The LearningOnline Network
# Allow visitors to create a user account with the username being either an 
# institutional log-in ID (institutional authentication required - localauth,
# kerberos, or SSO) or an e-mail address. Requests to use an e-mail address as
# username may be processed automatically, or may be queued for approval.
#
# $Id: createaccount.pm,v 1.87 2022/10/18 23:28:00 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::createaccount;

use strict;
use Apache::Constants qw(:common);
use Apache::lonacc;
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonhtmlcommon;
use Apache::lonlocal;
use Apache::lonauth;
use Apache::resetpw;
use DynaLoader; # for Crypt::DES version
use Crypt::DES;
use LONCAPA qw(:DEFAULT :match);
use HTML::Entities;

sub handler {
    my $r = shift;
    &Apache::loncommon::content_type($r,'text/html');
    $r->send_http_header;
    if ($r->header_only) {
        return OK;
    }

    my $domain;

    my $sso_username = $r->subprocess_env->get('SSOUserUnknown');
    my $sso_domain = $r->subprocess_env->get('SSOUserDomain');

    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                            ['token','courseid','domain','type']);
    &Apache::lonacc::get_posted_cgi($r);
    &Apache::lonlocal::get_language_handle($r);

    if ($sso_username ne '' && $sso_domain ne '') {
        $domain = $sso_domain; 
    } else {
        ($domain, undef) = Apache::lonnet::is_course($env{'form.courseid'});
        unless ($domain) {
            if ($env{'form.phase'} =~ /^username_(activation|validation)$/) {
                if (($env{'form.udom'} =~ /^$match_domain$/) &&
                    (&Apache::lonnet::domain($env{'form.udom'}) ne '')) {
                    $domain = $env{'form.udom'};
                } else {
                    $domain = &Apache::lonnet::default_login_domain();
                }
            } elsif (($env{'form.phase'} eq '') &&
                     ($env{'form.domain'} =~ /^$match_domain$/) &&
                     (&Apache::lonnet::domain($env{'form.domain'}) ne '')) {
                $domain = $env{'form.domain'};
            } else {
                $domain = &Apache::lonnet::default_login_domain();
            }
        }
    }
    my $domdesc = &Apache::lonnet::domain($domain,'description');
    my $contact_name = &mt('LON-CAPA helpdesk');
    my $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
    my $contacts =
        &Apache::loncommon::build_recipient_list(undef,'helpdeskmail',
                                                 $domain,$origmail);
    my ($contact_email) = split(',',$contacts);
    my $lonhost = $r->dir_config('lonHostID');
    my $include = $r->dir_config('lonIncludes');
    my $start_page;

    my $handle = &Apache::lonnet::check_for_valid_session($r);
    if (($handle ne '') && ($handle !~ /^publicuser_\d+$/)) {
        $start_page =
            &Apache::loncommon::start_page('Already logged in');
        my $end_page =
            &Apache::loncommon::end_page();
        $r->print($start_page."\n".'<h2>'.&mt('You are already logged in').'</h2>'.
                  '<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].',
                            '<a href="/adm/roles">','</a>','<a href="/adm/logout">','</a>').
                  '</p><p><a href="/adm/loginproblems.html">'.&mt('Login problems?').'</a></p>'.$end_page);
        return OK;
    }

    my ($js,$courseid,$title);
    $courseid = Apache::lonnet::is_course($env{'form.courseid'});
    if ($courseid ne '') {
        $js = &catreturn_js();
        $title = 'Self-enroll in a LON-CAPA course';
    } else {
        $title = 'Create a user account in LON-CAPA';
    }
    if ($env{'form.phase'} eq 'selfenroll_login') {
        $title = 'Self-enroll in a LON-CAPA course';
        if ($env{'form.udom'} ne '') {
            $domain = $env{'form.udom'};
        }

        my %domconfig = 
            &Apache::lonnet::get_dom('configuration',['usercreation'],$domain);
        my ($cancreate,$statustocreate) = 
            &get_creation_controls($domain,$domconfig{'usercreation'});

        my ($result,$output) =
            &username_validation($r,$env{'form.uname'},$domain,$domdesc,
                                 $contact_name,$contact_email,$courseid,
                                 $lonhost,$statustocreate);
        if ($result eq 'redirect') {
            $r->internal_redirect('/adm/switchserver');
            return OK;
        } elsif ($result eq 'existingaccount') {
            $r->print($output);
            &print_footer($r);
            return OK;
        } else {
            $start_page = &Apache::loncommon::start_page($title,$js); 
            &print_header($r,$start_page,$courseid);
            $r->print($output);
            &print_footer($r);    
            return OK;
        }
    }

    my %domconfig =
        &Apache::lonnet::get_dom('configuration',['usercreation'],$domain);
    my ($cancreate,$statustocreate,$statusforemail,$emailusername,
        $emailoptions,$verification,$emaildomain,$types,$usertypes,$othertitle) =
        &get_creation_controls($domain,$domconfig{'usercreation'});
    my ($additems,$pagetitle);
    if (ref($cancreate) eq 'ARRAY') {
        unless (($env{'form.token'}) || ($sso_username ne '') || ($env{'form.phase'}) ||
                ($env{'form.create_with_email'})) {
            if ((grep(/^email$/,@{$cancreate})) && (ref($statusforemail) eq 'ARRAY')) {
                my $usertype = &get_usertype($domain);
                if ((($usertype eq '') || (!grep(/^\Q$usertype\E$/,@{$statusforemail}))) && 
                    (@{$statusforemail} > 0)) {
                    $js .= &setelements_js($statusforemail,$types,$usertypes,$othertitle);
                    $additems = {'add_entries' => { 'onload' => "setElements();"} };
                    if ((@{$cancreate} == 1) && (@{$statusforemail} > 0)) {
                        $pagetitle = 'Select affiliation';
                    }
                } else {
                    $js .= &username_js();
                }
            }
        }
    }
    $start_page = &Apache::loncommon::start_page($title,$js,$additems);
    if (@{$cancreate} == 0) {
        &print_header($r,$start_page,$courseid,$pagetitle);
        my $output = '<h3>'.&mt('Account creation unavailable').'</h3>'.
                     '<span class="LC_warning">'.
                     &mt('Creation of a new user account using an institutional log-in ID or e-mail verification is not permitted for: [_1].',$domdesc).
                     '</span><br /><br />';
        $r->print($output);
        &print_footer($r);
        return OK;
    }

    if ($sso_username ne '') {
        &print_header($r,$start_page,$courseid);
        my ($msg,$sso_logout);
        $sso_logout = &sso_logout_frag($r,$domain);
        if (grep(/^sso$/,@{$cancreate})) {
            $msg = '<h3>'.&mt('Account creation').'</h3>'.
                   &mt("Although your username and password were authenticated by your institution's Single Sign On system, you do not currently have a LON-CAPA account at this institution.").'<br />';
            my $shibenv;
            if (($r->dir_config('lonOtherAuthen') eq 'yes') && 
                ($r->dir_config('lonOtherAuthenType') eq 'Shibboleth')) {
                if (ref($domconfig{'usercreation'}) eq 'HASH') {
                    if (ref($domconfig{'usercreation'}{'cancreate'}) eq 'HASH') {
                        if (ref($domconfig{'usercreation'}{'cancreate'}{'shibenv'}) eq 'HASH') {
                            my @possfields = ('firstname','middlename','lastname','generation',
                                              'permanentemail','id');
                            $shibenv= {};
                            foreach my $key (keys(%{$domconfig{'usercreation'}{'cancreate'}{'shibenv'}})) {
                                if ($key eq 'inststatus') {
                                    if (ref($usertypes) eq 'HASH') {
                                        if ($domconfig{'usercreation'}{'cancreate'}{'shibenv'}{$key} ne '') {
                                            if (exists($usertypes->{$domconfig{'usercreation'}{'cancreate'}{'shibenv'}{$key}})) {
                                                $shibenv->{$key} = $domconfig{'usercreation'}{'cancreate'}{'shibenv'}{$key};
                                             }
                                        }
                                    }
                                } elsif (grep(/^\Q$key\E/,@possfields)) {
                                    if ($domconfig{'usercreation'}{'cancreate'}{'shibenv'}{$key} ne '') {
                                        $shibenv->{$key} = $domconfig{'usercreation'}{'cancreate'}{'shibenv'}{$key};
                                    }
                                }
                            }
                        }
                    }
                }
            }
            $msg .= &username_check($sso_username,$domain,$domdesc,$courseid, 
                                    $lonhost,$contact_email,$contact_name,
                                    $sso_logout,$statustocreate,$shibenv);
        } else {
            $msg = '<h3>'.&mt('Account creation unavailable').'</h3>'.
                   '<span class="LC_warning">'.&mt("Although your username and password were authenticated by your institution's Single Sign On system, you do not currently have a LON-CAPA account at this institution, and you are not permitted to create one.").'</span><br /><br />'.&mt('Please contact the [_1] ([_2]) for assistance.',$contact_name,$contact_email).'<hr />'.
                   $sso_logout;
        }
        $r->print($msg);
        &print_footer($r);
        return OK;
    }

    my ($output,$nostart,$noend,$redirect);
    my $token = $env{'form.token'};
    if ($token) {
        ($output,$nostart,$noend,$redirect) = 
            &process_mailtoken($r,$token,$contact_name,$contact_email,$domain,
                               $domdesc,$lonhost,$include,$start_page,$cancreate,
                               $domconfig{'usercreation'},$types);
        if ($redirect) {
            $r->internal_redirect('/adm/switchserver');
            return OK;
        } elsif ($nostart) {
            if ($noend) {
                return OK;
            } else {
                $r->print($output);
                &print_footer($r);
                return OK;
            }
        } else {
            &print_header($r,$start_page,$courseid);
            $r->print($output);
            &print_footer($r);
            return OK;
        }
    }
    my ($usernameset,$condition,$excluded,$hascustom);
    if ((grep(/^email$/,@{$cancreate})) && (($env{'form.create_with_email'}) ||
                                            ((!$token) && ($env{'form.phase'} eq '')))) {
        my $usertype = &get_usertype($domain);
        if ($usertype eq '') {
            $usertype = 'default';
        }
        if (ref($verification) eq 'HASH') {
            if ($verification->{$usertype} =~ /^(free|first)$/) {
                $usernameset = $verification->{$usertype};
            }
        }
        if (ref($emailoptions) eq 'HASH') {
            if ($emailoptions->{$usertype} =~ /^(inst|noninst)$/) {
                my $chosen = $1;
                if (ref($emaildomain) eq 'HASH') {
                    if (ref($emaildomain->{$usertype}) eq 'HASH') {
                        if ($chosen eq 'inst') {
                            $condition = $emaildomain->{$usertype}->{$chosen};
                        } else {
                            $excluded = $emaildomain->{$usertype}->{$chosen};
                        }
                    }
                }
            } elsif ($emailoptions->{$usertype} eq 'custom') {
                $hascustom = 1;
            }
        }
    }
    if ($env{'form.phase'} eq 'username_activation') {
        (my $result,$output,$nostart) = 
            &username_activation($r,$env{'form.uname'},$domain,$domdesc,
                                 $courseid);
        if ($result eq 'redirect') {
            $r->internal_redirect('/adm/switchserver');
            return OK; 
        } elsif ($result eq 'ok') {
            if ($nostart) {
                return OK;
            }
        }
        &print_header($r,$start_page,$courseid);
        $r->print($output);
        &print_footer($r);
        return OK;
    } elsif ($env{'form.phase'} eq 'username_validation') { 
        (my $result,$output) = 
            &username_validation($r,$env{'form.uname'},$domain,$domdesc,
                                 $contact_name,$contact_email,$courseid,
                                 $lonhost,$statustocreate);
        if ($result eq 'existingaccount') {
            $r->print($output);
            &print_footer($r);
            return OK;
        } else {
            &print_header($r,$start_page,$courseid);
        }
    } elsif ($env{'form.create_with_email'}) {
        &print_header($r,$start_page,$courseid);
        my $usertype = &get_usertype($domain);
        if ($usertype eq '') {
            $usertype = 'default';
        }
        $output = &process_email_request($env{'form.uname'},$domain,$domdesc,
                                         $contact_name,$contact_email,$cancreate,
                                         $lonhost,$domconfig{'usercreation'},
                                         $emailusername,$courseid,$usertype,
                                         $usernameset,$condition,$excluded,$hascustom);
    } elsif (!$token) {
        &print_header($r,$start_page,$courseid,$pagetitle);
        my $now=time;
        if ((grep(/^login$/,@{$cancreate})) && (!grep(/^email$/,@{$cancreate}))) {
            if (open(my $jsh,"<","$include/londes.js")) {
                while(my $line = <$jsh>) {
                    $r->print($line);
                }
                close($jsh);
                $r->print(&javascript_setforms($now));
            }
        }
        if (grep(/^email$/,@{$cancreate})) {
            $r->print(&javascript_validmail($condition));
        }
        my $usertype = &get_usertype($domain);
        $output = &print_username_form($r,$domain,$domdesc,$cancreate,$now,$lonhost,
                                       $include,$courseid,$emailusername,
                                       $statusforemail,$usernameset,$condition,
                                       $excluded,$usertype,$types,$usertypes,$othertitle);
    }
    $r->print($output);
    &print_footer($r);
    return OK;
}

sub print_header {
    my ($r,$start_page,$courseid,$pagetitle) = @_;
    $r->print($start_page);
    &Apache::lonhtmlcommon::clear_breadcrumbs();
    my $url = '/adm/createaccount';
    if ($pagetitle eq '') {
        $pagetitle = 'New username';
    }
    if ($courseid ne '') {
        my %coursehash = &Apache::lonnet::coursedescription($courseid);
        &selfenroll_crumbs($r,$courseid,$coursehash{'description'});
    }
    if ($env{'form.reportedtype'}) {
        &Apache::lonhtmlcommon::add_breadcrumb
        ({href=>$url,
          text=>"Select affiliation"});
    }
    &Apache::lonhtmlcommon::add_breadcrumb
    ({href=>$url,
      text=>$pagetitle});
    $r->print(&Apache::lonhtmlcommon::breadcrumbs('Create account'));
    return;
}

sub print_footer {
    my ($r) = @_;
    if ($env{'form.courseid'} ne '') {
        $r->print('<form name="backupcrumbs" method="post" action="">'.
                  &Apache::lonhtmlcommon::echo_form_input(['backto','logtoken',
                      'token','serverid','uname','upass','phase','create_with_email',
                      'code','crypt','cfirstname','clastname','g-recaptcha-response',
                      'recaptcha_challenge_field','recaptcha_response_field',
                      'cmiddlename','cgeneration','cpermanentemail','cid']).
                  '</form>');
    }
    $r->print(&Apache::loncommon::end_page());
}

sub get_usertype {
    my ($domain) = @_;
    my $usertype;
    my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($domain);
    if (ref($types) eq 'ARRAY') {
        push(@{$types},'default');
        my $posstype = $env{'form.type'};
        $posstype =~ s/^\s+|\s$//g;
        if (grep(/^\Q$posstype\E$/,@{$types})) {
            $usertype = $posstype;
        }
    }
    return $usertype;
}

sub selfenroll_crumbs {
    my ($r,$courseid,$desc) = @_;
    &Apache::lonhtmlcommon::add_breadcrumb
         ({href=>"javascript:ToCatalog('backupcrumbs','')",
           text=>"Course/Community Catalog"});
    if ($env{'form.coursenum'} ne '') {
        &Apache::lonhtmlcommon::add_breadcrumb
          ({href=>"javascript:ToCatalog('backupcrumbs','details')",
            text=>"Course details"});
    }
    my $last_crumb;
    if ($desc ne '') {
        $last_crumb = &mt("Self-enroll in [_1]","'$desc'");
    } else {
        $last_crumb = &mt('Self-enroll');
    }
    &Apache::lonhtmlcommon::add_breadcrumb
                   ({href=>"javascript:ToSelfenroll('backupcrumbs')",
                     text=>$last_crumb,
                     no_mt=>"1"});
    return;
}

sub javascript_setforms {
    my ($now,$emailusername,$captcha,$usertype,$recaptchaversion,$usernameset,$condition,$excluded) =  @_;
    my ($setuserinfo,@required,$requiredchk);
    if (ref($emailusername) eq 'HASH') {
        if (ref($emailusername->{$usertype}) eq 'HASH') {  
            foreach my $key (sort(keys(%{$emailusername->{$usertype}}))) {
                if ($emailusername->{$usertype}{$key} eq 'required') {
                    push(@required,$key); 
                }
                $setuserinfo .= '                    server.elements.'.$key.'.value=client.elements.'.$key.'.value;'."\n";
            }
            if ($usertype ne '') {
                $setuserinfo .= '                    server.elements.type.value=client.elements.type.value;'."\n";
            }
        }
        if ($captcha eq 'original') {
            $setuserinfo .= '                    server.elements.code.value=client.elements.code.value;'."\n".
                            '                    server.elements.crypt.value=client.elements.crypt.value;'."\n";
        } elsif ($captcha eq 'recaptcha') {
            if ($recaptchaversion ne '2') {
                $setuserinfo .=
                '                    server.elements.recaptcha_challenge_field.value=client.elements.recaptcha_challenge_field.value;'."\n".
                '                    server.elements.recaptcha_response_field.value=client.elements.recaptcha_response_field.value;'."\n";
            }
        }
        if ($usernameset eq 'free') {
            $setuserinfo .=
                '                    server.elements.username.value=client.elements.username.value;'."\n";
        }
    }
    if (@required) {
        my $missprompt = &mt('One or more required fields are currently blank.');
        &js_escape(\$missprompt);
        my $reqstr = join("','",@required);
        $requiredchk = <<"ENDCHK";
                var requiredfields = new Array('$reqstr');
                missing = 0; 
                for (var i=0; i<requiredfields.length; i++) {
                    try {
                        eval("client.elements."+requiredfields[i]+".value");
                    }
                    catch(err) {
                        continue;
                    }
                    if (eval("client.elements."+requiredfields[i]+".value") == '') {
                        missing ++;
                    }
                }
                if (missing > 0) {
                    alert("$missprompt");
                    return false;
                }

ENDCHK
    }
    my $js = <<ENDSCRIPT;
<script type="text/javascript">
// <![CDATA[
    function send(one,two,context) {
        var server;
        var client;
        if (document.forms[one]) {
            server = document.forms[one];
            if (document.forms[two]) {
                client = document.forms[two];
$requiredchk
                server.elements.uname.value = client.elements.uname.value;
                server.elements.udom.value = client.elements.udom.value;

                uextkey=client.elements.uextkey.value;
                lextkey=client.elements.lextkey.value;
                initkeys();
                server.elements.upass.value
                    = getCrypted(client.elements.upass$now.value);
                client.elements.uname.value='';
                client.elements.upass$now.value='';
                if (context == 'email') {
$setuserinfo
                    client.elements.upasscheck$now.value='';
                }
                server.submit();
            }
        }
        return false;
    }

// ]]>
</script>
ENDSCRIPT
    if (($captcha eq 'recaptcha') && ($recaptchaversion eq '2')) {
        $js .= "\n".'<script src="https://www.google.com/recaptcha/api.js"></script>'."\n";
    }
    return $js;
}

sub javascript_checkpass {
    my ($now,$context,$domain) = @_;
    my $nopass = &mt('You must enter a password.');
    my $mismatchpass = &mt('The passwords you entered did not match.')."\n".
                       &mt('Please try again.'); 
    my ($numrules,$intargjs) =
        &Apache::loncommon::passwd_validation_js('upass',$domain);
    &js_escape(\$nopass);
    &js_escape(\$mismatchpass);
    my $js = <<"ENDSCRIPT";
<script type="text/javascript">
// <![CDATA[
    function checkpass(one,two) {
        var client;
        if (document.forms[two]) {
            client = document.forms[two]; 
            var upass = client.elements.upass$now.value;
            var upasscheck = client.elements.upasscheck$now.value;
            if (upass == '') {
                alert("$nopass");
                return false;
            }
            if (upass == upasscheck) {
                var numrules = $numrules;
                if (numrules > 0) {
$intargjs
                }
                client.elements.upasscheck$now.value='';
                if (validate_email(client)) {
                    send(one,two,'$context');
                } 
                return false;
            } else {
                alert("$mismatchpass");
                return false;
            }
        }
        return false; 
    }
// ]]>
</script>
ENDSCRIPT
    return $js;
}

sub javascript_validmail {
    my ($condition) = @_;
    my %js_lt = &Apache::lonlocal::texthash (
               email => 'The e-mail address you entered',
               notv  => 'is not a valid e-mail address',
               avae  => 'A valid e-mail address is not formed when the value you entered is combined with the required domain',
    );
    my $output =  "\n".'<script type="text/javascript">'."\n".
                  '// <![CDATA['."\n".
                  &Apache::lonhtmlcommon::javascript_valid_email()."\n";
    &js_escape(\%js_lt);
    $output .= <<"ENDSCRIPT";
function validate_email(client) {
    field = client.uname;
    var condition = '$condition';
    if (validmail(field,condition) == false) {
        if ((condition != undefined) && (condition != '')) {
            alert("$js_lt{'avae'}: "+condition);
        } else {
            alert("$js_lt{'email'}: "+field.value+" $js_lt{'notv'}.");
        }
        return false;
    }
    return true;
}
ENDSCRIPT
    $output .= "\n".'// ]]>'."\n".'</script>'."\n";
    return $output;
}

sub print_username_form {
    my ($r,$domain,$domdesc,$cancreate,$now,$lonhost,$include,$courseid,$emailusername,
        $statusforemail,$usernameset,$condition,$excluded,$usertype,$types,$usertypes,
        $othertitle) = @_;
    my %lt = &Apache::lonlocal::texthash (
                                         crac => 'Create account with a username provided by this institution',
                                         clca => 'Create LON-CAPA account',
                                         type => 'Type in your log-in ID and password to find out.',
                                         plse => 'Please provide a password for your new account.',
                                         info => 'Please provide user information and a password for your new account.',
                                         yopw => 'Your password will be encrypted when sent (and stored).',
                                         crae => 'Create account using e-mail address verification',
                                         );
    my $output;
    if (ref($cancreate) eq 'ARRAY') {
        if (grep(/^login$/,@{$cancreate})) {
            my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
            if ((($domdefaults{'auth_def'} =~/^krb/) && ($domdefaults{'auth_arg_def'} ne '')) || ($domdefaults{'auth_def'} eq 'localauth')) {
                $output = '<div class="LC_left_float"><h3>'.$lt{'crac'}.'</h3>';
                $output .= &mt('If you already have a log-in ID at this institution [_1]you may be able to use it for LON-CAPA.','<br />').
                           '<br /><br />'.
                           $lt{'type'}.
                           '<br /><br />';
                $output .= &login_box($now,$lonhost,$courseid,$lt{'clca'},
                                      $domain,'createaccount').'</div>';
            }
        }
        if (grep(/^email$/,@{$cancreate})) {
            $output .= '<div class="LC_left_float"><h3>'.$lt{'crae'}.'</h3>';
            if ($usertype ne '') {
                if ((ref($statusforemail) eq 'ARRAY') && (@{$statusforemail} > 0)) {
                    unless (grep(/^\Q$usertype\E$/,@{$statusforemail})) {
                        undef($usertype);
                    }
                } elsif ($usertype ne 'default') {
                    undef($usertype);
                }
            }
            if (($usertype eq '') && (ref($statusforemail) eq 'ARRAY') && 
                (@{$statusforemail} > 0) && (ref($types) eq 'ARRAY') && (@{$types} > 0)) {
                my @posstypes = @{$types};
                unless (grep(/^default$/,@posstypes)) {
                    push(@posstypes,'default');
                }
                $output .= '<p>'.&mt('Choose your affiliation at [_1]',$domdesc).'</p>'."\n".
                           '<form name="reportstatus" id="LC_reportstatus" action="/adm/createaccount" method="post" '.
                           'onsubmit="return checkVerification();"><p>';
                foreach my $type (@posstypes) {
                    my $name;
                    if ($type eq 'default') {
                        $name = $othertitle;
                    } else {
                        $name = $type;
                        if (ref($usertypes) eq 'HASH') {
                            if (exists($usertypes->{$type})) {
                                $name = $usertypes->{$type};
                            }
                        }
                    }
                    my $checked;
                    if ($env{'form.type'} eq $type) {
                        $checked = ' checked="checked"';
                    }
                    $output .= '<label><input type="radio" name="type" value="'.$type.'"'.$checked.' />'.
                               $name.'</label>'.('&nbsp;'x2);
                }
                if ($env{'form.courseid'} =~ /^$match_domain\_$match_courseid$/) {
                    $output .= "\n".'<input type="hidden" name="courseid" value="'.$env{'form.courseid'}.'" />';
                }
                $output .= '</p>'."\n".'<p><input type="submit" name="reportedtype" value="'.&mt('Submit').'" /></p></form>';
            } else {
                my ($captchaform,$error,$captcha,$recaptchaversion) = 
                    &Apache::loncommon::captcha_display('usercreation',$lonhost);
                if ($error) {
                    my $helpdesk = '/adm/helpdesk?origurl=%2fadm%2fcreateaccount';
                    if ($courseid ne '') {
                        $helpdesk .= '&courseid='.$courseid;
                    }
                    $output .= '<span class="LC_error">'.
                               &mt('An error occurred generating the validation code[_1] required for use of an e-mail address to request a LON-CAPA account.','<br />').
                               '</span><br /><br />'.
                               &mt('[_1]Contact the helpdesk[_2] or [_3]reload[_2] the page and try again.',
                                   '<a href="'.$helpdesk.'">','</a>','<a href="javascript:window.location.reload()">');
                } else {
                    if (grep(/^login$/,@{$cancreate})) {
                        $output .= &mt('If you do not have a log-in ID at your institution, [_1]provide your e-mail address to request a LON-CAPA account.','<br />').'<br /><br />'.
                                   $lt{'plse'}.'<br />'.
                                   $lt{'yopw'}.'<br />';
                    } else {
                        my $prompt = $lt{'plse'};
                        if (ref($emailusername) eq 'HASH') {
                            if (ref($emailusername->{$usertype}) eq 'HASH') {
                                if (keys(%{$emailusername->{$usertype}}) > 0) {
                                    $prompt = $lt{'info'};
                                }
                            }
                        }
                        $output .= $prompt.'<br />'.
                                   $lt{'yopw'}.'<br />';
                    }
                    if ($usertype eq '') {
                        $usertype = 'default';
                    } elsif (ref($usertypes) eq 'HASH') {
                        my $usertitle;
                        if ($usertype eq 'default') {
                            $usertitle = $othertitle;
                        } elsif (exists($usertypes->{$usertype})) {
                            $usertitle = $usertypes->{$usertype};
                        }
                        if ($usertitle ne '') {
                            $output .= &mt('Self-reported affiliation: [_1]',
                                           '<span style="font-style: italic;">'.$usertitle.'</span>').
                                       '<br />';
                        }
                    }
                    $output .= &print_dataentry_form($r,$domain,$lonhost,$include,$now,$captchaform,
                                                     $courseid,$emailusername,$captcha,$usertype,
                                                     $recaptchaversion,$usernameset,$condition,$excluded);
                }
            }
            $output .= '</div>';
        }
    }
    if ($output eq '') {
        $output = &mt('Creation of a new LON-CAPA user account using an institutional log-in ID or verification by e-mail is not permitted at [_1].',$domdesc);
    } else {
        $output .= '<div class="LC_clear_float_footer"></div>';
    }
    return $output;
}

sub login_box {
    my ($now,$lonhost,$courseid,$submit_text,$domain,$context) = @_;
    my $output;
    my %titles = &Apache::lonlocal::texthash(
                                              createaccount => 'Log-in ID',
                                              selfenroll    => 'Username',
                                            );
    my ($lkey,$ukey) = &Apache::loncommon::des_keys();
    my ($lextkey,$uextkey) = &getkeys($lkey,$ukey);
    my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount:createaccount',
                                       $lonhost);
    $output = &serverform($logtoken,$lonhost,undef,$courseid,$context);
    my $unameform = '<input type="text" name="uname" size="20" value="" autocomplete="off" />';
    my $upassform = '<input type="password" name="upass'.$now.'" size="20" autocomplete="new-password" />';
    $output .= '<form name="client" method="post" action="" onsubmit="return(send('."'server','client'".'));">'."\n".
               &Apache::lonhtmlcommon::start_pick_box()."\n".
               &Apache::lonhtmlcommon::row_title($titles{$context},
                                                 'LC_pick_box_title')."\n".
               $unameform."\n".
               &Apache::lonhtmlcommon::row_closure(1)."\n".
               &Apache::lonhtmlcommon::row_title(&mt('Password'),
                                                'LC_pick_box_title')."\n".
               $upassform;
    if ($context eq 'selfenroll') {
        my $udomform = '<input type="text" name="udom" size="10" value="'.
                        $domain.'" />';
        $output .= &Apache::lonhtmlcommon::row_closure(1)."\n".
                   &Apache::lonhtmlcommon::row_title(&mt('Domain'),
                                                     'LC_pick_box_title')."\n".
                   $udomform."\n";
    } else {
        $output .= '<input type="hidden" name="udom" value="'.$domain.'" />';
    }
    $output .= &Apache::lonhtmlcommon::row_closure(1).
               &Apache::lonhtmlcommon::row_title().
               '<br /><input type="submit" name="username_validation" value="'.
               $submit_text.'" />'."\n";
    if ($context eq 'selfenroll') {
        $output .= '<br /><br /><table width="100%"><tr><td align="right">'.
                   '<span class="LC_fontsize_medium">'.
                   '<a href="/adm/resetpw">'.&mt('Forgot password?').'</a>'.
                   '</span></td></tr></table>'."\n";
    }
    $output .= &Apache::lonhtmlcommon::row_closure(1)."\n".
               &Apache::lonhtmlcommon::end_pick_box().'<br />'."\n";
    $output .= '<input type="hidden" name="lextkey" value="'.$lextkey.'" />'."\n".
               '<input type="hidden" name="uextkey" value="'.$uextkey.'" />'."\n".
               '</form>';
    return $output;
}

sub process_email_request {
    my ($useremail,$domain,$domdesc,$contact_name,$contact_email,$cancreate,
        $server,$settings,$emailusername,$courseid,$usertype,$usernameset,
        $condition,$excluded,$hascustom) = @_;
    my ($output,$uname);
    if (ref($cancreate) eq 'ARRAY') {
        if (!grep(/^email$/,@{$cancreate})) {
            $output = &invalid_state('noemails',$domdesc,
                                     $contact_name,$contact_email);
            return $output;
        } elsif ((($condition ne '') && ($useremail !~ /^[^\@]+$/)) ||
                 (($condition eq '') && ($useremail !~ /^[^\@]+\@[^\@]+\.[^\@\.]+$/))) {
            $output = &invalid_state('baduseremail',$domdesc,
                                     $contact_name,$contact_email);
            return $output;
        } else {
            $useremail =~ s/^\s+|\s+$//g;
            my $possuname;
            if ($condition ne '') {
                if ($usernameset eq 'first') {
                    $possuname = $useremail;
                }
                $useremail .= $condition;
            } elsif ($excluded ne '') {
                if ($useremail =~ /^[^\@]+\Q$excluded\E$/) {
                    $output = &invalid_state('userrules',$domdesc,
                                     $contact_name,$contact_email);
                    return $output;
                } 
            }
            if (($usernameset eq 'free') && ($env{'form.username'} ne '')) {
                $possuname = $env{'form.username'};
            } elsif (($usernameset eq 'first') && ($condition eq '')) {
                if ($condition eq '') {
                    ($possuname) = ($useremail =~ /^([^\@]+)\@/);
                }
            }
            if ($possuname ne '') {
                $possuname  =~ s/^\s+|\s+$//g;
                if ($possuname ne '') {
                    $uname=&LONCAPA::clean_username($possuname);
                    if ($uname ne $possuname) {
                        $output = &invalid_state('badusername',$domdesc,
                                                 $contact_name,$contact_email);
                        return $output;
                    }
                }
            }
            if ($possuname eq '') {
                $uname=&LONCAPA::clean_username($useremail);
                if ($useremail ne $uname) {
                    $output = &invalid_state('badusername',$domdesc,
                                             $contact_name,$contact_email);
                    return $output;
                }
            }
            my $uhome = &Apache::lonnet::homeserver($uname,$domain);
            if ($uhome ne 'no_host') {
                $output = &invalid_state('existinguser',$domdesc,
                                         $contact_name,$contact_email);
                return $output;
            } else {
                my ($captcha_chk,$captcha_error) = &Apache::loncommon::captcha_response('usercreation',$server);
                if ($captcha_chk != 1) {
                    $output = '<span class="LC_warning">'.
                              &mt('Validation of the code you entered failed.').'</span>'.
                              '<br />'.$captcha_error."\n".'<br /><p>'.
                               &mt('[_1]Return[_2] to the previous page to try again.',
                                   '<a href="javascript:document.retryemail.submit();">','</a>')."\n".
                              '<form name="retryemail" action="/adm/createaccount" method="post" />'.
                              '<input type="hidden" name="domain" value="'.$domain.'" />'."\n";
                    if ($env{'form.courseid'} =~ /^$match_domain\_$match_courseid$/) {
                        $output .= '<input type="hidden" name="courseid" value="'.$env{'form.courseid'}.'" />'."\n";
                    }
                    if ($env{'form.type'}) {
                        my $usertype = &get_usertype($domain);
                        if ($usertype ne '') {
                            $output .= '<input type="hidden" name="type" value="'.$usertype.'" />'."\n".
                                       '<input type="hidden" name="reportedtype" value="'.&mt('Submit').'" />'."\n";
                        }
                    }
                    $output .= '</form></p>';
                    return $output;
                }
                my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts);
                &call_rulecheck($uname,$domain,\%alerts,\%rulematch,
                                \%inst_results,\%curr_rules,\%got_rules,'username');
                if (ref($alerts{'username'}) eq 'HASH') {
                    if (ref($alerts{'username'}{$domain}) eq 'HASH') {
                        if ($alerts{'username'}{$domain}{$uname}) {
                            $output = &invalid_state('userrules',$domdesc,
                                                     $contact_name,$contact_email);
                            return $output;
                        }
                    }
                }
                if ($hascustom) {
                    my $format_msg = 
                        &guest_format_check($useremail,$domain,$cancreate,
                                            $settings,$usertype);
                    if ($format_msg) {
                        $output = &invalid_state('userformat',$domdesc,$contact_name,
                                                 $contact_email,$format_msg);
                        return $output;
                    }
                }
            }
        }
        $output = &send_token($domain,$useremail,$server,$domdesc,$contact_name,
                              $contact_email,$courseid,$emailusername,$usertype,
                              $uname);
    }
    return $output;
}

sub call_rulecheck {
    my ($uname,$udom,$alerts,$rulematch,$inst_results,$curr_rules,
        $got_rules,$tocheck) = @_;
    my ($checkhash,$checks);
    $checkhash->{$uname.':'.$udom} = { 'newuser' => 1, };
    if ($tocheck eq 'username') {
        $checks = { 'username' => 1 };
    }
    &Apache::loncommon::user_rule_check($checkhash,$checks,
           $alerts,$rulematch,$inst_results,$curr_rules,
           $got_rules);
    return;
}

sub send_token {
    my ($domain,$email,$server,$domdesc,$contact_name,$contact_email,$courseid,$emailusername,
        $usertype,$uname) = @_;
    my $msg = '<h3>'.&mt('Account creation status').'</h3>'.
              &mt('Thank you for your request to create a new LON-CAPA account.').
              '<br /><br />';
    my $now = time;
    $env{'form.logtoken'} =~ s/(`)//g;
    if ($env{'form.logtoken'}) {
        my $logtoken = $env{'form.logtoken'};
        my $earlyout;
        my $tmpinfo=Apache::lonnet::reply('tmpget:'.$logtoken,$server);
        if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
            $msg = &mt('Information needed to process your request is missing, inaccessible or expired.')
                  .'<br /><p>'.&mt('[_1]Return[_2] to the previous page to try again.',
                                   '<a href="javascript:document.retryemail.submit();">','</a>');
            $earlyout = 1;
        } else {
            my $reply = &Apache::lonnet::reply('tmpdel:'.$logtoken,$server);
            unless ($reply eq 'ok') {
                $msg .= &mt('Request could not be processed.');
            }
        }
# Check if the password entered by the user satisfies domain's requirements
        my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
        my ($min,$max,@chars);
        $min = $Apache::lonnet::passwdmin;
        if (ref($passwdconf{'chars'}) eq 'ARRAY') {
            if ($passwdconf{'min'} =~ /^\d+$/) {
                if ($passwdconf{'min'} > $min) {
                    $min = $passwdconf{'min'};
                }
            }
            if ($passwdconf{'max'} =~ /^\d+$/) {
                $max = $passwdconf{'max'};
            }
            @chars = @{$passwdconf{'chars'}};
        }
        my $encpass = $env{'form.upass'};
        if ($encpass eq '') {
            $msg = &mt('Password retrieved was blank.').
                   '<br /><p>'.&mt('[_1]Return[_2] to the previous page to try again.',
                                   '<a href="javascript:document.retryemail.submit();">','</a>');
            $earlyout = 1;
        } else {
# Split the logtoken to retrieve the DES key and decrypt the encypted password
            my ($key,$caller)=split(/&/,$tmpinfo);
            if ($caller eq 'createaccount') {
                my $plainpass = &Apache::loncommon::des_decrypt($key,$encpass);
                if (($min > 0) || ($max ne '') || (@chars > 0)) {
                    my $warning = &Apache::loncommon::check_passwd_rules($domain,$plainpass);
                    if ($warning) {
                        $msg = $warning.
                               '<p>'.&mt('[_1]Return[_2] to the previous page to try again.',
                                         '<a href="javascript:document.retryemail.submit();">','</a>');
                        $earlyout = 1;
                    }
                }
            }
        }
        if ($earlyout) {
            $msg .= '<form name="retryemail" action="/adm/createaccount" method="post" />'.
                    '<input type="hidden" name="domain" value="'.$domain.'" />'."\n";
            if ($env{'form.courseid'} =~ /^$match_domain\_$match_courseid$/) {
                $msg .= '<input type="hidden" name="courseid" value="'.$env{'form.courseid'}.'" />'."\n";
            }
            if ($env{'form.type'}) {
                my $usertype = &get_usertype($domain);
                if ($usertype ne '') {
                    $msg .= '<input type="hidden" name="type" value="'.$usertype.'" />'.
                            '<input type="hidden" name="reportedtype" value="'.&mt('Submit').'" />'."\n";
                }
            }
            $msg .= '</form></p>';
            return $msg;
        }
        my $ip = &Apache::lonnet::get_requestor_ip();
        my %info = ('ip'         => $ip,
                    'time'       => $now,
                    'domain'     => $domain,
                    'username'   => $email,
                    'courseid'   => $courseid,
                    'upass'      => $env{'form.upass'},
                    'serverid'   => $env{'form.serverid'},
                    'tmpinfo'    => $tmpinfo);
        if ($uname ne '') {
            $info{'username'} = $uname;
            $info{'email'} = $email;
        }
        if (ref($emailusername) eq 'HASH') {
            if (ref($emailusername->{$usertype}) eq 'HASH') {
                foreach my $item (keys(%{$emailusername->{$usertype}})) {
                    $info{$item} = $env{'form.'.$item};
                    $info{$item} =~ s/(`)//g;
                }
            }
        }
        if ($usertype ne '') {
           $info{'usertype'} = $usertype;
        }
        my $token = &Apache::lonnet::tmpput(\%info,$server,'createaccount');
        if ($token !~ /^error/ && $token ne 'no_such_host') {
            my $esc_token = &escape($token);
            my $showtime = localtime(time);
            my $mailmsg = &mt('A request was submitted on [_1] for creation of a LON-CAPA account at the following institution: [_2].',$showtime,$domdesc).' '.
                          &mt('To complete this process please open a web browser and enter the following URL in the address/location box: [_1]',
                          &Apache::lonnet::absolute_url().'/adm/createaccount?token='.$esc_token);
            my $result = &Apache::resetpw::send_mail($domdesc,$email,$mailmsg,$contact_name,
                                                     $contact_email);
            if ($result eq 'ok') {
                $msg .= &mt('A message has been sent to the e-mail address you provided.').'<br />'.
                        &mt('The message includes the web address for the link you will use to complete the account creation process.').'<br />'.
                        &mt("The link included in the message will be valid for the next [_1]two[_2] hours.",'<b>','</b>');
            } else {
                $msg .= '<span class="LC_error">'.
                        &mt('An error occurred when sending a message to the e-mail address you provided.').'</span><br />'.
                        ' '.&mt('Please contact the [_1] ([_2]) for assistance.',$contact_name,$contact_email);
            }
        } else {
            $msg .= '<span class="LC_error">'.
                    &mt('An error occurred creating a token required for the account creation process.').'</span><br />'.
                    ' '.&mt('Please contact the [_1] ([_2]) for assistance.',$contact_name,$contact_email);
        }
    } else {
        $msg .=  $msg = &mt('Information needed to process your request is missing, inaccessible or expired.')
                .'<br />'.&mt('Return to the previous page to try again.');

    }
    return $msg;
}

sub process_mailtoken {
    my ($r,$token,$contact_name,$contact_email,$domain,$domdesc,$lonhost,
        $include,$start_page,$cancreate,$settings,$types) = @_;
    my ($msg,$nostart,$noend,$redirect);
    my %data = &Apache::lonnet::tmpget($token);
    my $now = time;
    if (keys(%data) == 0) {
        $msg = &mt('Sorry, the URL you provided to complete creation of a new LON-CAPA account was invalid.')
               .' '.&mt('Either the token included in the URL has been deleted or the URL you provided was invalid.')
               .' '.&mt('Please submit a [_1]new request[_2] for account creation and follow the new link page included in the e-mail that will be sent to you.',
                        '<a href="/adm/createaccount">','</a>');
        return $msg;
    }
    if (($data{'time'} =~ /^\d+$/) &&
        ($data{'domain'} ne '') &&
        ((($data{'email'} =~ /^[^\@]+\@[^\@]+\.[^\@\.]+$/) && ($data{'username'} =~ /^$match_username$/)) ||
          ($data{'username'}  =~ /^[^\@]+\@[^\@]+\.[^\@\.]+$/))) {
        if ($now - $data{'time'} < 7200) {
# Check if request should be queued.
            if (ref($cancreate) eq 'ARRAY') {
                my ($disposition,$usertype);
                if (grep(/^email$/,@{$cancreate})) {
                    if (exists($data{'usertype'})) {
                        $usertype = $data{'usertype'};
                        my @posstypes;
                        if (ref($types) eq 'ARRAY') {
                            @posstypes = @{$types};
                            if (@posstypes) {
                                unless (grep(/^default$/,@posstypes)) {
                                    push(@posstypes,'default');
                                }
                            }
                            if (grep(/\Q$usertype\E/,@posstypes)) {
                                unless ($usertype eq 'default') {
                                    $data{'inststatus'} = $usertype;
                                }
                            } else {
                                $disposition = 'approval';
                            }
                        }
                        delete($data{'usertype'});
                    }
                    if (ref($settings) eq 'HASH') {
                        if (ref($settings->{'cancreate'}) eq 'HASH') {
                            if (ref($settings->{'cancreate'}{'selfcreateprocessing'}) eq 'HASH') {
                                if ($usertype ne '') {
                                    $disposition = $settings->{'cancreate'}{'selfcreateprocessing'}{$usertype};
                                    unless ($disposition =~ /^(approval|automatic)$/) {
                                        $disposition = 'approval';
                                    }
                                }
                            }
                        }
                    }
                    if ($disposition eq 'approval') {
                        $msg = &store_request($domain,$data{'username'},'approval',\%data,$settings);
                        my $delete = &Apache::lonnet::tmpdel($token);
                    } else {
                        my ($result,$output,$uhome) = 
                            &create_account($r,$domain,$domdesc,\%data);
                        if ($result eq 'ok') {
                            $msg = $output;
                            my $ip = &Apache::lonnet::get_requestor_ip();
                            my $shownow = &Apache::lonlocal::locallocaltime($now);
                            my $mailmsg = &mt('A LON-CAPA account for the institution: [_1] has been created [_2] from IP address: [_3]. If you did not perform this action or authorize it, please contact the [_4] ([_5]).',$domdesc,$shownow,$ip,$contact_name,$contact_email)."\n";
                            my $mailresult = &Apache::resetpw::send_mail($domdesc,$data{'email'},
                                                                        $mailmsg,$contact_name,
                                                                        $contact_email);
                            if ($mailresult eq 'ok') {
                                $msg .= &mt('An e-mail confirming creation of your new LON-CAPA account has been sent to [_1].',$data{'username'});
                            } else {
                                $msg .= &mt('An error occurred when sending e-mail to [_1] confirming creation of your LON-CAPA account.',$data{'username'});
                            }
                            $redirect = &start_session($r,$data{'username'},$domain,$uhome,
                                                       $data{'courseid'},$token);
                            $nostart = 1;
                            $noend = 1;
                        } else {
                            $msg .= &mt('A problem occurred when attempting to create your new LON-CAPA account.')
                                   .'<br />'.$output;
                            if (($contact_name ne '') && ($contact_email ne '')) {
                                $msg .= &mt('Please contact the [_1] ([_2]) for assistance.',$contact_name,$contact_email);
                            }
                        }
                        my $delete = &Apache::lonnet::tmpdel($token);
                    }
                } else {
                    $msg = &invalid_state('noemails',$domdesc,$contact_name,$contact_email);
                }
            } else {
                $msg = &invalid_state('noemails',$domdesc,$contact_name,$contact_email);
            }
        } else {
            $msg = &mt('Sorry, the token generated when you requested creation of an account has expired.')
                  .' '.&mt('Please submit a [_1]new request[_2] for account creation and follow the new link included in the e-mail that will be sent to you.','<a href="/adm/createaccount">','</a>');
            }
    } else {
        $msg .= &mt('Sorry, the URL generated when you requested creation of an account contained incomplete information.')
               .' '.&mt('Please submit a [_1]new request[_2] for account creation and follow the new link included in the e-mail that will be sent to you.','<a href="/adm/createaccount">','</a>');
    }
    return ($msg,$nostart,$noend,$redirect);
}

sub start_session {
    my ($r,$username,$domain,$uhome,$courseid,$token) = @_;
    my ($is_balancer) = &Apache::lonnet::check_loadbalancing($username,$domain);
    if ($is_balancer) {
        Apache::lonauth::success($r, $username, $domain, $uhome,
            'noredirect', undef, {});

        Apache::lonnet::tmpdel($token) if $token;

        return 'redirect';
    } else {
        $courseid = Apache::lonnet::is_course($courseid); 

        Apache::lonauth::success($r, $username, $domain, $uhome,
            ($courseid ? "/adm/selfenroll?courseid=$courseid" : '/adm/roles'),
            undef, {}); 
    }
    return;
}

#
# The screen that the user gets to create his or her account
# Desired username, desired password, etc
# Stores token to store DES-key and stage during creation session
#
sub print_dataentry_form {
    my ($r,$domain,$lonhost,$include,$now,$captchaform,$courseid,$emailusername,$captcha,
        $usertype,$recaptchaversion,$usernameset,$condition,$excluded) = @_;
    my ($error,$output);
    if (open(my $jsh,"<","$include/londes.js")) {
        while(my $line = <$jsh>) {
            $r->print($line);
        }
        close($jsh);
        $output = &javascript_setforms($now,$emailusername,$captcha,$usertype,$recaptchaversion,
                                       $usernameset,$condition,$excluded).
                  "\n".&javascript_checkpass($now,'email',$domain);
        my ($lkey,$ukey) = &Apache::loncommon::des_keys();
        my ($lextkey,$uextkey) = &getkeys($lkey,$ukey);
        my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount:createaccount',
                                           $lonhost);
        my $showsubmit = 1;
        my $serverform =
            '<form name="createaccount" method="post" target="_top" action="/adm/createaccount">';
        if ($courseid ne '') {
            $serverform .= '<input type="hidden" name="courseid" value="'.$courseid.'"/>'."\n";
        }
        if (ref($emailusername) eq 'HASH') {
            if (ref($emailusername->{$usertype}) eq 'HASH') {
                foreach my $field (sort(keys(%{$emailusername->{$usertype}}))) {
                    $serverform .= '<input type="hidden" name="'.$field.'" value="" />'."\n";
                }
            }
        }
        if ($captcha eq 'original') {
            $serverform .= '
   <input type="hidden" name="crypt" value="" />
   <input type="hidden" name="code" value="" />
';
        } elsif ($captcha eq 'recaptcha') {
            if ($recaptchaversion eq '2') {
                $serverform .= &Apache::lonhtmlcommon::start_pick_box().
                               &Apache::lonhtmlcommon::row_title(&mt('Validation').'<b>*</b>',
                                                                 'LC_pick_box_title',
                                                                 'LC_oddrow_value')."\n".
                                                                 $captchaform.
                               &Apache::lonhtmlcommon::row_closure(1)."\n".
                               &Apache::lonhtmlcommon::row_title()."\n".
                               '<br /><input type="button" name="createaccount" value="'.
                               &mt('Create account').'" onclick="checkpass('."'createaccount','newemail'".')" />'.
                               &Apache::lonhtmlcommon::row_closure(1)."\n".
                               &Apache::lonhtmlcommon::end_pick_box();
                undef($captchaform);
                undef($showsubmit);
            } else {
                $serverform .= '
   <input type="hidden" name="recaptcha_challenge_field" value="" />
   <input type="hidden" name="recaptcha_response_field" value="" />
';
            }
        }
        if ($usertype ne '') {
            $serverform .= '<input type="hidden" name="type" value="'.
                           &HTML::Entities::encode($usertype,'\'<>"&').'" />'."\n";
        }
        if ($usernameset eq 'free') {
            $serverform .= '<input type="hidden" name="username" value="" />'."\n"; 
        }
        $serverform .= <<"ENDSERVERFORM";
   <input type="hidden" name="logtoken" value="$logtoken" />
   <input type="hidden" name="serverid" value="$lonhost" />
   <input type="hidden" name="uname" value="" />
   <input type="hidden" name="upass" value="" />
   <input type="hidden" name="udom" value="" />
   <input type="hidden" name="phase" value="createaccount" />
   <input type="hidden" name="create_with_email" value="1" />
  </form>
ENDSERVERFORM
        my $beginclientform = '<form name="newemail" method="post" action="" '.
                              'onsubmit="return checkpass('."'createaccount','newemail'".');">'."\n";
        my $endclientform;
        unless ($showsubmit) {
            if ($usertype ne '') {
                $endclientform = '<input type="hidden" name="type" value="'.
                                 &HTML::Entities::encode($usertype,'\'<>"&').'" />'."\n";
            }
        }
        $endclientform .= '<input type="hidden" name="udom" value="'.$domain.'" />'."\n".
                          '<input type="hidden" name="lextkey" value="'.$lextkey.'" />'."\n".
                          '<input type="hidden" name="uextkey" value="'.$uextkey.'" />'."\n".
                          '</form>'."\n";
        my ($datatable,$rowcount) =
            &Apache::loncreateuser::personal_data_display('',$domain,'email','selfcreate',
                                                          '','',$now,$captchaform,
                                                          $emailusername,$usertype,
                                                          $usernameset,$condition,$excluded,
                                                          $showsubmit);
        if ($rowcount) {
            $output .= '<div class="LC_left_float">'.$beginclientform.$datatable.$endclientform.'</div>'."\n".
                       '<div class="LC_clear_float_footer"></div>'."\n";
        } else {
            $output .= $beginclientform.$endclientform;
        }
        $output .= $serverform.
                   '<p class="LC_info">'.
                   &mt('Fields marked [_1]*[_2] are required.','<b>','</b>').
                   '</p>';
    } else {
        $output = &mt('Could not load javascript file [_1]','<tt>londes.js</tt>');
    }
    return $output;
}

#
# Retrieve rules for generating accounts from domain configuration
# Can the user make a new account or just self-enroll?

sub get_creation_controls {
    my ($domain,$usercreation) = @_;
    my (@cancreate,@statustocreate,@statusforemail,$emailusername,$processing,
        $emailoptions,$verification,$emaildomain,$othertitle,$usertypes,$types);
    if (ref($usercreation) eq 'HASH') {
        if (ref($usercreation->{'cancreate'}) eq 'HASH') {
            ($othertitle,$usertypes,$types) =
                &Apache::loncommon::sorted_inst_types($domain);
            if (ref($usercreation->{'cancreate'}{'statustocreate'}) eq 'ARRAY') {
                @statustocreate = @{$usercreation->{'cancreate'}{'statustocreate'}};
                if (@statustocreate == 0) {
                    if (ref($types) eq 'ARRAY') {
                        if (@{$types} == 0) {
                            @statustocreate = ('default');
                        }
                    } else {
                        @statustocreate = ('default');
                    }
                }
            } else {
                @statustocreate = ('default');
                if (ref($types) eq 'ARRAY') {
                    push(@statustocreate,@{$types});
                }
            }
            if (ref($usercreation->{'cancreate'}{'selfcreate'}) eq 'ARRAY') {
                @cancreate = @{$usercreation->{'cancreate'}{'selfcreate'}};
            } elsif (($usercreation->{'cancreate'}{'selfcreate'} ne 'none') &&
                     ($usercreation->{'cancreate'}{'selfcreate'} ne '')) {
                @cancreate = ($usercreation->{'cancreate'}{'selfcreate'});
            }
            if (grep(/^email$/,@cancreate)) {
                if (ref($usercreation->{'cancreate'}{'selfcreateprocessing'}) eq 'HASH') {
                    $processing = $usercreation->{'cancreate'}{'selfcreateprocessing'};
                }
                if (ref($usercreation->{'cancreate'}{'emailoptions'}) eq 'HASH') {
                    $emailoptions = $usercreation->{'cancreate'}{'emailoptions'};
                }
                if (ref($usercreation->{'cancreate'}{'emailverified'}) eq 'HASH') {
                    $verification = $usercreation->{'cancreate'}{'emailverified'};
                }
                if (ref($usercreation->{'cancreate'}{'emaildomain'}) eq 'HASH') {
                    $emaildomain = $usercreation->{'cancreate'}{'emaildomain'};
                }
                if (ref($processing)) {
                    my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                    my @emailtypes;
                    if (ref($domdefaults{'inststatusguest'}) eq 'ARRAY') {
                        @statusforemail = @{$domdefaults{'inststatusguest'}};
                        unless (@statusforemail) {
                            my @okcreate;
                            foreach my $poss (@cancreate) {
                                unless ($poss eq 'email') {
                                     push(@okcreate,$poss);
                                }
                            }
                            @cancreate = @okcreate;
                        }
                    }
                }  
            }
            if (ref($usercreation->{'cancreate'}{'emailusername'}) eq 'HASH') {
                $emailusername = $usercreation->{'cancreate'}{'emailusername'};
            } else {
                $emailusername = {
                                    default =>  {
                                                   'lastname' => '1',
                                                   'firstname' => 1,
                                                },
                                 };
            }
        }
    }
    return (\@cancreate,\@statustocreate,\@statusforemail,$emailusername,
            $emailoptions,$verification,$emaildomain,$types,$usertypes,$othertitle);
}

sub create_account {
    my ($r,$domain,$domdesc,$dataref) = @_;
    my $error    = '<span class="LC_error">'.&mt('Error:').' ';
    my $end      = '</span><br /><br />';
    my $rtnlink  = '<a href="javascript:history.back();">'.
                    &mt('Return to previous page').'</a>'.
                    &Apache::loncommon::end_page();
    my $output;
    if (ref($dataref) eq 'HASH') {
        my ($username,$encpass,$serverid,$courseid,$id,$firstname,$middlename,$lastname,
            $generation,$inststatus,$permanentemail);
        $username   = $dataref->{'username'};
        $encpass    = $dataref->{'upass'};
        $serverid   = $dataref->{'serverid'};
        $courseid   = $dataref->{'courseid'};
        $id         = $dataref->{'id'};
        $firstname  = $dataref->{'firstname'};
        $middlename = $dataref->{'middlename'};
        $lastname   = $dataref->{'lastname'};
        $generation = $dataref->{'generation'};
        $inststatus = $dataref->{'inststatus'};

        if ($dataref->{'email'} ne '') {
            $permanentemail = $dataref->{'email'};
        } else {
            $permanentemail = $dataref->{'username'};
        }
        my $currhome = &Apache::lonnet::homeserver($username,$domain);
        unless ($currhome eq 'no_host') {
            $output = &mt('User account requested for username: [_1] in domain: [_2] already exists.',$username,$domain);
            return ('fail',$error.$output.$end.$rtnlink);
        }

# Split the logtoken to retrieve the DES key and decrypt the encypted password

        my ($key,$caller)=split(/&/,$dataref->{'tmpinfo'});
        if ($caller eq 'createaccount') {
            my $upass;
            if ($encpass eq '') {
                $output = &mt('Password retrieved was blank.');
                return ('fail',$error.$output.$end.$rtnlink);
            } else {
                $upass = &Apache::loncommon::des_decrypt($key,$encpass);
            }

# See if we are allowed to use the proposed student/employee ID,
# as per domain rules; if not, student/employee will be left blank.

            if ($id ne '') {
                my ($result,$userchkmsg) = &check_id($username,$domain,$id,$domdesc,'email');
                if ($result eq 'fail') {
                    $output = $error.&mt('Invalid ID format').$end.
                              $userchkmsg;
                    undef($id);
                }
            }

# Create an internally authenticated account with password $upass
# if the user account does not already exist.
# Assign student/employee id, first name, last name, etc.

            my $result =
                &Apache::lonnet::modifyuser($domain,$username,$id,
                                            'internal',$upass,$firstname,$middlename,
                                            $lastname,$generation,undef,undef,$permanentemail);
            $output = &mt('Generating user: [_1]',$result);

# Now that the user account exists, retrieve the homeserver, and include it in the output.

            my $uhome = &Apache::lonnet::homeserver($username,$domain);
            unless (($inststatus eq 'default') || ($inststatus eq '')) {
                &Apache::lonnet::put('environment',{inststatus => $inststatus},$domain,$username);
            }
            $output .= '<br />'.&mt('Home Server').": $uhome ".
                       &Apache::lonnet::hostname($uhome).'<br /><br />';
            return ('ok',$output,$uhome);
        } else {
            $output = &mt('Unable to retrieve your account creation information - unexpected context');
            undef($encpass);
            return ('fail',$error.$output.$end.$rtnlink);
        }
    } else {
        $output = &mt('Unable to retrieve information for your account request.');
        return ('fail',$error.$output.$end.$rtnlink);
    }
}

sub username_validation {
    my ($r,$username,$domain,$domdesc,$contact_name,$contact_email,$courseid,
        $lonhost,$statustocreate) = @_;
# $r: request object
# $username,$domain: for the user who needs to be validated
# $domdesc: full name of the domain (for error messages)
# $contact_name, $contact_email: name and email for user assistance (for error messages in &username_check)
# $courseid: ID of the course if user came to username_validation via self-enroll link,
#             passed to start_session()
# $lonhost: LON-CAPA lonHostID
# $statustocreate: -> inststatus in username_check ('faculty', 'staff', 'student', ...)
 
#
# Sanitize incoming username and domain
#
    $username= &LONCAPA::clean_username($username);
    $domain = &LONCAPA::clean_domain($domain);

#
# Check if LON-CAPA account already exists for $username:$domain
#
    my $uhome = &Apache::lonnet::homeserver($username,$domain);

    my $output;

# Retrieve DES key from server using logtoken
 
    my $tmpinfo=Apache::lonnet::reply('tmpget:'.$env{'form.logtoken'},$env{'form.serverid'});
    if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
        $output = &mt('Information needed to verify your login information is missing, inaccessible or expired.')
                 .'<br />'.&mt('You may need to reload the previous page to obtain a new token.');
        return ('fail',$output);
    } else {
        my $reply = &Apache::lonnet::reply('tmpdel:'.$env{'form.logtoken'},$env{'form.serverid'});
        unless ($reply eq 'ok') {
            $output = &mt('Session could not be opened.');
            return ('fail',$output); 
        }
    }

# Split the logtoken to retrieve the DES key and decrypt the encypted password

    my ($key,$caller)=split(/&/,$tmpinfo);
    my $upass;
    if ($caller eq 'createaccount') {
        $upass = &Apache::loncommon::des_decrypt($key,$env{'form.upass'});
    } else {
        $output = &mt('Unable to retrieve your log-in information - unexpected context');
        return ('fail',$output);
    }
    if ($uhome ne 'no_host') {
        my $result = &Apache::lonnet::authenticate($username,$upass,$domain);
        if ($result ne 'no_host') { 
            my $redirect = &start_session($r,$username,$domain,$uhome,$courseid);
            if ($redirect) {
                return ($redirect);
            }
            $output = '<br /><br />'.
                      &mt('A LON-CAPA account already exists for username [_1] at this institution ([_2]).',
                          '<tt>'.$username.'</tt>',$domdesc).'<br />'.
                      &mt('The password entered was also correct so you have been logged in.');
            return ('existingaccount',$output);
        } else {
            $output = &login_failure_msg($courseid);
        }
    } else {
        my $primlibserv = &Apache::lonnet::domain($domain,'primary');
        my $authok;
        my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
        if ((($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) || 
             ($domdefaults{'auth_def'} eq 'localauth')) {
            my $checkdefauth = 1;
            $authok = 
                &Apache::lonnet::reply("encrypt:auth:$domain:$username:$upass:$checkdefauth",$primlibserv);
        } else {
            $authok = 'non_authorized';
        }
        if ($authok eq 'authorized') {
            $output = &username_check($username,$domain,$domdesc,$courseid,$lonhost,
                                      $contact_email,$contact_name,undef,
                                      $statustocreate);
        } else {
            $output = &login_failure_msg($courseid);
        }
    }
    return ('ok',$output);
}

sub login_failure_msg {
    my ($courseid) = @_;
    my $url;
    if ($courseid ne '') {
        $url = "/adm/selfenroll?courseid=".$courseid;
    } else {
        $url = "/adm/createaccount";
    }
    my $output = '<h4>'.&mt('Authentication failed').'</h4><div class="LC_warning">'.
                 &mt('Username and/or password could not be authenticated.').
                 '</div>'.
                 &mt('Please check the username and password.').'<br /><br />';
                 '<a href="'.$url.'">'.&mt('Try again').'</a>';
    return $output;
}

sub username_check {
    my ($username,$domain,$domdesc,$courseid,$lonhost,$contact_email,
        $contact_name,$sso_logout,$statustocreate,$shibenv) = @_;
    my (%rulematch,%inst_results,$checkfail,$rowcount,$editable,$output,$msg,
        %alerts,%curr_rules,%got_rules);
    &call_rulecheck($username,$domain,\%alerts,\%rulematch,
                    \%inst_results,\%curr_rules,\%got_rules,'username');
    if (ref($alerts{'username'}) eq 'HASH') {
        if (ref($alerts{'username'}{$domain}) eq 'HASH') {
            if ($alerts{'username'}{$domain}{$username}) {
                if (ref($curr_rules{$domain}) eq 'HASH') {
                    $output =
                        &Apache::loncommon::instrule_disallow_msg('username',$domdesc,1,
                                                                  'selfcreate').
                        &Apache::loncommon::user_rule_formats($domain,$domdesc,
                                $curr_rules{$domain}{'username'},'username');
                }
                $checkfail = 'username';
            }
        }
    }
    if (!$checkfail) {
        if (ref($statustocreate) eq 'ARRAY') {
            $checkfail = 'inststatus';
            if (ref($inst_results{$username.':'.$domain}{inststatus}) eq 'ARRAY') {
                foreach my $inststatus (@{$inst_results{$username.':'.$domain}{inststatus}}) {
                    if (grep(/^\Q$inststatus\E$/,@{$statustocreate})) {
                        undef($checkfail);
                        last;
                    }
                }
            } elsif (grep(/^default$/,@{$statustocreate})) {
                undef($checkfail);
            }
        }
    }
    if (!$checkfail) {
        $output = '<form method="post" action="/adm/createaccount">';
        if (ref($shibenv) eq 'HASH') {
            foreach my $key (keys(%{$shibenv})) {
                if ($ENV{$shibenv->{$key}} ne '') {
                    $inst_results{$username.':'.$domain}{$key} = $ENV{$shibenv->{$key}};
                }
            }
        }
        (my $datatable,$rowcount,$editable) = 
            &Apache::loncreateuser::personal_data_display($username,$domain,1,'selfcreate',
                                                         $inst_results{$username.':'.$domain});
        if ($rowcount > 0) {
            $output .= $datatable;
        }
        $output .=  '<br /><br /><input type="hidden" name="uname" value="'.$username.'" />'."\n".
                    '<input type="hidden" name="udom" value="'.$domain.'" />'."\n".
                    '<input type="hidden" name="phase" value="username_activation" />';
        my $now = time;
        my $ip = &Apache::lonnet::get_requestor_ip();
        my %info = ('ip'         => $ip,
                    'time'       => $now,
                    'domain'     => $domain,
                    'username'   => $username);
        my $authtoken = &Apache::lonnet::tmpput(\%info,$lonhost,'createaccount');
        if ($authtoken !~ /^error/ && $authtoken ne 'no_such_host') {
            $output .= '<input type="hidden" name="authtoken" value="'.&HTML::Entities::encode($authtoken,'&<>"').'" />';
        } else {
            $output = &mt('An error occurred when storing a token').'<br />'.
                      &mt('You will not be able to proceed to the next stage of account creation').
                      &linkto_email_help($contact_email,$domdesc);
            $checkfail = 'authtoken';
        }
    }
    if ($checkfail) { 
        $msg = '<br /><h4>'.&mt('Account creation unavailable').'</h4>';
        if ($checkfail eq 'username') {
            $msg .= '<span class="LC_warning">'.
                     &mt('A LON-CAPA account may not be created with the username you use.').
                     '</span><br /><br />'.$output;
        } elsif ($checkfail eq 'authtoken') {
            $msg .= '<span class="LC_error">'.&mt('Error creating token.').'</span>'.
                    '<br />'.$output;
        } elsif ($checkfail eq 'inststatus') {
            $msg .= '<span class="LC_warning">'.
                     &mt('You are not permitted to create a LON-CAPA account.').
                     '</span><br /><br />'.$output;
        }
        $msg .= &mt('Please contact the [_1] ([_2]) for assistance.',
                $contact_name,$contact_email).'<br /><hr />'.
                $sso_logout;
        &Apache::lonnet::logthis("ERROR: failure type of '$checkfail' when performing username check to create account for authenticated user: $username, in domain $domain");
    } else {
        if ($courseid ne '') {
            $output .= '<input type="hidden" name="courseid" value="'.$courseid.'" />';
        }
        $output .= '<input type="submit" name="newaccount" value="'.
                   &mt('Create LON-CAPA account').'" /></form>';
        if ($rowcount) {
            if ($editable) {
                if ($courseid ne '') { 
                    $msg = '<br /><h4>'.&mt('User information').'</h4>';
                }
                $msg .= &mt('To create one, use the table below to provide information about yourself, then click the [_1]Create LON-CAPA account[_2] button.','<span class="LC_cusr_emph">','</span>').'<br />';
            } else {
                 if ($courseid ne '') {
                     $msg = '<h4>'.&mt('Review user information').'</h4>';
                 }
                 $msg .= &mt('A user account will be created with information displayed in the table below, when you click the [_1]Create LON-CAPA account[_2] button.','<span class="LC_cusr_emph">','</span>').'<br />';
            }
        } else {
            if ($courseid ne '') {
                $msg = '<h4>'.&mt('Confirmation').'</h4>';
            }
            $msg .= &mt('Confirm that you wish to create an account.');
        }
        $msg .= $output;
    }
    return $msg;
}

sub username_activation {
    my ($r,$username,$domain,$domdesc,$courseid) = @_;
    my $output;
    my $error     = '<span class="LC_error">'.&mt('Error:').' ';
    my $end       = '</span><br /><br />';
    my $rtnlink   = '<a href="javascript:history.back();">'.
                    &mt('Return to previous page').'</a>'.
                    &Apache::loncommon::end_page();
    my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
    my %data = &Apache::lonnet::tmpget($env{'form.authtoken'});
    my $now = time;
    my $earlyout;
    my $timeout = 300;
    if (keys(%data) == 0) {
        $output = &mt('Sorry, your authentication has expired.');
        $earlyout = 'fail';
    }
    if (($data{'time'} !~ /^\d+$/) ||
        ($data{'domain'} ne $domain) || 
        ($data{'username'} ne $username)) {
        $earlyout = 'fail';
        $output = &mt('The credentials you provided could not be verified.');   
    } elsif ($now - $data{'time'} > $timeout) {
        $earlyout = 'fail';
        $output = &mt('Sorry, your authentication has expired.');
    }
    if ($earlyout ne '') {
        my $link = '/adm/createaccount';
        if (&Apache::lonnet::domain($domain) ne '') {
            $link .= "?domain=$domain"; 
        }
        $output .= '<br />'.&mt('Please [_1]start again[_2].',
                                '<a href="'.$link.'">','</a>');
        return($earlyout,$output);
    }
    if ((($domdefaults{'auth_def'} =~/^krb(4|5)$/) && 
         ($domdefaults{'auth_arg_def'} ne '')) || 
        ($domdefaults{'auth_def'} eq 'localauth')) {
        if ($env{'form.courseid'} ne '') {
            my $id = $env{'form.cid'}; 
            my ($result,$userchkmsg) = &check_id($username,$domain,$id,$domdesc,'institutional');
            if ($result eq 'fail') {
                $output = $error.&mt('Invalid ID format').$end.
                          $userchkmsg.$rtnlink;
                return ('fail',$output);
            }
        }
        # Call modifyuser
        my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts,%info);
        &call_rulecheck($username,$domain,\%alerts,\%rulematch,
                        \%inst_results,\%curr_rules,\%got_rules);
        my @userinfo = ('firstname','middlename','lastname','generation',
                        'permanentemail','id');
        my %canmodify = 
            &Apache::loncreateuser::selfcreate_canmodify('selfcreate',$domain,
                                                         \@userinfo,\%inst_results);
        foreach my $item (@userinfo) {
            if ($canmodify{$item}) {
                $info{$item} = $env{'form.c'.$item};
            } else {
                $info{$item} = $inst_results{$username.':'.$domain}{$item}; 
            }
        }
        if (ref($inst_results{$username.':'.$domain}{'inststatus'}) eq 'ARRAY') {
            my @inststatuses = @{$inst_results{$username.':'.$domain}{'inststatus'}};
            $info{'inststatus'} = join(':',map { &escape($_); } @inststatuses);
        }
        my $result =
            &Apache::lonnet::modifyuser($domain,$username,$env{'form.cid'},
                          $domdefaults{'auth_def'},
                          $domdefaults{'auth_arg_def'},$info{'firstname'},
                          $info{'middlename'},$info{'lastname'},
                          $info{'generation'},undef,undef,
                          $info{'permanentemail'},$info{'inststatus'});
        if ($result eq 'ok') {
            my $delete = &Apache::lonnet::tmpdel($env{'form.authtoken'});
            $output = &mt('A LON-CAPA account has been created for username: [_1] in domain: [_2].',$username,$domain);
            my $uhome=&Apache::lonnet::homeserver($username,$domain,'true');
            my $nostart = 1;
            my $response = 'ok';
            my $redirect = &start_session($r,$username,$domain,$uhome,$courseid);
            if ($redirect) {
                $response = $redirect;
            }
            return ($response,$output,$nostart);
        } else {
            $output = &mt('Account creation failed for username: [_1] in domain: [_2].',$username,$domain).'<br /><span class="LC_error">'.&mt('Error: [_1]',$result).'</span>';
            return ('fail',$output);
        }
    } else {
        $output = &mt('User account creation is not available for the current default authentication type.')."\n";
        return('fail',$output);
    }
}

sub check_id {
    my ($username,$domain,$id,$domdesc,$usernametype) = @_;
    # Check student/employee ID format
    # Is proposed student/employee ID acceptable according to domain's rules.  
    # $domdesc is just used for user error messages
    my (%alerts,%rulematch,%inst_results,%curr_rules,%checkhash);
    my %checks = ('id' => 1);
    %{$checkhash{$username.':'.$domain}} = (
                                            'newuser' => 1,
                                            'id' => $id,
                                           );
    &Apache::loncommon::user_rule_check(\%checkhash,\%checks,\%alerts,
                                        \%rulematch,\%inst_results,\%curr_rules);
    if (ref($alerts{'id'}) eq 'HASH') {
        if (ref($alerts{'id'}{$domain}) eq 'HASH') {
            if ($alerts{'id'}{$domain}{$env{'form.cid'}}) {
                my $userchkmsg;
                if (ref($curr_rules{$domain}) eq 'HASH') {
                    if ($usernametype eq 'email') {
                        $userchkmsg = &mt('A student/employee ID has not been set because the value suggested matched the format used for institutional users in the domain, and you are using an e-mail address as username, not an institutional username.');
                    } else {
                        $userchkmsg =
                            &Apache::loncommon::instrule_disallow_msg('id',
                                                                      $domdesc,1).
                            &Apache::loncommon::user_rule_formats($domain,
                                $domdesc,$curr_rules{$domain}{'id'},'id');
                    }
                }
                return ('fail',$userchkmsg);
            }
        }
    }
    return; 
}

sub invalid_state {
    my ($error,$domdesc,$contact_name,$contact_email,$msgtext) = @_;
    my $msg = '<h3>'.&mt('Account creation unavailable').'</h3><span class="LC_error">';
    if ($error eq 'baduseremail') {
        $msg .= &mt('The e-mail address you provided does not appear to be a valid address.');
    } elsif ($error eq 'badusername') {
        $msg .= &mt('The e-mail address you provided contains characters which prevent its use as a username in LON-CAPA.');
    } elsif ($error eq 'existinguser') {
        $msg .= &mt('The e-mail address you provided is already in use as a username in LON-CAPA at this institution.');
    } elsif ($error eq 'userrules') {
        $msg .= &mt('Username rules at this institution do not allow the e-mail address you provided to be used as a username.');
    } elsif ($error eq 'userformat') {
        $msg .= &mt('The e-mail address you provided may not be used as a username at this LON-CAPA institution.');
    } elsif ($error eq 'noemails') {
        $msg .= &mt('Creation of a new user account using an e-mail address as username is not permitted at this LON-CAPA institution.');
    } elsif ($error eq 'emailfail') {
        $msg .= &mt('Creation of a new user account with verification by e-mail is not permitted with the e-mail address you provided');
    }
    $msg .= '</span>';
    if ($msgtext) {
        $msg .= '<br />'.$msgtext;
    }
    $msg .= &linkto_email_help($contact_email,$domdesc,$error);
    return $msg;
}

sub linkto_email_help {
    my ($contact_email,$domdesc,$error) = @_;
    my $msg;
    my $href = '/adm/helpdesk';
    if ($contact_email ne '') {
        my $escuri = &HTML::Entities::encode('/adm/createaccount','&<>"');
        $href .= '?origurl='.$escuri;
        if ($error eq 'existinguser') {
            my $escemail = &HTML::Entities::encode($env{'form.useremail'});
            $href .= '&useremail='.$escemail.'&useraccount='.$escemail;
        }
        $msg .= '<br />'.&mt('You may wish to contact the [_1]LON-CAPA helpdesk[_2] for [_3].','<a href="'.$href.'">','</a>',$domdesc).'<br />';
    } else {
        $msg .= '<br />'.&mt('You may wish to send an e-mail to the server administrator: [_1] for [_2].',$Apache::lonnet::perlvar{'AdmEMail'},$domdesc).'<br />';
    }
    return $msg;
}

sub getkeys {
    my ($lkey,$ukey) = @_;
    my $lextkey=hex($lkey);
    if ($lextkey>2147483647) { $lextkey-=4294967296; }

    my $uextkey=hex($ukey);
    if ($uextkey>2147483647) { $uextkey-=4294967296; }
    return ($lextkey,$uextkey);
}

sub serverform {
    my ($logtoken,$lonhost,$mailtoken,$courseid,$context) = @_;
    my $phase = 'username_validation';
    my $catalog_elements;
    if ($context eq 'selfenroll') {
        $phase = 'selfenroll_login';
    }
    if ($courseid ne '') {
        $catalog_elements = &Apache::lonhtmlcommon::echo_form_input(['courseid','phase']);
    } 
    my $output = <<ENDSERVERFORM;
  <form name="server" method="post" action="/adm/createaccount">
   <input type="hidden" name="logtoken" value="$logtoken" />
   <input type="hidden" name="token" value="$mailtoken" />
   <input type="hidden" name="serverid" value="$lonhost" />
   <input type="hidden" name="uname" value="" />
   <input type="hidden" name="upass" value="" />
   <input type="hidden" name="udom" value="" />
   <input type="hidden" name="phase" value="$phase" />
   <input type="hidden" name="courseid" value="$courseid" />
   $catalog_elements
  </form>
ENDSERVERFORM
    return $output;
}

sub store_request {
    my ($dom,$username,$val,$dataref,$settings) = @_;
    my $output;
    my $domconfiguser = &Apache::lonnet::get_domainconfiguser($dom);
    my $key = &escape($username);
    my $now = time();
    if (&Apache::lonnet::put('usernamequeue', { $key.'_'.$val => $now },
                             $dom,$domconfiguser) eq 'ok') {
        if (ref($dataref) eq 'HASH') {
            my $logtoken = $dataref->{'tmpinfo'};
            my $serverid = $dataref->{'serverid'}; 
            if ($logtoken && $serverid) {
                my $tmpinfo=Apache::lonnet::reply('tmpget:'.$logtoken,$serverid);
                unless (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
                    my $reply = &Apache::lonnet::reply('tmpdel:'.$logtoken,$serverid);
                    if ($reply eq 'ok') {
                        my ($key,$caller)=split(/&/,$tmpinfo);
                        $dataref->{'key'} = $key;
                        undef($dataref->{'tmpinfo'});
                        undef($dataref->{'serverid'});
                    }
                }
            }
        }
        my %userrequest = ( $username => $dataref );
        $userrequest{$username}{timestamp} = $now;
        $userrequest{$username}{status} = $val;
        my $notifylist;
        if (ref($settings) eq 'HASH') {
            if (ref($settings->{'cancreate'}) eq 'HASH') {
                if (ref($settings->{'cancreate'}{'notify'}) eq 'HASH') {
                    my $notifylist = $settings->{'cancreate'}{'notify'}{'approval'};
                    if ($notifylist) {
                        my $sender = $domconfiguser.':'.$dom;
                        my $domdesc = &Apache::lonnet::domain($dom,'description');
                        my $fullname;
                        if (ref($dataref) eq 'HASH') {
                            if ($dataref->{'firstname'}) {
                                $fullname = $dataref->{'firstname'};
                            }
                            if ($dataref->{'lastname'}) {
                                $fullname .= ' '.$dataref->{'lastname'};
                            }
                            $fullname =~ s/^\s+|\s+$//g; 
                        }
                        &Apache::loncoursequeueadmin::send_selfserve_notification($notifylist,
                                                     "$fullname ($username)",
                                                     undef,$domdesc,$now,'usernamereq',$sender);
                    }
                }
            }
        }
        my $userresult =
            &Apache::lonnet::put('nohist_requestedusernames',\%userrequest,$dom,$domconfiguser);
        $output = '<p class="LC_info">'.
                  &mt('Your request for a LON-CAPA account has been submitted for approval.').
                  '</p>'.
                  '<p class="LC_info">'.
                  &mt('An e-mail will be sent to [_1] when your request has been reviewed by an administrator and action has been taken.',$username).
                  '</p>';
    } else {
        $output = '<span class="LC_error">'.
                  &mt('An error occurred when attempting to save your request for a LON-CAPA account.');
                  '</span>';
    }
    return $output;
}

sub guest_format_check {
    my ($useremail,$domain,$cancreate,$settings,$usertype) = @_;
    my ($login,$format_match,$format_msg,@user_rules);
    if (ref($settings) eq 'HASH') {
        if (ref($settings->{'email_rule'}) eq 'ARRAY') {
            push(@user_rules,@{$settings->{'email_rule'}});
        } elsif (ref($settings->{'email_rule'}) eq 'HASH') {
            if (ref($settings->{'email_rule'}->{$usertype}) eq 'ARRAY') {
                push(@user_rules,@{$settings->{'email_rule'}->{$usertype}});
            }
        }
    }
    if (@user_rules > 0) {
        my %rule_check = 
            &Apache::lonnet::inst_rulecheck($domain,$useremail,undef,
                                            'selfcreate',\@user_rules);
        if (keys(%rule_check) > 0) {
            foreach my $item (keys(%rule_check)) {
                if ($rule_check{$item}) {
                    $format_match = 1;   
                    last;
                }
            }
        }
    }
    if ($format_match) {
        ($login) = ($useremail =~ /^([^\@]+)\@/);
        $format_msg = '<br />'.
                      &mt("Your e-mail address uses the same internet domain as your institution's LON-CAPA service.").'<br />'.
                      &mt('Creation of a LON-CAPA account with this type of e-mail address as username is not permitted.').'<br />';
        if (ref($cancreate) eq 'ARRAY') {
            if (grep(/^login$/,@{$cancreate})) {
                $format_msg .= &mt('You should request creation of a LON-CAPA account for a log-in ID of "[_1]" at your institution instead.',$login).'<br />'; 
            }
        }
    }
    return $format_msg;
}

sub sso_logout_frag {
    my ($r,$domain) = @_;
    my $endsessionmsg;
    if (defined($r->dir_config('lonSSOUserLogoutMessageFile_'.$domain))) {
        my $msgfile = $r->dir_config('lonSSOUserLogoutMessageFile_'.$domain);
        if (-e $msgfile) {
            open(my $fh,"<",$msgfile);
            $endsessionmsg = join('',<$fh>);
            close($fh);
        }
    } elsif (defined($r->dir_config('lonSSOUserLogoutMessageFile'))) {
        my $msgfile = $r->dir_config('lonSSOUserLogoutMessageFile');
        if (-e $msgfile) {     
            open(my $fh,"<",$msgfile);
            $endsessionmsg = join('',<$fh>);
            close($fh);
        }
    }
    return $endsessionmsg;
}

sub catreturn_js {
    return  <<"ENDSCRIPT";
<script type="text/javascript">
// <![CDATA[
function ToSelfenroll(formname) {
    var formidx = getFormByName(formname);
    if (formidx > -1) {
        document.forms[formidx].action = '/adm/selfenroll';
        numidx = getIndexByName(formidx,'phase');
        if (numidx > -1) {
            document.forms[formidx].elements[numidx].value = '';   
        }
        numidx = getIndexByName(formidx,'context');
        if (numidx > -1) {
            document.forms[formidx].elements[numidx].value = '';
        }
    }
    document.forms[formidx].submit();
}

function ToCatalog(formname,caller) {
    var formidx = getFormByName(formname);
    if (formidx > -1) {
        document.forms[formidx].action = '/adm/coursecatalog';
        numidx = getIndexByName(formidx,'coursenum');
        if (numidx > -1) {
            if (caller != 'details') {
                document.forms[formidx].elements[numidx].value = '';
            }
        }
    }
    document.forms[formidx].submit();
}

function getIndexByName(formidx,item) {
    for (var i=0;i<document.forms[formidx].elements.length;i++) {
        if (document.forms[formidx].elements[i].name == item) {
            return i;
        }
    }
    return -1;
}

function getFormByName(item) {
    for (var i=0; i<document.forms.length; i++) {
        if (document.forms[i].name == item) {
            return i;
        }
    }
    return -1;
}
// ]]>
</script>
ENDSCRIPT

}

sub setelements_js {
    my ($statusforemail,$types,$usertypes,$othertitle) = @_;
    my ($posstypes,$posstypesnames,$availabletypes);
    if ((ref($statusforemail) eq 'ARRAY') && (ref($types) eq 'ARRAY') && 
        (ref($usertypes) eq 'HASH')) {
        $posstypes = join("','",@{$types},'default');
        $posstypesnames = join("','",(map {$usertypes->{$_};} @{$types}),$othertitle);
        $availabletypes = join("','", @{$statusforemail});
    }
    return  <<"ENDSCRIPT";
<script type="text/javascript">
// <![CDATA[

function setElements() {
    if (document.getElementById('LC_reportstatus')) {
        var reportnum = document.reportstatus.type.length;
        if ((reportnum != 'undefined') && (typeof(document.reportstatus.type) != 'undefined')) {
            for (var i=0; i<reportnum; i++) {
                document.reportstatus.type[i].checked = false;
            }
        }
    }
}

function checkVerification() {
    var curr;
    var cancreate = false;
    var reportnum = document.reportstatus.type.length;
    if ((reportnum == 'undefined') && (typeof(document.reportstatus.type) != 'undefined')) {
        curr = document.reportstatus.type.value; 
    } else if (document.reportstatus.type.length) {
        for (var i=0; i<document.reportstatus.type.length; i++) {
            if (document.reportstatus.type[i].checked) {
                curr = document.reportstatus.type[i].value;
                break;
            }
        }
    }
    var types = Array('$posstypes');
    var names = Array('$posstypesnames');
    var available = Array('$availabletypes');
    if (available.length) {
        for (var i=0; i<available.length; i++) {
            if (curr == available[i]) {
                cancreate = true;   
                break;
            }
        }
    }
    if (types.length > 0) {
        for (var j=0; j<types.length; j++) {
            if (curr == types[j]) {
                if (!cancreate) {
                    alert('Creation of an account via verification by e-mail unavailable for user type: "'+names[j]+'"');
                    setElements();
                }
                break;
            }
        }
    }
    if (cancreate) {
        return true;
    } else {
        return false;
    }
}

// ]]>
</script>
ENDSCRIPT

}

sub username_js {
    return  <<"ENDSCRIPT";
<script type="text/javascript">
// <![CDATA[

function toggleUsernameDisp(caller,divid) {
    if (document.getElementById(divid)) {
        if (caller.checked) {
            if (caller.value == '1') {
                document.getElementById(divid).style.display = 'none';
            } else {
                document.getElementById(divid).style.display = 'inline';
            }
        }
    }
}
// ]]>
</script>
ENDSCRIPT

}

1;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

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.