File:  [LON-CAPA] / loncom / interface / createaccount.pm
Revision 1.34: download - view: text, annotated - select for diffs
Sat Apr 4 21:47:40 2009 UTC (15 years, 2 months ago) by bisitz
Branches: MAIN
CVS tags: HEAD
XHTML conform tags (input, br, hr)

# The LearningOnline Network
# Allow visitors to create a user account with the username being either an 
# institutional log-in ID (institutional authentication required - localauth
#  or kerberos) or an e-mail address.
#
# $Id: createaccount.pm,v 1.34 2009/04/04 21:47:40 bisitz 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 Authen::Captcha;
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('REDIRECT_SSOUserUnknown');
    my $sso_domain = $r->subprocess_env->get('REDIRECT_SSOUserDomain');

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

    if ($sso_username ne '' && $sso_domain ne '') {
        $domain = $sso_domain; 
    } else {
        $domain = &Apache::lonnet::default_login_domain();
        if (defined($env{'form.courseid'})) {
            if (&validate_course($env{'form.courseid'})) {
                if ($env{'form.courseid'} =~ /^($match_domain)_($match_courseid)$/) {
                    $domain = $1; 
                }
            }
        }
    }
    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);
    if (defined($env{'form.courseid'})) {
        $courseid = &validate_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 ($result,$output) =
            &username_validation($r,$env{'form.uname'},$domain,$domdesc,
                                 $contact_name,$contact_email,$courseid,
                                 $lonhost);
        if ($result eq 'existingaccount') {
            $r->print($output);
            &print_footer($r);
            return OK;
        } else {
            $start_page = 
                &Apache::loncommon::start_page($title,$js,
                                               {'no_inline_link'   => 1,});
            &print_header($r,$start_page,$courseid);
            $r->print($output);
            &print_footer($r);    
            return OK;
        }
    }
    $start_page =
        &Apache::loncommon::start_page($title,$js,
                                       {'no_inline_link'   => 1,});
    my @cancreate;
    my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$domain);
    if (ref($domconfig{'usercreation'}) eq 'HASH') {
        if (ref($domconfig{'usercreation'}{'cancreate'}) eq 'HASH') {
            if (ref($domconfig{'usercreation'}{'cancreate'}{'selfcreate'}) eq 'ARRAY') {
                @cancreate = @{$domconfig{'usercreation'}{'cancreate'}{'selfcreate'}};
            } elsif (($domconfig{'usercreation'}{'cancreate'}{'selfcreate'} ne 'none') &&
                     ($domconfig{'usercreation'}{'cancreate'}{'selfcreate'} ne '')) {
                @cancreate = ($domconfig{'usercreation'}{'cancreate'}{'selfcreate'});
            }
        }
    }

    if (@cancreate == 0) {
        &print_header($r,$start_page,$courseid);
        my $output = '<h3>'.&mt('Account creation unavailable').'</h3>'.
                     '<span class="LC_warning">'.
                     &mt('Creation of a new user account using an e-mail address or an institutional log-in ID as username is not permitted at this institution ([_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 />';

            $msg .= &username_check($sso_username,$domain,$domdesc,$courseid, 
                                    $lonhost,$contact_email,$contact_name,$sso_logout);
        } 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);
    my $token = $env{'form.token'};
    if ($token) {
        ($output,$nostart,$noend) = 
            &process_mailtoken($r,$token,$contact_name,$contact_email,$domain,
                               $domdesc,$lonhost,$include,$start_page);
        if ($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;
        }
    }

    if ($env{'form.phase'} eq 'username_activation') {
        (my $result,$output,$nostart) = 
            &username_activation($r,$env{'form.uname'},$domain,$domdesc,
                                 $lonhost,$courseid);
        if ($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);
        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);
        $output = &process_email_request($env{'form.useremail'},$domain,$domdesc,
                                         $contact_name,$contact_email,\@cancreate,
                                         $lonhost,$domconfig{'usercreation'},
                                         $courseid);
    } elsif (!$token) {
        &print_header($r,$start_page,$courseid);
        my $now=time;
        if (grep(/^login$/,@cancreate)) {
            my $jsh=Apache::File->new($include."/londes.js");
            $r->print(<$jsh>);
            $r->print(&javascript_setforms($now));
        }
        if (grep(/^email$/,@cancreate)) {
            $r->print(&javascript_validmail());
        }
        $output = &print_username_form($domain,$domdesc,\@cancreate,$now,$lonhost,
                                       $courseid);
    }
    $r->print($output);
    &print_footer($r);
    return OK;
}

sub print_header {
    my ($r,$start_page,$courseid) = @_;
    $r->print($start_page);
    &Apache::lonhtmlcommon::clear_breadcrumbs();
    if ($courseid ne '') {
        my %coursehash = &Apache::lonnet::coursedescription($courseid);
        &selfenroll_crumbs($r,$courseid,$coursehash{'description'});
    }
    &Apache::lonhtmlcommon::add_breadcrumb
    ({href=>"/adm/createuser",
      text=>"New username"});
    $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','useremail','crypt','cfirstname','clastname',
                      'cmiddlename','cgeneration','cpermanentemail','cid']).
                  '</form>');
    }
    $r->print(&Apache::loncommon::end_page());
}

sub selfenroll_crumbs {
    my ($r,$courseid,$desc) = @_;
    &Apache::lonhtmlcommon::add_breadcrumb
         ({href=>"javascript:ToCatalog('backupcrumbs','')",
           text=>"Course 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]','<span class="LC_cusr_emph">'.$desc.'</span>');
    } else {
        $last_crumb = &mt('Self-enroll');
    }
    &Apache::lonhtmlcommon::add_breadcrumb
                   ({href=>"javascript:ToSelfenroll('backupcrumbs')",
                     text=>$last_crumb,
                     no_mt=>"1"});
    return;
}

sub validate_course {
    my ($courseid) = @_;
    my ($cdom,$cnum) = ($courseid =~ /^($match_domain)_($match_courseid)$/);
    if (($cdom ne '') && ($cnum ne '')) {
        if (&Apache::lonnet::is_course($cdom,$cnum)) {
            return ($courseid);
        }
    }
    return;
}

sub javascript_setforms {
    my ($now) =  @_;
    my $js = <<ENDSCRIPT;
 <script type="text/javascript" language="JavaScript">
    function send() {
        this.document.server.elements.uname.value = this.document.client.elements.uname.value;
        this.document.server.elements.udom.value = this.document.client.elements.udom.value;
        uextkey=this.document.client.elements.uextkey.value;
        lextkey=this.document.client.elements.lextkey.value;
        initkeys();

        this.document.server.elements.upass.value
            = crypted(this.document.client.elements.upass$now.value);

        this.document.client.elements.uname.value='';
        this.document.client.elements.upass$now.value='';

        this.document.server.submit();
        return false;
    }
 </script>
ENDSCRIPT
    return $js;
}

sub javascript_checkpass {
    my ($now) = @_;
    my $nopass = &mt('You must enter a password.');
    my $mismatchpass = &mt('The passwords you entered did not match.').'\\n'.
                       &mt('Please try again.'); 
    my $js = <<"ENDSCRIPT";
<script type="text/javascript" language="JavaScript">
    function checkpass() {
        var upass = this.document.client.elements.upass$now.value;
        var upasscheck = this.document.client.elements.upasscheck$now.value;
        if (upass == '') {
            alert("$nopass");
            return false;
        }
        if (upass == upasscheck) {
            this.document.client.elements.upasscheck$now.value='';
            send();
            return false;
        } else {
            alert("$mismatchpass");
            return false;
        }
    }
</script>
ENDSCRIPT
    return $js;
}

sub javascript_validmail {
    my %lt = &Apache::lonlocal::texthash (
               email => 'The e-mail address you entered',
               notv  => 'is not a valid e-mail address',
    );
    my $output =  "\n".'<script type="text/javascript">'."\n".
                  &Apache::lonhtmlcommon::javascript_valid_email()."\n";
    $output .= <<"ENDSCRIPT";
function validate_email() {
    field = document.createaccount.useremail;
    if (validmail(field) == false) {
        alert("$lt{'email'}: "+field.value+" $lt{'notv'}.");
        return false;
    }
    return true;
}
ENDSCRIPT
    $output .= "\n".'</script>'."\n";
    return $output;
}

sub print_username_form {
    my ($domain,$domdesc,$cancreate,$now,$lonhost,$courseid) = @_;
    my %lt = &Apache::lonlocal::texthash(
                                         unam => 'username',
                                         udom => 'domain',
                                         uemail => 'E-mail address in LON-CAPA',
                                         proc => 'Proceed');
    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>'.&mt('Create account with a username provided by this institution').'</h3>';
                my $submit_text = &mt('Create LON-CAPA account');
                $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 />'.&mt('Type in your log-in ID and password to find out.').'<br /><br />';
                $output .= &login_box($now,$lonhost,$courseid,$submit_text,
                                      $domain,'createaccount').'</div>';
            }
        }
        if (grep(/^email$/,@{$cancreate})) {
            $output .= '<div class="LC_left_float"><h3>'.&mt('Create account with an e-mail address as your username').'</h3>';
            my $captchaform = &create_captcha();
            if ($captchaform) {
                my $submit_text = &mt('Request LON-CAPA account');
                my $emailform = '<input type="text" name="useremail" size="25" value="" />';
                if (grep(/^login$/,@{$cancreate})) {
                    $output .= &mt('Provide your e-mail address to request a LON-CAPA account,[_1] if you do not have a log-in ID at your institution.','<br />').'<br /><br />';
                } else {
                    $output .= '<br />';
                }
                $output .=  '<form name="createaccount" method="post" onSubmit="return validate_email()" action="/adm/createaccount">'.
                            &Apache::lonhtmlcommon::start_pick_box()."\n".
                            &Apache::lonhtmlcommon::row_title(&mt('E-mail address'),
                                                             'LC_pick_box_title')."\n".
                            $emailform."\n".
                            &Apache::lonhtmlcommon::row_closure(1).
                            &Apache::lonhtmlcommon::row_title(&mt('Validation'),
                                                             'LC_pick_box_title')."\n".
                            $captchaform."\n".'<br /><br />';
                if ($courseid ne '') {
                    $output .= '<input type="hidden" name="courseid" value="'.$courseid.'"/>'."\n"; 
                }
                $output .=  &Apache::lonhtmlcommon::row_closure(1).
                            &Apache::lonhtmlcommon::row_title().'<br />'.
                            '<input type="submit" name="create_with_email" value="'. 
                            $submit_text.'" />'.
                            &Apache::lonhtmlcommon::row_closure(1).
                            &Apache::lonhtmlcommon::end_pick_box().'<br /><br />';
                if ($courseid ne '') {
                    $output .= &Apache::lonhtmlcommon::echo_form_input(['courseid']);
                }
                $output .= '</form>';
            } else {
                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 an e-mail address to be used as username.','<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()">');
            }
            $output .= '</div>';
        }
    }
    if ($output eq '') {
        $output = &mt('Creation of a new LON-CAPA user account using an e-mail address or an institutional log-in ID as your username 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::lonpreferences::des_keys();
    my ($lextkey,$uextkey) = &getkeys($lkey,$ukey);
    my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount',
                                       $lonhost);
    $output = &serverform($logtoken,$lonhost,undef,$courseid,$context);
    my $unameform = '<input type="text" name="uname" size="20" value="" />';
    my $upassform = '<input type="password" name="upass'.$now.'" size="20" />';
    $output .= '<form name="client" method="post" onsubmit="return(send());">'."\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,$courseid) = @_;
    $useremail = $env{'form.useremail'};
    my $output;
    if (ref($cancreate) eq 'ARRAY') {
        if (!grep(/^email$/,@{$cancreate})) {
            $output = &invalid_state('noemails',$domdesc,
                                     $contact_name,$contact_email);
            return $output;
        } elsif ($useremail !~ /^[^\@]+\@[^\@]+\.[^\@\.]+$/) {
            $output = &invalid_state('baduseremail',$domdesc,
                                     $contact_name,$contact_email);
            return $output;
        } else {
            my $uhome = &Apache::lonnet::homeserver($useremail,$domain);
            if ($uhome ne 'no_host') {
                $output = &invalid_state('existinguser',$domdesc,
                                         $contact_name,$contact_email);
                return $output;
            } else {
                my $code = $env{'form.code'};
                my $md5sum = $env{'form.crypt'};
                my %captcha_params = &captcha_settings();
                my $captcha = Authen::Captcha->new(
                                  output_folder => $captcha_params{'output_dir'},
                                  data_folder   => $captcha_params{'db_dir'},
                                 );
                my $captcha_chk = $captcha->check_code($code,$md5sum);
                my %captcha_hash = (
                                  0       => 'Code not checked (file error)',
                                  -1      => 'Failed: code expired',
                                  -2      => 'Failed: invalid code (not in database)',
                                  -3      => 'Failed: invalid code (code does not match crypt)',
                                   );
                if ($captcha_chk != 1) {
                    $output = &invalid_state('captcha',$domdesc,$contact_name,
                                             $contact_email,$captcha_hash{$captcha_chk});
                    return $output;
                }
                my $uhome=&Apache::lonnet::homeserver($useremail,$domain);
                if ($uhome eq 'no_host') {
                    my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts);
                    &call_rulecheck($useremail,$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}{$useremail}) {
                                $output = &invalid_state('userrules',$domdesc,
                                                         $contact_name,$contact_email);
                                return $output;
                            }
                        }
                    }
                    my $format_msg = 
                        &guest_format_check($useremail,$domain,$cancreate,
                                            $settings);
                    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);
    }
    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) = @_;
    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;
    my %info = ('ip'         => $ENV{'REMOTE_ADDR'},
                'time'       => $now,
                'domain'     => $domain,
                'username'   => $email,
                'courseid'   => $courseid);
    my $token = &Apache::lonnet::tmpput(\%info,$server);
    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);
    }
    return $msg;
}

sub process_mailtoken {
    my ($r,$token,$contact_name,$contact_email,$domain,$domdesc,$lonhost,
        $include,$start_page) = @_;
    my ($msg,$nostart,$noend);
    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{'username'}  =~ /^[^\@]+\@[^\@]+\.[^\@\.]+$/)) {
        if ($now - $data{'time'} < 7200) {
            if ($env{'form.phase'} eq 'createaccount') {
                my ($result,$output) = &create_account($r,$domain,$lonhost,
                                                       $data{'username'},$domdesc);
                if ($result eq 'ok') {
                    $msg = $output; 
                    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,$ENV{'REMOTE_ADDR'},$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'});
                    }
                    my %form = &start_session($r,$data{'username'},$domain, 
                                              $lonhost,$data{'courseid'},
                                              $token);
                    $nostart = 1;
                    $noend = 1;
                } else {
                    $msg .= &mt('A problem occurred when attempting to create your new LON-CAPA account.')
                           .'<br />'.$output
#                           .&mt('Please contact the [_1] ([_2]) for assistance.',$contact_name,'<a href="mailto:'.$contact_email.'">'.$contact_email.'</a>');
                           .&mt('Please contact the [_1] ([_2]) for assistance.',$contact_name,$contact_email);
                }
                my $delete = &Apache::lonnet::tmpdel($token);
            } else {
                $msg .= &mt('Please provide user information and a password for your new account.').'<br />'.&mt('Your password, which must contain at least seven characters, will be sent to the LON-CAPA server in an encrypted form.').'<br />';
                $msg .= &print_dataentry_form($r,$domain,$lonhost,$include,$token,$now,$data{'username'},$start_page);
                $nostart = 1;
            }
        } 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);
}

sub start_session {
    my ($r,$username,$domain,$lonhost,$courseid,$token) = @_;
    my %form = (
                uname => $username,
                udom  => $domain,
               );
    my $firsturl = '/adm/roles';
    if (defined($courseid)) {
        $courseid = &validate_course($courseid);
        if ($courseid ne '') {
            $form{'courseid'} = $courseid;
            $firsturl = '/adm/selfenroll?courseid='.$courseid;
        }
    }
    if ($r->dir_config('lonBalancer') eq 'yes') {
        &Apache::lonauth::success($r,$form{'uname'},$form{'udom'},
                                  $lonhost,'noredirect',undef,\%form);
        if ($token ne '') { 
            my $delete = &Apache::lonnet::tmpdel($token);
        }
        $r->internal_redirect('/adm/switchserver');
    } else {
        &Apache::lonauth::success($r,$form{'uname'},$form{'udom'},
                                  $lonhost,$firsturl,undef,\%form);
    }
    return %form;
}


sub print_dataentry_form {
    my ($r,$domain,$lonhost,$include,$mailtoken,$now,$username,$start_page) = @_;
    my ($error,$output);
    &print_header($r,$start_page);
    if (open(my $jsh,"<$include/londes.js")) {
        while(my $line = <$jsh>) {
            $r->print($line);
        }
        close($jsh);
        $output .= &javascript_setforms($now)."\n".&javascript_checkpass($now);
        my ($lkey,$ukey) = &Apache::lonpreferences::des_keys();
        my ($lextkey,$uextkey) = &getkeys($lkey,$ukey);
        my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount',
                                           $lonhost);
        my $formtag = '<form name="server" method="post" target="_top" action="/adm/createaccount">';
        my ($datatable,$rowcount) =
            &Apache::loncreateuser::personal_data_display($username,$domain,
                                                          'email','selfcreate');
        if ($rowcount) {
            $output .= '<div class="LC_left_float">'.$formtag.$datatable;
        } else {
            $output .= $formtag;
        }
        $output .= <<"ENDSERVERFORM";
   <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="createaccount" />
  </form>
ENDSERVERFORM
        if ($rowcount) {
            $output .= '</div>'.
                       '<div class="LC_left_float">';
        }
        my $upassone = '<input type="password" name="upass'.$now.'" size="10" />';
        my $upasstwo = '<input type="password" name="upasscheck'.$now.'" size="10" />';
        my $submit_text = &mt('Create LON-CAPA account');
        $output .= '<h3>'.&mt('Login Data').'</h3>'."\n".
                   '<form name="client" method="post" '.
                   'onsubmit="return checkpass();">'."\n".
                   &Apache::lonhtmlcommon::start_pick_box()."\n".
                   &Apache::lonhtmlcommon::row_title(&mt('Username'),
                                                     'LC_pick_box_title',
                                                     'LC_oddrow_value')."\n".
                   $username."\n".
                   &Apache::lonhtmlcommon::row_closure(1)."\n".
                   &Apache::lonhtmlcommon::row_title(&mt('Password'),
                                                    'LC_pick_box_title',
                                                    'LC_oddrow_value')."\n".
                   $upassone."\n".
                   &Apache::lonhtmlcommon::row_closure(1)."\n".
                   &Apache::lonhtmlcommon::row_title(&mt('Confirm password'),
                                                     'LC_pick_box_title',
                                                     'LC_oddrow_value')."\n".
                   $upasstwo.
                   &Apache::lonhtmlcommon::row_closure(1)."\n".
                   &Apache::lonhtmlcommon::row_title()."\n".
                   '<br /><input type="submit" name="createaccount" value="'.
                   $submit_text.'" />'.
                   &Apache::lonhtmlcommon::row_closure(1)."\n".
                   &Apache::lonhtmlcommon::end_pick_box()."\n".
                   '<input type="hidden" name="uname" value="'.$username.'" />'."\n".
                   '<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>';
        if ($rowcount) {
            $output .= '</div>'."\n".
                       '<div class="LC_clear_float_footer"></div>'."\n";
        }
    } else {
        $output = &mt('Could not load javascript file [_1]','<tt>londes.js</tt>');
    }
    return $output;
}

sub create_account {
    my ($r,$domain,$lonhost,$username,$domdesc) = @_;
    my ($retrieved,$output,$upass) = &process_credentials($env{'form.logtoken'},
                                                          $env{'form.serverid'}); 
    # Error messages
    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();
    if ($retrieved eq 'ok') {
        if ($env{'form.courseid'} ne '') {
            my ($result,$userchkmsg) = &check_id($username,$domain,$domdesc);
            if ($result eq 'fail') {
                $output = $error.&mt('Invalid ID format').$end.
                          $userchkmsg.$rtnlink;
                return ('fail',$output);
            }
        }
    } else {
        return ('fail',$error.$output.$end.$rtnlink);
    }
    # Call modifyuser
    my $result = 
        &Apache::lonnet::modifyuser($domain,$username,$env{'form.cid'},
                                    'internal',$upass,$env{'form.cfirstname'},
                                    $env{'form.cmiddlename'},$env{'form.clastname'},
                                    $env{'form.cgeneration'},undef,undef,$username);
    $output = &mt('Generating user: [_1]',$result);
    my $uhome = &Apache::lonnet::homeserver($username,$domain);
    $output .= '<br />'.&mt('Home server: [_1]',$uhome).' '.
              &Apache::lonnet::hostname($uhome).'<br /><br />';
    return ('ok',$output);
}

sub username_validation {
    my ($r,$username,$domain,$domdesc,$contact_name,$contact_email,$courseid,
        $lonhost) = @_;
    my ($retrieved,$output,$upass);

    $username= &LONCAPA::clean_username($username);
    $domain = &LONCAPA::clean_domain($domain);
    my $uhome = &Apache::lonnet::homeserver($username,$domain);

    ($retrieved,$output,$upass) = &process_credentials($env{'form.logtoken'},
                                                       $env{'form.serverid'});
    if ($retrieved ne 'ok') {
        return ('fail',$output);
    }
    if ($uhome ne 'no_host') {
        my $result = &Apache::lonnet::authenticate($username,$upass,$domain);
        if ($result ne 'no_host') { 
            my %form = &start_session($r,$username,$domain,$lonhost,$courseid);
            $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);
        } 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) = @_;
    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) {
        $output = '<form method="post" action="/adm/createaccount">';
        (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 %info = ('ip'         => $ENV{'REMOTE_ADDR'},
                    'time'       => $now,
                    'domain'     => $domain,
                    'username'   => $username);
        my $authtoken = &Apache::lonnet::tmpput(\%info,$lonhost);
        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 = '<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;
        }
        $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 = '<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,$lonhost,$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 '') {
        $output .= '<br />'.&mt('Please [_1]start again[_2].','<a href="/adm/createaccount">','</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 ($result,$userchkmsg) = &check_id($username,$domain,$domdesc);
            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 %form = &start_session($r,$username,$domain,$lonhost,$courseid);
            my $nostart = 1;
            return ('ok',$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,$domdesc) = @_;
    # Check ID format
    my (%alerts,%rulematch,%inst_results,%curr_rules,%checkhash);
    my %checks = ('id' => 1);
    %{$checkhash{$username.':'.$domain}} = (
                                            'newuser' => 1,
                                            'id' => $env{'form.cid'},
                                           );
    &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') {
                    $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 '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 'captcha') {
        $msg = &mt('Validation of the code your entered failed.');
    } 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.');
    }
    $msg .= '</span>';
    if ($msgtext) {
        $msg .= '<br />'.$msgtext;
    }
    $msg .= &linkto_email_help($contact_email,$domdesc);
    return $msg;
}

sub linkto_email_help {
    my ($contact_email,$domdesc) = @_;
    my $msg;
    if ($contact_email ne '') {
        my $escuri = &HTML::Entities::encode('/adm/createaccount','&<>"');
        $msg .= '<br />'.&mt('You may wish to contact the [_1]LON-CAPA helpdesk[_2] for [_3].','<a href="/adm/helpdesk?origurl='.$escuri.'">','</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{'AdminEmail'},$domdesc).'<br />';
    }
    return $msg;
}

sub create_captcha {
    my ($output_dir,$db_dir) = @_;
    my %captcha_params = &captcha_settings();
    my ($output,$maxtries,$tries) = ('',10,0);
    while ($tries < $maxtries) {
        $tries ++;
        my $captcha = Authen::Captcha->new (
                                           output_folder => $captcha_params{'output_dir'},
                                           data_folder   => $captcha_params{'db_dir'},
                                          );
        my $md5sum = $captcha->generate_code($captcha_params{'numchars'});

        if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
            $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                      &mt('Type in the letters/numbers shown below').'&nbsp;'.
                     '<input type="text" size="5" name="code" value="" /><br />'.
                     '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png">';
            last;
        }
    }
    return $output;
}

sub captcha_settings {
    my %captcha_params = ( 
                           output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                           www_output_dir => "/captchaspool",
                           db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                           numchars       => '5',
                         );
    return %captcha_params;
}

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 process_credentials {
    my ($logtoken,$lonhost) = @_;
    my $tmpinfo=Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
    my ($retrieved,$output,$upass);
    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 ($retrieved,$output,$upass); 
    } else {
        my $reply = &Apache::lonnet::reply('tmpdel:'.$logtoken,$lonhost);
        if ($reply eq 'ok') {
            $retrieved = 'ok';
        } else {
            $output = &mt('Session could not be opened.');
        }
    }
    my ($key,$caller)=split(/&/,$tmpinfo);
    if ($caller eq 'createaccount') {
        $upass = &Apache::lonpreferences::des_decrypt($key,$env{'form.upass'});
    } else {
        $output = &mt('Unable to retrieve your log-in information - unexpected context');
    }
    return ($retrieved,$output,$upass);
}

sub guest_format_check {
    my ($useremail,$domain,$cancreate,$settings) = @_;
    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'}});
        }
    }
    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">

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

}

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.