File:  [LON-CAPA] / loncom / interface / createaccount.pm
Revision 1.21: download - view: text, annotated - select for diffs
Mon Jul 14 10:17:42 2008 UTC (15 years, 10 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD
- already declared.

    1: # The LearningOnline Network
    2: # Allow visitors to create a user account with the username being either an 
    3: # institutional log-in ID (institutional authentication required - localauth
    4: #  or kerberos) or an e-mail address.
    5: #
    6: # $Id: createaccount.pm,v 1.21 2008/07/14 10:17:42 raeburn Exp $
    7: #
    8: # Copyright Michigan State University Board of Trustees
    9: #
   10: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   11: #
   12: # LON-CAPA is free software; you can redistribute it and/or modify
   13: # it under the terms of the GNU General Public License as published by
   14: # the Free Software Foundation; either version 2 of the License, or
   15: # (at your option) any later version.
   16: #
   17: # LON-CAPA is distributed in the hope that it will be useful,
   18: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   19: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   20: # GNU General Public License for more details.
   21: #
   22: # You should have received a copy of the GNU General Public License
   23: # along with LON-CAPA; if not, write to the Free Software
   24: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   25: #
   26: # /home/httpd/html/adm/gpl.txt
   27: #
   28: # http://www.lon-capa.org/
   29: #
   30: #
   31: package Apache::createaccount;
   32: 
   33: use strict;
   34: use Apache::Constants qw(:common);
   35: use Apache::lonacc;
   36: use Apache::lonnet;
   37: use Apache::loncommon;
   38: use Apache::lonhtmlcommon;
   39: use Apache::lonlocal;
   40: use Apache::lonauth;
   41: use Apache::resetpw;
   42: use Authen::Captcha;
   43: use DynaLoader; # for Crypt::DES version
   44: use Crypt::DES;
   45: use LONCAPA qw(:DEFAULT :match);
   46: use HTML::Entities;
   47: 
   48: sub handler {
   49:     my $r = shift;
   50:     &Apache::loncommon::content_type($r,'text/html');
   51:     $r->send_http_header;
   52:     if ($r->header_only) {
   53:         return OK;
   54:     }
   55:     
   56:     my $domain;
   57: 
   58:     my $sso_username = $r->subprocess_env->get('REDIRECT_SSOUserUnknown');
   59:     my $sso_domain = $r->subprocess_env->get('REDIRECT_SSOUserDomain');
   60: 
   61:     if ($sso_username ne '' && $sso_domain ne '') {
   62:         $domain = $sso_domain; 
   63:     } else { 
   64:         $domain = &Apache::lonnet::default_login_domain();
   65:     }
   66:     my $domdesc = &Apache::lonnet::domain($domain,'description');
   67:     my $contact_name = &mt('LON-CAPA helpdesk');
   68:     my $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
   69:     my $contacts =
   70:         &Apache::loncommon::build_recipient_list(undef,'helpdeskmail',
   71:                                                  $domain,$origmail);
   72:     my ($contact_email) = split(',',$contacts);
   73:     my $lonhost = $r->dir_config('lonHostID');
   74:     my $include = $r->dir_config('lonIncludes');
   75:     my $start_page;
   76: 
   77:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['token','courseid']);
   78:     &Apache::lonacc::get_posted_cgi($r);
   79:     &Apache::lonlocal::get_language_handle($r);
   80: 
   81:     my $handle = &Apache::lonnet::check_for_valid_session($r);
   82:     if ($handle ne '') {
   83:         $start_page =
   84:             &Apache::loncommon::start_page('Already logged in');
   85:         my $end_page =
   86:             &Apache::loncommon::end_page();
   87:         $r->print($start_page."\n".'<h2>'.&mt('You are already logged in').'</h2>'.
   88:                   '<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]logout[_4].','<a href="/adm/roles">','</a>','<a href="/adm/logout">','</a>').
   89:                   '</p><p><a href="/adm/loginproblems.html">'.&mt('Login problems?').'</a></p>'.$end_page);
   90:         return OK;
   91:     }
   92: 
   93:     my $courseid;
   94:     if (defined($env{'form.courseid'})) {
   95:         $courseid = &validate_course($env{'form.courseid'});
   96:     }
   97:     if ($env{'form.phase'} eq 'selfenroll_login') {
   98:         if ($env{'form.udom'} ne '') {
   99:             $domain = $env{'form.udom'};
  100:         }
  101:         my ($result,$output) =
  102:             &username_validation($r,$env{'form.uname'},$domain,$domdesc,
  103:  
  104:                                  $contact_name,$contact_email,$courseid,
  105:                                  $lonhost);
  106:         if ($result eq 'existingaccount') {
  107:             $r->print($output);
  108:             $r->print(&Apache::loncommon::end_page());
  109:             return OK;
  110:         } else {
  111:             $start_page = 
  112:                 &Apache::loncommon::start_page('Self-enroll in a LON-CAPA course','',
  113:                                                {'no_inline_link'   => 1,});
  114:             &print_header($r,$start_page);
  115:             $r->print($output.&Apache::loncommon::end_page());    
  116:             return OK;
  117:         }
  118:     }
  119: 
  120:     $start_page =
  121:         &Apache::loncommon::start_page('Create a user account in LON-CAPA','',
  122:                                        {'no_inline_link'   => 1,});
  123:     my @cancreate;
  124:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$domain);
  125:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
  126:         if (ref($domconfig{'usercreation'}{'cancreate'}) eq 'HASH') {
  127:             if (ref($domconfig{'usercreation'}{'cancreate'}{'selfcreate'}) eq 'ARRAY') {
  128:                 @cancreate = @{$domconfig{'usercreation'}{'cancreate'}{'selfcreate'}};
  129:             } elsif (($domconfig{'usercreation'}{'cancreate'}{'selfcreate'} ne 'none') &&
  130:                      ($domconfig{'usercreation'}{'cancreate'}{'selfcreate'} ne '')) {
  131:                 @cancreate = ($domconfig{'usercreation'}{'cancreate'}{'selfcreate'});
  132:             }
  133:         }
  134:     }
  135: 
  136:     if (@cancreate == 0) {
  137:         &print_header($r,$start_page);
  138:         my $output = '<h3>'.&mt('Account creation unavailable').'</h3>'.
  139:                      '<span class="LC_warning">'.
  140:                      &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 />';
  141:         $r->print($output);
  142:         $r->print(&Apache::loncommon::end_page());
  143:         return OK;
  144:     }
  145: 
  146:     if ($sso_username ne '') {
  147:         &print_header($r,$start_page);
  148:         my ($msg,$sso_logout);
  149:         $sso_logout = &sso_logout_frag($r,$domain);
  150:         if (grep(/^sso$/,@cancreate)) {
  151:             $msg = '<h3>'.&mt('Account creation').'</h3>'.
  152:                    &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 />';
  153: 
  154:             $msg .= &username_check($sso_username,$domain,$domdesc,$courseid, 
  155:                                     $lonhost,$contact_email,$contact_name,$sso_logout);
  156:         } else {
  157:             $msg = '<h3>'.&mt('Account creation unavailable').'</h3>'.
  158:                    '<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 />'.
  159:                    $sso_logout;
  160:         }
  161:         $r->print($msg);
  162:         $r->print(&Apache::loncommon::end_page());
  163:         return OK;
  164:     }
  165: 
  166:     my ($output,$nostart,$noend);
  167:     my $token = $env{'form.token'};
  168:     if ($token) {
  169:         ($output,$nostart,$noend) = 
  170:             &process_mailtoken($r,$token,$contact_name,$contact_email,$domain,
  171:                                $domdesc,$lonhost,$include,$start_page);
  172:         if ($nostart) {
  173:             if ($noend) {
  174:                 return OK;
  175:             } else {
  176:                 $r->print($output);
  177:                 $r->print(&Apache::loncommon::end_page());
  178:                 return OK;
  179:             }
  180:         } else {
  181:             &print_header($r,$start_page);
  182:             $r->print($output);
  183:             $r->print(&Apache::loncommon::end_page());
  184:             return OK;
  185:         }
  186:     }
  187: 
  188:     if ($env{'form.phase'} eq 'username_activation') {
  189:         (my $result,$output,$nostart) = 
  190:             &username_activation($r,$env{'form.uname'},$domain,$domdesc,
  191:                                  $lonhost,$courseid);
  192:         if ($result eq 'ok') {
  193:             if ($nostart) {
  194:                 return OK;
  195:             }
  196:         }
  197:         &print_header($r,$start_page);
  198:         $r->print($output);
  199:         $r->print(&Apache::loncommon::end_page());
  200:         return OK;
  201:     } elsif ($env{'form.phase'} eq 'username_validation') { 
  202:         (my $result,$output) = 
  203:             &username_validation($r,$env{'form.uname'},$domain,$domdesc,
  204:                                  $contact_name,$contact_email,$courseid,
  205:                                  $lonhost);
  206:         if ($result eq 'existingaccount') {
  207:             $r->print($output);
  208:             $r->print(&Apache::loncommon::end_page());
  209:             return OK;
  210:         } else {
  211:             &print_header($r,$start_page);
  212:         }
  213:     } elsif ($env{'form.create_with_email'}) {
  214:         &print_header($r,$start_page);
  215:         $output = &process_email_request($env{'form.useremail'},$domain,$domdesc,
  216:                                          $contact_name,$contact_email,\@cancreate,
  217:                                          $lonhost,$domconfig{'usercreation'},
  218:                                          $courseid);
  219:     } elsif (!$token) {
  220:         &print_header($r,$start_page);
  221:         my $now=time;
  222:         if (grep(/^login$/,@cancreate)) {
  223:             my $jsh=Apache::File->new($include."/londes.js");
  224:             $r->print(<$jsh>);
  225:             $r->print(&javascript_setforms($now));
  226:         }
  227:         if (grep(/^email$/,@cancreate)) {
  228:             $r->print(&javascript_validmail());
  229:         }
  230:         $output = &print_username_form($domain,$domdesc,\@cancreate,$now,$lonhost,
  231:                                        $courseid); 
  232:     }
  233:     $r->print($output);
  234:     $r->print(&Apache::loncommon::end_page());
  235:     return OK;
  236: }
  237: 
  238: sub print_header {
  239:     my ($r,$start_page) = @_;
  240:     $r->print($start_page);
  241:     &Apache::lonhtmlcommon::clear_breadcrumbs();
  242:     &Apache::lonhtmlcommon::add_breadcrumb
  243:     ({href=>"/adm/createuser",
  244:       text=>"New username"});
  245:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Create account'));
  246:     return;
  247: }
  248: 
  249: sub validate_course {
  250:     my ($courseid) = @_;
  251:     my ($cdom,$cnum) = ($courseid =~ /^($match_domain)_($match_courseid)$/);
  252:     if (($cdom ne '') && ($cnum ne '')) {
  253:         if (&Apache::lonnet::is_course($cdom,$cnum)) {
  254:             return ($courseid);
  255:         }
  256:     }
  257:     return;
  258: }
  259: 
  260: sub javascript_setforms {
  261:     my ($now) =  @_;
  262:     my $js = <<ENDSCRIPT;
  263:  <script language="JavaScript">
  264:     function send() {
  265:         this.document.server.elements.uname.value = this.document.client.elements.uname.value;
  266:         uextkey=this.document.client.elements.uextkey.value;
  267:         lextkey=this.document.client.elements.lextkey.value;
  268:         initkeys();
  269: 
  270:         this.document.server.elements.upass.value
  271:             = crypted(this.document.client.elements.upass$now.value);
  272: 
  273:         this.document.client.elements.uname.value='';
  274:         this.document.client.elements.upass$now.value='';
  275: 
  276:         this.document.server.submit();
  277:         return false;
  278:     }
  279:  </script>
  280: ENDSCRIPT
  281:     return $js;
  282: }
  283: 
  284: sub javascript_checkpass {
  285:     my ($now) = @_;
  286:     my $nopass = &mt('You must enter a password.');
  287:     my $mismatchpass = &mt('The passwords you entered did not match.').'\\n'.
  288:                        &mt('Please try again.'); 
  289:     my $js = <<"ENDSCRIPT";
  290: <script type="text/javascript" language="JavaScript">
  291:     function checkpass() {
  292:         var upass = this.document.client.elements.upass$now.value;
  293:         var upasscheck = this.document.client.elements.upasscheck$now.value;
  294:         if (upass == '') {
  295:             alert("$nopass");
  296:             return;
  297:         }
  298:         if (upass == upasscheck) {
  299:             this.document.client.elements.upasscheck$now.value='';
  300:             send();
  301:             return;
  302:         } else {
  303:             alert("$mismatchpass");
  304:             return;
  305:         } 
  306:     }
  307: </script>
  308: ENDSCRIPT
  309:     return $js;
  310: }
  311: 
  312: sub javascript_validmail {
  313:     my %lt = &Apache::lonlocal::texthash (
  314:                email => 'The e-mail address you entered',
  315:                notv  => 'is not a valid e-mail address',
  316:     );
  317:     my $output =  "\n".'<script type="text/javascript">'."\n".
  318:                   &Apache::lonhtmlcommon::javascript_valid_email()."\n";
  319:     $output .= <<"ENDSCRIPT";
  320: function validate_email() {
  321:     field = document.createaccount.useremail;
  322:     if (validmail(field) == false) {
  323:         alert("$lt{'email'}: "+field.value+" $lt{'notv'}.");
  324:         return false;
  325:     }
  326:     return true;
  327: }
  328: ENDSCRIPT
  329:     $output .= "\n".'</script>'."\n";
  330:     return $output;
  331: }
  332: 
  333: sub print_username_form {
  334:     my ($domain,$domdesc,$cancreate,$now,$lonhost,$courseid) = @_;
  335:     my %lt = &Apache::lonlocal::texthash(
  336:                                          unam => 'username',
  337:                                          udom => 'domain',
  338:                                          uemail => 'Email address in LON-CAPA',
  339:                                          proc => 'Proceed');
  340:     my $output;
  341:     if (ref($cancreate) eq 'ARRAY') {
  342:         if (grep(/^login$/,@{$cancreate})) {
  343:             my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
  344:             if ((($domdefaults{'auth_def'} =~/^krb/) && ($domdefaults{'auth_arg_def'} ne '')) || ($domdefaults{'auth_def'} eq 'localauth')) {
  345:                 $output = '<div class="LC_left_float"><h3>'.&mt('Create account with a username provided by this institution').'</h3>';
  346:                 my $submit_text = &mt('Create LON-CAPA account');
  347:                 $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 />';
  348:                 $output .= &login_box($now,$lonhost,$courseid,$submit_text,
  349:                                       $domain,'createaccount');
  350:             }
  351:         }
  352:         if (grep(/^email$/,@{$cancreate})) {
  353:             $output .= '<div class="LC_left_float"><h3>'.&mt('Create account with an e-mail address as your username').'</h3>';
  354:             if (grep(/^login$/,@{$cancreate})) {
  355:                 $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 />';
  356:             } else {
  357:                 $output .= '<br />';
  358:             }
  359:             my $emailform = '<input type="text" name="useremail" size="25" value="" />';
  360:             my $captchaform = &create_captcha();
  361:             my $submit_text = &mt('Request LON-CAPA account');
  362:             $output .=  '<form name="createaccount" method="post" onSubmit="return validate_email()" action="/adm/createaccount">'.
  363:                         &Apache::lonhtmlcommon::start_pick_box()."\n".
  364:                         &Apache::lonhtmlcommon::row_title(&mt('E-mail address'),
  365:                                                          'LC_pick_box_title')."\n".
  366:                         $emailform."\n".
  367:                         &Apache::lonhtmlcommon::row_closure(1).
  368:                         &Apache::lonhtmlcommon::row_title(&mt('Validation'),
  369:                                                          'LC_pick_box_title')."\n".
  370:                         $captchaform."\n".'<br /><br />';
  371:             if ($courseid ne '') {
  372:                 $output .= '<input type="hidden" name="courseid" value="'.$courseid.'"/>'."\n"; 
  373:             }
  374:             $output .= '<input type="submit" name="create_with_email" value="'. 
  375:                         $submit_text.'" />'.
  376:                         &Apache::lonhtmlcommon::row_closure(1).
  377:                         &Apache::lonhtmlcommon::end_pick_box().'<br /><br /></form>'.
  378:                         '</div>';
  379:         }
  380:     }
  381:     if ($output eq '') {
  382:         $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);
  383:     } else {
  384:         $output .= '<div class="LC_clear_float_footer"></div>';
  385:     }
  386:     return $output;
  387: }
  388: 
  389: sub login_box {
  390:     my ($now,$lonhost,$courseid,$submit_text,$domain,$context) = @_;
  391:     my $output;
  392:     my %titles = &Apache::lonlocal::texthash(
  393:                                               createaccount => 'Log-in ID',
  394:                                               selfenroll    => 'Username',
  395:                                             );
  396:     my ($lkey,$ukey) = &Apache::lonpreferences::des_keys();
  397:     my ($lextkey,$uextkey) = &getkeys($lkey,$ukey);
  398:     my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount',
  399:                                        $lonhost);
  400:     $output = &serverform($logtoken,$lonhost,undef,$courseid,$context);
  401:     my $unameform = '<input type="text" name="uname" size="10" value="" />';
  402:     my $upassform = '<input type="password" name="upass'.$now.'" size="10" />';
  403:     $output .= '<form name="client" method="post" action="/adm/createaccount">'."\n".
  404:                &Apache::lonhtmlcommon::start_pick_box()."\n";
  405:     if ($context eq 'selfenroll') {
  406:         my $udomform =  '<input type="text" name="udom" size="10" value="'.
  407:                         $domain.'" />';
  408:         $output .= &Apache::lonhtmlcommon::row_title(&mt('Domain'),
  409:                                                      'LC_pick_box_title')."\n".
  410:                    $udomform."\n".
  411:                    &Apache::lonhtmlcommon::row_closure(1)."\n";
  412:     }
  413: 
  414:     $output .= &Apache::lonhtmlcommon::row_title($titles{$context},
  415:                                                  'LC_pick_box_title')."\n".
  416:                $unameform."\n".
  417:                &Apache::lonhtmlcommon::row_closure(1)."\n".
  418:                &Apache::lonhtmlcommon::row_title(&mt('Password'),
  419:                                                 'LC_pick_box_title')."\n".
  420:                $upassform."\n".'<br /><br />'."\n".
  421:                '<input type="button" name="username_validation" value="'.
  422:                $submit_text.'" onclick="javascript:send()" />'."\n".
  423:                &Apache::lonhtmlcommon::row_closure(1)."\n".
  424:                &Apache::lonhtmlcommon::end_pick_box().'<br /><br />'."\n".
  425:                '<input type="hidden" name="lextkey" value="'.$lextkey.'">'."\n".
  426:                '<input type="hidden" name="uextkey" value="'.$uextkey.'">'."\n".
  427:                '</form></div>';
  428:     return $output;
  429: }
  430: 
  431: sub process_email_request {
  432:     my ($useremail,$domain,$domdesc,$contact_name,$contact_email,$cancreate,
  433:         $server,$settings,$courseid) = @_;
  434:     $useremail = $env{'form.useremail'};
  435:     my $output;
  436:     if (ref($cancreate) eq 'ARRAY') {
  437:         if (!grep(/^email$/,@{$cancreate})) {
  438:             $output = &invalid_state('noemails',$domdesc,
  439:                                      $contact_name,$contact_email);
  440:             return $output;
  441:         } elsif ($useremail !~ /^[^\@]+\@[^\@]+\.[^\@\.]+$/) {
  442:             $output = &invalid_state('baduseremail',$domdesc,
  443:                                      $contact_name,$contact_email);
  444:             return $output;
  445:         } else {
  446:             my $uhome = &Apache::lonnet::homeserver($useremail,$domain);
  447:             if ($uhome ne 'no_host') {
  448:                 $output = &invalid_state('existinguser',$domdesc,
  449:                                          $contact_name,$contact_email);
  450:                 return $output;
  451:             } else {
  452:                 my $code = $env{'form.code'};
  453:                 my $md5sum = $env{'form.crypt'};
  454:                 my %captcha_params = &captcha_settings();
  455:                 my $captcha = Authen::Captcha->new(
  456:                                   output_folder => $captcha_params{'output_dir'},
  457:                                   data_folder   => $captcha_params{'db_dir'},
  458:                                  );
  459:                 my $captcha_chk = $captcha->check_code($code,$md5sum);
  460:                 my %captcha_hash = (
  461:                                   0       => 'Code not checked (file error)',
  462:                                   -1      => 'Failed: code expired',
  463:                                   -2      => 'Failed: invalid code (not in database)',
  464:                                   -3      => 'Failed: invalid code (code does not match crypt)',
  465:                                    );
  466:                 if ($captcha_chk != 1) {
  467:                     $output = &invalid_state('captcha',$domdesc,$contact_name,
  468:                                              $contact_email,$captcha_hash{$captcha_chk});
  469:                     return $output;
  470:                 }
  471:                 my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts);
  472:                 my $uhome=&Apache::lonnet::homeserver($useremail,$domain);
  473:                 if ($uhome eq 'no_host') {
  474:                     my $checkhash;
  475:                     my $checks = { 'username' => 1 };
  476:                     $checkhash->{$useremail.':'.$domain} = { 'newuser' => 1, };
  477:                     &Apache::loncommon::user_rule_check($checkhash,$checks,
  478:                           \%alerts,\%rulematch,\%inst_results,\%curr_rules,
  479:                           \%got_rules);
  480:                     if (ref($alerts{'useremail'}) eq 'HASH') {
  481:                         if (ref($alerts{'useremail'}{$domain}) eq 'HASH') {
  482:                             if ($alerts{'username'}{$domain}{$useremail}) {
  483:                                 $output = &invalid_state('userrules',$domdesc,
  484:                                                          $contact_name,$contact_email);
  485:                                 return $output;
  486:                             }
  487:                         }
  488:                     }
  489:                     my $format_msg = 
  490:                         &guest_format_check($useremail,$domain,$cancreate,
  491:                                             $settings);
  492:                     if ($format_msg) {
  493:                         $output = &invalid_state('userformat',$domdesc,$contact_name,
  494:                                                  $contact_email,$format_msg);
  495:                         return $output;
  496:                     }
  497:                 }
  498:             }
  499:         }
  500:         $output = &send_token($domain,$useremail,$server,$domdesc,$contact_name,
  501:                           $contact_email,$courseid);
  502:     }
  503:     return $output;
  504: }
  505: 
  506: sub send_token {
  507:     my ($domain,$email,$server,$domdesc,$contact_name,$contact_email,$courseid) = @_;
  508:     my $msg = '<h3>'.&mt('Account creation status').'</h3>'.
  509:               &mt('Thank you for your request to create a new LON-CAPA account.').
  510:               '<br /><br />';
  511:     my $now = time;
  512:     my %info = ('ip'         => $ENV{'REMOTE_ADDR'},
  513:                 'time'       => $now,
  514:                 'domain'     => $domain,
  515:                 'username'   => $email,
  516:                 'courseid'   => $courseid);
  517:     my $token = &Apache::lonnet::tmpput(\%info,$server);
  518:     if ($token !~ /^error/ && $token ne 'no_such_host') {
  519:         my $esc_token = &escape($token);
  520:         my $mailmsg = &mt('A request was submitted on [_1] for creation of a LON-CAPA account at the following institution: [_2].',localtime(time),$domdesc).' '.
  521:              &mt('To complete this process please open a web browser and enter the following'
  522:                 .' URL in the address/location box: [_1]'
  523:                 ,&Apache::lonnet::absolute_url().'/adm/createaccount?token='.$esc_token);
  524:         my $result = &Apache::resetpw::send_mail($domdesc,$email,$mailmsg,$contact_name,
  525:                                                  $contact_email);
  526:         if ($result eq 'ok') {
  527:             $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>');
  528:         } else {
  529:             $msg .= '<span class="LC_error">'.
  530:                     &mt('An error occurred when sending a message to the e-mail address you provided.').'</span><br />'.
  531:                     ' '.&mt('Please contact the [_1] ([_2]) for assistance.',$contact_name,$contact_email);
  532:         }
  533:     } else {
  534:         $msg .= '<span class="LC_error">'.
  535:                 &mt('An error occurred creating a token required for the account creation process.').'</span><br />'.
  536:                 ' '.&mt('Please contact the [_1] ([_2]) for assistance.',$contact_name,$contact_email);
  537:     }
  538:     return $msg;
  539: }
  540: 
  541: sub process_mailtoken {
  542:     my ($r,$token,$contact_name,$contact_email,$domain,$domdesc,$lonhost,
  543:         $include,$start_page) = @_;
  544:     my ($msg,$nostart,$noend);
  545:     my %data = &Apache::lonnet::tmpget($token);
  546:     my $now = time;
  547:     if (keys(%data) == 0) {
  548:         $msg = &mt('Sorry, the URL you provided to complete creation of a new LON-CAPA account was invalid.')
  549:                .' '.&mt('Either the token included in the URL has been deleted or the URL you provided was invalid.')
  550:                .' '.&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>');
  551:         return $msg;
  552:     }
  553:     if (($data{'time'} =~ /^\d+$/) &&
  554:         ($data{'domain'} ne '') &&
  555:         ($data{'username'}  =~ /^[^\@]+\@[^\@]+\.[^\@\.]+$/)) {
  556:         if ($now - $data{'time'} < 7200) {
  557:             if ($env{'form.phase'} eq 'createaccount') {
  558:                 my ($result,$output) = &create_account($r,$domain,$lonhost,
  559:                                                        $data{'username'},$domdesc);
  560:                 if ($result eq 'ok') {
  561:                     $msg = $output; 
  562:                     my $shownow = &Apache::lonlocal::locallocaltime($now);
  563:                     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";
  564:                     my $mailresult = &Apache::resetpw::send_mail($domdesc,$data{'email'},
  565:                                                                  $mailmsg,$contact_name,
  566:                                                                  $contact_email);
  567:                     if ($mailresult eq 'ok') {
  568:                         $msg .= &mt('An e-mail confirming creation of your new LON-CAPA account has been sent to [_1].',$data{'username'});
  569:                     } else {
  570:                         $msg .= &mt('An error occurred when sending e-mail to [_1] confirming creation of your LON-CAPA account.',$data{'username'});
  571:                     }
  572:                     my %form = &start_session($r,$data{'username'},$domain, 
  573:                                               $lonhost,$data{'courseid'},
  574:                                               $token);
  575:                     $nostart = 1;
  576:                     $noend = 1;
  577:                 } else {
  578:                     $msg .= &mt('A problem occurred when attempting to create your new LON-CAPA account.')
  579:                            .'<br />'.$output
  580: #                           .&mt('Please contact the [_1] ([_2]) for assistance.',$contact_name,'<a href="mailto:'.$contact_email.'">'.$contact_email.'</a>');
  581:                            .&mt('Please contact the [_1] ([_2]) for assistance.',$contact_name,$contact_email);
  582:                 }
  583:                 my $delete = &Apache::lonnet::tmpdel($token);
  584:             } else {
  585:                 $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 />';
  586:                 $msg .= &print_dataentry_form($r,$domain,$lonhost,$include,$token,$now,$data{'username'},$start_page);
  587:                 $nostart = 1;
  588:             }
  589:         } else {
  590:             $msg = &mt('Sorry, the token generated when you requested creation of an account has expired.')
  591:                   .' '.&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>');
  592:             }
  593:     } else {
  594:         $msg .= &mt('Sorry, the URL generated when you requested creation of an account contained incomplete information.')
  595:                .' '.&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>');
  596:     }
  597:     return ($msg,$nostart,$noend);
  598: }
  599: 
  600: sub start_session {
  601:     my ($r,$username,$domain,$lonhost,$courseid,$token) = @_;
  602:     my %form = (
  603:                 uname => $username,
  604:                 udom  => $domain,
  605:                );
  606:     my $firsturl = '/adm/roles';
  607:     if (defined($courseid)) {
  608:         $courseid = &validate_course($courseid);
  609:         if ($courseid ne '') {
  610:             $form{'courseid'} = $courseid;
  611:             $firsturl = '/adm/selfenroll?cid='.$courseid;
  612:         }
  613:     }
  614:     if ($r->dir_config('lonBalancer') eq 'yes') {
  615:         &Apache::lonauth::success($r,$form{'uname'},$form{'udom'},
  616:                                   $lonhost,'noredirect',undef,\%form);
  617:         if ($token ne '') { 
  618:             my $delete = &Apache::lonnet::tmpdel($token);
  619:         }
  620:         $r->internal_redirect('/adm/switchserver');
  621:     } else {
  622:         &Apache::lonauth::success($r,$form{'uname'},$form{'udom'},
  623:                                   $lonhost,$firsturl,undef,\%form);
  624:     }
  625:     return %form;
  626: }
  627: 
  628: 
  629: sub print_dataentry_form {
  630:     my ($r,$domain,$lonhost,$include,$mailtoken,$now,$username,$start_page) = @_;
  631:     my ($error,$output);
  632:     &print_header($r,$start_page);
  633:     if (open(my $jsh,"<$include/londes.js")) {
  634:         while(my $line = <$jsh>) {
  635:             $r->print($line);
  636:         }
  637:         close($jsh);
  638:         $output .= &javascript_setforms($now)."\n".&javascript_checkpass($now);
  639:         my ($lkey,$ukey) = &Apache::lonpreferences::des_keys();
  640:         my ($lextkey,$uextkey) = &getkeys($lkey,$ukey);
  641:         my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount',
  642:                                            $lonhost);
  643:         my @userinfo = ('firstname','middlename','lastname','generation','id',
  644:                         'permanentemail');
  645:         my %lt=&Apache::lonlocal::texthash(
  646:                     'pd'             => "Personal Data",
  647:                     'firstname'      => "First Name",
  648:                     'middlename'     => "Middle Name",
  649:                     'lastname'       => "Last Name",
  650:                     'generation'     => "Generation",
  651:                     'permanentemail' => "Permanent e-mail address",
  652:                     'id'             => "ID/Student Number",
  653:                     'lg'             => "Login Data"
  654:         );
  655:         my %textboxsize = (
  656:                            firstname      => '15',
  657:                            middlename     => '15',
  658:                            lastname       => '15',
  659:                            generation     => '5',
  660:                            id             => '15',
  661:                           );
  662:         my $genhelp=&Apache::loncommon::help_open_topic('Generation');
  663:         $output .= '<div class="LC_left_float"><h3>'.$lt{'pd'}.'</h3>'.
  664:                   '<form name="server" method="post" target="_top" action="/adm/createaccount">'.
  665:                   &Apache::lonhtmlcommon::start_pick_box();
  666:         foreach my $item (@userinfo) {
  667:             my $rowtitle = $lt{$item};
  668:             if ($item eq 'generation') {
  669:                 $rowtitle = $genhelp.$rowtitle;
  670:             }
  671:             $output .= &Apache::lonhtmlcommon::row_title($rowtitle,undef,'LC_oddrow_value')."\n";
  672:             if ($item eq 'permanentemail') {
  673:                 $output .= $username;
  674:             } else {
  675:                 $output .= '<input type="text" name="c'.$item.'" size="'.$textboxsize{$item}.'" value="" />';
  676:             }
  677:             $output .= &Apache::lonhtmlcommon::row_closure(1);
  678:         }
  679:         $output .= &Apache::lonhtmlcommon::end_pick_box();
  680:         $output .= <<"ENDSERVERFORM";
  681:    <input type="hidden" name="logtoken" value="$logtoken" />
  682:    <input type="hidden" name="token" value="$mailtoken" />
  683:    <input type="hidden" name="serverid" value="$lonhost" />
  684:    <input type="hidden" name="uname" value="" />
  685:    <input type="hidden" name="upass" value="" />
  686:    <input type="hidden" name="phase" value="createaccount" />
  687:   </form></div>
  688: ENDSERVERFORM
  689:         my $upassone = '<input type="password" name="upass'.$now.'" size="10" />';
  690:         my $upasstwo = '<input type="password" name="upasscheck'.$now.'" size="10" />';
  691:         my $submit_text = &mt('Create LON-CAPA account');
  692:         $output .= '<div class="LC_left_float"><h3>'.$lt{'lg'}.'</h3>'."\n".
  693:                    '<form name="client" method="post" />'."\n".
  694:                    &Apache::lonhtmlcommon::start_pick_box()."\n".
  695:                    &Apache::lonhtmlcommon::row_title(&mt('Username'),
  696:                                                     'LC_pick_box_title')."\n".
  697:                    $username."\n".
  698:                    &Apache::lonhtmlcommon::row_closure(1)."\n".
  699:                    &Apache::lonhtmlcommon::row_title(&mt('Password'),
  700:                                                     'LC_pick_box_title')."\n".
  701:                    $upassone."\n".
  702:                    &Apache::lonhtmlcommon::row_closure(1)."\n".
  703:                    &Apache::lonhtmlcommon::row_title(&mt('Confirm password'),
  704:                                                 'LC_pick_box_title')."\n".
  705:                    $upasstwo."\n".
  706:                    &Apache::lonhtmlcommon::row_closure(1)."\n".
  707:                    &Apache::lonhtmlcommon::end_pick_box()."\n".
  708:                    '<input type="hidden" name="uname" value="'.$username.'">'."\n".
  709:                    '<input type="hidden" name="lextkey" value="'.$lextkey.'">'."\n".
  710:                    '<input type="hidden" name="uextkey" value="'.$uextkey.'">'."\n".
  711:                    '</form></div>'."\n".
  712:                    '<div class="LC_clear_float_footer"><br /><br />'."\n".
  713:                    '<form name="buttonform">'."\n".
  714:                    '<input type="button" name="createaccount" value="'.
  715:                    $submit_text.'" onclick="javascript:checkpass();" /></form></div>';
  716:     } else {
  717:         $output = &mt('Could not load javascript file [_1]','<tt>londes.js</tt>');
  718:     }
  719:     return $output;
  720: }
  721: 
  722: sub create_account {
  723:     my ($r,$domain,$lonhost,$username,$domdesc) = @_;
  724:     my ($retrieved,$output,$upass) = &process_credentials($env{'form.logtoken'},
  725:                                                           $env{'form.serverid'}); 
  726:     # Error messages
  727:     my $error     = '<span class="LC_error">'.&mt('Error:').' ';
  728:     my $end       = '</span><br /><br />';
  729:     my $rtnlink   = '<a href="javascript:history.back();" />'.
  730:                     &mt('Return to previous page').'</a>'.
  731:                     &Apache::loncommon::end_page();
  732:     if ($retrieved eq 'ok') {
  733:         if ($env{'form.cid'} ne '') {
  734:             my ($result,$userchkmsg) = &check_id($username,$domain,$domdesc);
  735:             if ($result eq 'fail') {
  736:                 $output = $error.&mt('Invalid ID format').$end.
  737:                           $userchkmsg.$rtnlink;
  738:                 return ('fail',$output);
  739:             }
  740:         }
  741:     } else {
  742:         return ('fail',$error.$output.$end.$rtnlink);
  743:     }
  744:     # Call modifyuser
  745:     my $result = 
  746:         &Apache::lonnet::modifyuser($domain,$username,$env{'form.cid'},
  747:                                     'internal',$upass,$env{'form.cfirstname'},
  748:                                     $env{'form.cmiddlename'},$env{'form.clastname'},
  749:                                     $env{'form.cgeneration'},undef,undef,$username);
  750:     $output = &mt('Generating user: [_1]',$result);
  751:     my $uhome = &Apache::lonnet::homeserver($username,$domain);
  752:     $output .= '<br />'.&mt('Home server: [_1]',$uhome).' '.
  753:               &Apache::lonnet::hostname($uhome).'<br /><br />';
  754:     return ('ok',$output);
  755: }
  756: 
  757: sub username_validation {
  758:     my ($r,$username,$domain,$domdesc,$contact_name,$contact_email,$courseid,
  759:         $lonhost) = @_;
  760:     my ($retrieved,$output,$upass);
  761: 
  762:     $username= &LONCAPA::clean_username($username);
  763:     $domain = &LONCAPA::clean_domain($domain);
  764:     my $uhome = &Apache::lonnet::homeserver($username,$domain);
  765: 
  766:     ($retrieved,$output,$upass) = &process_credentials($env{'form.logtoken'},
  767:                                                        $env{'form.serverid'});
  768:     if ($retrieved ne 'ok') {
  769:         return ('fail',$output);
  770:     }
  771:     if ($uhome ne 'no_host') {
  772:         my $result = &Apache::lonnet::authenticate($username,$upass,$domain);
  773:         if ($result ne 'no_host') { 
  774:             my %form = &start_session($r,$username,$domain,$lonhost,$courseid);
  775:             $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.');
  776:             return ('existingaccount',$output);
  777:         } else {
  778:             $output = '<div class="LC_warning">'.
  779:                       &mt('Username and/or password could not be authenticated.').
  780:                       '</div>'.
  781:                       &mt('Please check the username and password.');
  782:         }
  783:     } else {
  784:         my $primlibserv = &Apache::lonnet::domain($domain,'primary');
  785:         my $authok;
  786:         my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
  787:         if ((($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) || ($domdefaults{'auth_def'} eq 'localauth')) {
  788:             my $checkdefauth = 1;
  789:             $authok = 
  790:                 &Apache::lonnet::reply("encrypt:auth:$domain:$username:$upass:$checkdefauth",$primlibserv);
  791:         } else {
  792:             $authok = 'non_authorized';
  793:         }
  794:         if ($authok eq 'authorized') {
  795:             $output = &username_check($username,$domain,$domdesc,$courseid,$lonhost,
  796:                                       $contact_email,$contact_name);
  797:         } else {
  798:             $output = '<div class="LC_warning">'.
  799:                       &mt('Username and/or password could not be authenticated.').
  800:                       '</div>'.
  801:                       &mt('Please check the username and password.'); 
  802:         }
  803:     }
  804:     return ('ok',$output);
  805: }
  806: 
  807: sub username_check {
  808:     my ($username,$domain,$domdesc,$courseid,$lonhost,$contact_email,$contact_name,
  809:         $sso_logout) = @_;
  810:     my (%rulematch,%inst_results,$newuser,$checkfail,$rowcount,$editable,$output,$msg,
  811:         %alerts,%curr_rules,%got_rules);
  812:     $newuser = 1;
  813:     my $checkhash;
  814:     my $checks = { 'username' => 1 };
  815:     $checkhash->{$username.':'.$domain} = { 'newuser' => $newuser };
  816:     &Apache::loncommon::user_rule_check($checkhash,$checks,\%alerts,\%rulematch,
  817:                                         \%inst_results,\%curr_rules,\%got_rules);
  818:     if (ref($alerts{'username'}) eq 'HASH') {
  819:         if (ref($alerts{'username'}{$domain}) eq 'HASH') {
  820:             if ($alerts{'username'}{$domain}{$username}) {
  821:                 if (ref($curr_rules{$domain}) eq 'HASH') {
  822:                     $output =
  823:                         &Apache::loncommon::instrule_disallow_msg('username',$domdesc,1,
  824:                                                                   'selfcreate').
  825:                         &Apache::loncommon::user_rule_formats($domain,$domdesc,
  826:                                 $curr_rules{$domain}{'username'},'username');
  827:                 }
  828:                 $checkfail = 'username';
  829:             }
  830:         }
  831:     }
  832:     if (!$checkfail) {
  833:         $output = '<form method="post" action="/adm/createaccount">';
  834:         (my $datatable,$rowcount,$editable) = 
  835:             &Apache::loncreateuser::personal_data_display($username,$domain,1,'selfcreate',
  836:                                                          $inst_results{$username.':'.$domain});
  837:         if ($rowcount > 0) {
  838:             $output .= $datatable;
  839:         }
  840:         $output .=  '<br /><br /><input type="hidden" name="uname" value="'.$username.'" />'."\n".
  841:                     '<input type="hidden" name="udom" value="'.$domain.'" />'."\n".
  842:                     '<input type="hidden" name="phase" value="username_activation" />';
  843:         my $now = time;
  844:         my %info = ('ip'         => $ENV{'REMOTE_ADDR'},
  845:                     'time'       => $now,
  846:                     'domain'     => $domain,
  847:                     'username'   => $username);
  848:         my $authtoken = &Apache::lonnet::tmpput(\%info,$lonhost);
  849:         if ($authtoken !~ /^error/ && $authtoken ne 'no_such_host') {
  850:             $output .= '<input type="hidden" name="authtoken" value="'.&HTML::Entities::encode($authtoken,'&<>"').'" />';
  851:         } else {
  852:             $output = &mt('An error occurred when storing a token').'<br />'.
  853:                       &mt('You will not be able to proceed to the next stage of account creation').
  854:                       &linkto_email_help($contact_email,$domdesc);
  855:             $checkfail = 'authtoken';
  856:         }
  857:     }
  858:     if ($checkfail) { 
  859:         $msg = '<h4>'.&mt('Account creation unavailable').'</h4>';
  860:         if ($checkfail eq 'username') {
  861:             $msg .= '<span class="LC_warning">'.
  862:                      &mt('A LON-CAPA account may not be created with the username you use.').
  863:                      '</span><br /><br />'.$output;
  864:         } elsif ($checkfail eq 'authtoken') {
  865:             $msg .= '<span class="LC_error">'.&mt('Error creating token.').'</span>'.
  866:                     '<br />'.$output;
  867:         }
  868:         $msg .= &mt('Please contact the [_1] ([_2]) for assistance.',
  869:                 $contact_name,$contact_email).'<br /><hr />'.
  870:                 $sso_logout;
  871:         &Apache::lonnet::logthis("ERROR: failure type of '$checkfail' when performing username check to create account for authenticated user: $username, in domain $domain");
  872:     } else {
  873:         if ($courseid ne '') {
  874:             $output .= '<input type="hidden" name="courseid" value="'.$courseid.'" />';
  875:         }
  876:         $output .= '<input type="submit" name="newaccount" value="'.
  877:                    &mt('Create LON-CAPA account').'" /></form>';
  878:         if ($rowcount) {
  879:             if ($editable) {
  880:                 $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 />';
  881:             } else {
  882:                  $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 />';
  883:             }
  884:         } else {
  885:             $msg = '<br />'.&mt('Confirm that you wish to create an account.');
  886:         }
  887:         $msg .= $output;
  888:     }
  889:     return $msg;
  890: }
  891: 
  892: sub username_activation {
  893:     my ($r,$username,$domain,$domdesc,$lonhost,$courseid) = @_;
  894:     my $output;
  895:     my $error     = '<span class="LC_error">'.&mt('Error:').' ';
  896:     my $end       = '</span><br /><br />';
  897:     my $rtnlink   = '<a href="javascript:history.back();" />'.
  898:                     &mt('Return to previous page').'</a>'.
  899:                     &Apache::loncommon::end_page();
  900:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
  901:     my %data = &Apache::lonnet::tmpget($env{'form.authtoken'});
  902:     my $now = time;
  903:     my $earlyout;
  904:     my $timeout = 300;
  905:     if (keys(%data) == 0) {
  906:         $output = &mt('Sorry, your authentication has expired.');
  907:         $earlyout = 'fail';
  908:     }
  909:     if (($data{'time'} !~ /^\d+$/) ||
  910:         ($data{'domain'} ne $domain) || 
  911:         ($data{'username'} ne $username)) {
  912:         $earlyout = 'fail';
  913:         $output = &mt('The credentials you provided could not be verified.');   
  914:     } elsif ($now - $data{'time'} > $timeout) {
  915:         $earlyout = 'fail';
  916:         $output = &mt('Sorry, your authentication has expired.');
  917:     }
  918:     if ($earlyout ne '') {
  919:         $output .= '<br />'.&mt('Please [_1]start again[_2].','<a href="/adm/createaccount">','</a>');
  920:         return($earlyout,$output);
  921:     }
  922:     if ((($domdefaults{'auth_def'} =~/^krb(4|5)$/) && 
  923:          ($domdefaults{'auth_arg_def'} ne '')) || 
  924:         ($domdefaults{'auth_def'} eq 'localauth')) {
  925:         if ($env{'form.cid'} ne '') {
  926:             my ($result,$userchkmsg) = &check_id($username,$domain,$domdesc);
  927:             if ($result eq 'fail') {
  928:                 $output = $error.&mt('Invalid ID format').$end.
  929:                           $userchkmsg.$rtnlink;
  930:                 return ('fail',$output);
  931:             }
  932:         }
  933:         # Call modifyuser
  934:         my $result =
  935:             &Apache::lonnet::modifyuser($domain,$username,$env{'form.cid'},
  936:                           $domdefaults{'auth_def'},
  937:                           $domdefaults{'auth_arg_def'},$env{'form.cfirstname'},
  938:                           $env{'form.cmiddlename'},$env{'form.clastname'},
  939:                           $env{'form.cgeneration'},undef,undef,
  940:                           $env{'form.cpermanentemail'});
  941:         if ($result eq 'ok') {
  942:             my $delete = &Apache::lonnet::tmpdel($env{'form.authtoken'});
  943:             $output = &mt('A LON-CAPA account has been created for username: [_1] in domain: [_2].',$username,$domain);
  944:             my %form = &start_session($r,$username,$domain,$lonhost,$courseid);
  945:             my $nostart = 1;
  946:             return ('ok',$output,$nostart);
  947:         } else {
  948:             $output = &mt('Account creation failed for username: [_1] in domain: [_2].',$username,$domain).'<br /><span class="LC_error">'.&mt('Error: [_1]',$result).'</span>';
  949:             return ('fail',$output);
  950:         }
  951:     } else {
  952:         $output = &mt('User account creation is not available for the current default authentication type.')."\n";
  953:         return('fail',$output);
  954:     }
  955: }
  956: 
  957: sub check_id {
  958:     my ($username,$domain,$domdesc) = @_;
  959:     # Check ID format
  960:     my (%alerts,%rulematch,%inst_results,%curr_rules,%checkhash);
  961:     my %checks = ('id' => 1);
  962:     %{$checkhash{$username.':'.$domain}} = (
  963:                                             'newuser' => 1,
  964:                                             'id' => $env{'form.cid'},
  965:                                            );
  966:     &Apache::loncommon::user_rule_check(\%checkhash,\%checks,\%alerts,
  967:                                         \%rulematch,\%inst_results,\%curr_rules);
  968:     if (ref($alerts{'id'}) eq 'HASH') {
  969:         if (ref($alerts{'id'}{$domain}) eq 'HASH') {
  970:             if ($alerts{'id'}{$domain}{$env{'form.cid'}}) {
  971:                 my $userchkmsg;
  972:                 if (ref($curr_rules{$domain}) eq 'HASH') {
  973:                     $userchkmsg  =
  974:                         &Apache::loncommon::instrule_disallow_msg('id',
  975:                                                            $domdesc,1).
  976:                         &Apache::loncommon::user_rule_formats($domain,
  977:                               $domdesc,$curr_rules{$domain}{'id'},'id');
  978:                 }
  979:                 return ('fail',$userchkmsg);
  980:             }
  981:         }
  982:     }
  983:     return; 
  984: }
  985: 
  986: sub invalid_state {
  987:     my ($error,$domdesc,$contact_name,$contact_email,$msgtext) = @_;
  988:     my $msg = '<h3>'.&mt('Account creation unavailable').'</h3><span class="LC_error">';
  989:     if ($error eq 'baduseremail') {
  990:         $msg = &mt('The e-mail address you provided does not appear to be a valid address.');
  991:     } elsif ($error eq 'existinguser') {
  992:         $msg = &mt('The e-mail address you provided is already in use as a username in LON-CAPA at this institution.');
  993:     } elsif ($error eq 'userrules') {
  994:         $msg = &mt('Username rules for this LON-CAPA at this institution do not allow the e-mail address you provided to be used as a username.');
  995:     } elsif ($error eq 'userformat') {
  996:         $msg = &mt('The e-mail address you provided may not be used as a username at this LON-CAPA institution.');
  997:     } elsif ($error eq 'captcha') {
  998:         $msg = &mt('Validation of the code your entered failed.');
  999:     } elsif ($error eq 'noemails') {
 1000:         $msg = &mt('Creation of a new user account using an e-mail address as username is not permitted at this LON-CAPA institution.');
 1001:     }
 1002:     $msg .= '</span>';
 1003:     if ($msgtext) {
 1004:         $msg .= '<br />'.$msgtext;
 1005:     }
 1006:     $msg .= &linkto_email_help($contact_email,$domdesc);
 1007:     return $msg;
 1008: }
 1009: 
 1010: sub linkto_email_help {
 1011:     my ($contact_email,$domdesc) = @_;
 1012:     my $msg;
 1013:     if ($contact_email ne '') {
 1014:         my $escuri = &HTML::Entities::encode('/adm/createaccount','&<>"');
 1015:         $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 />';
 1016:     } else {
 1017:         $msg .= '<br />'.&mt('You may wish to send an e-mail to the server administrator: [_1] for [_2].',$Apache::lonnet::perlvar{'AdminEmail'},$domdesc).'<br />';
 1018:     }
 1019:     return $msg;
 1020: }
 1021: 
 1022: sub create_captcha {
 1023:     my ($output_dir,$db_dir) = @_;
 1024:     my %captcha_params = &captcha_settings();
 1025:     my $captcha = Authen::Captcha->new(
 1026:                                        output_folder => $captcha_params{'output_dir'},
 1027:                                        data_folder   => $captcha_params{'db_dir'},
 1028:                                       );
 1029:     my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
 1030:     my $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
 1031:                  &mt('Type in the letters/numbers shown below').'&nbsp;'.
 1032:                  '<input type="text" size="5" name="code" value="" /><br />'.
 1033:                  '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png">';
 1034:     return $output;
 1035: }
 1036: 
 1037: sub captcha_settings {
 1038:     my %captcha_params = ( 
 1039:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
 1040:                            www_output_dir => "/captchaspool",
 1041:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
 1042:                            numchars       => '5',
 1043:                          );
 1044:     return %captcha_params;
 1045: }
 1046: 
 1047: sub getkeys {
 1048:     my ($lkey,$ukey) = @_;
 1049:     my $lextkey=hex($lkey);
 1050:     if ($lextkey>2147483647) { $lextkey-=4294967296; }
 1051: 
 1052:     my $uextkey=hex($ukey);
 1053:     if ($uextkey>2147483647) { $uextkey-=4294967296; }
 1054:     return ($lextkey,$uextkey);
 1055: }
 1056: 
 1057: sub serverform {
 1058:     my ($logtoken,$lonhost,$mailtoken,$courseid,$context) = @_;
 1059:     my $phase = 'username_validation"';
 1060:     if ($context eq 'selfenroll') {
 1061:         $phase = 'selfenroll_login';
 1062:     }
 1063:     my $output .= <<ENDSERVERFORM;
 1064:   <form name="server" method="post" action="/adm/createaccount">
 1065:    <input type="hidden" name="logtoken" value="$logtoken" />
 1066:    <input type="hidden" name="token" value="$mailtoken" />
 1067:    <input type="hidden" name="serverid" value="$lonhost" />
 1068:    <input type="hidden" name="uname" value="" />
 1069:    <input type="hidden" name="upass" value="" />
 1070:    <input type="hidden" name="phase" value="$phase" />
 1071:    <input type="hidden" name="courseid" value="$courseid" />
 1072:   </form>
 1073: ENDSERVERFORM
 1074:     return $output;
 1075: }
 1076: 
 1077: sub process_credentials {
 1078:     my ($logtoken,$lonhost) = @_;
 1079:     my $tmpinfo=Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
 1080:     my ($retrieved,$output,$upass);
 1081:     if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
 1082:         $output = &mt('Information needed to verify your login information is missing, inaccessible or expired.')
 1083:                  .'<br />'.&mt('You may need to reload the previous page to obtain a new token.');
 1084:         return ($retrieved,$output,$upass); 
 1085:     } else {
 1086:         my $reply = &Apache::lonnet::reply('tmpdel:'.$logtoken,$lonhost);
 1087:         if ($reply eq 'ok') {
 1088:             $retrieved = 'ok';
 1089:         } else {
 1090:             $output = &mt('Session could not be opened.');
 1091:         }
 1092:     }
 1093:     my ($key,$caller)=split(/&/,$tmpinfo);
 1094:     if ($caller eq 'createaccount') {
 1095:         $upass = &Apache::lonpreferences::des_decrypt($key,$env{'form.upass'});
 1096:     } else {
 1097:         $output = &mt('Unable to retrieve your log-in information - unexpected context');
 1098:     }
 1099:     return ($retrieved,$output,$upass);
 1100: }
 1101: 
 1102: sub guest_format_check {
 1103:     my ($useremail,$domain,$cancreate,$settings) = @_;
 1104:     my ($login,$format_match,$format_msg,@user_rules);
 1105:     if (ref($settings) eq 'HASH') {
 1106:         if (ref($settings->{'email_rule'}) eq 'ARRAY') {
 1107:             push(@user_rules,@{$settings->{'email_rule'}});
 1108:         }
 1109:     }
 1110:     if (@user_rules > 0) {
 1111:         my %rule_check = 
 1112:             &Apache::lonnet::inst_rulecheck($domain,$useremail,undef,
 1113:                                             'selfcreate',\@user_rules);
 1114:         if (keys(%rule_check) > 0) {
 1115:             foreach my $item (keys(%rule_check)) {
 1116:                 if ($rule_check{$item}) {
 1117:                     $format_match = 1;   
 1118:                     last;
 1119:                 }
 1120:             }
 1121:         }
 1122:     }
 1123:     if ($format_match) {
 1124:         ($login) = ($useremail =~ /^([^\@]+)\@/);
 1125:         $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 />';
 1126:         if (ref($cancreate) eq 'ARRAY') {
 1127:             if (grep(/^login$/,@{$cancreate})) {
 1128:                 $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 />'; 
 1129:             }
 1130:         }
 1131:     }
 1132:     return $format_msg;
 1133: }
 1134: 
 1135: sub sso_logout_frag {
 1136:     my ($r,$domain) = @_;
 1137:     my $endsessionmsg;
 1138:     if (defined($r->dir_config('lonSSOUserLogoutMessageFile_'.$domain))) {
 1139:         my $msgfile = $r->dir_config('lonSSOUserLogoutMessageFile_'.$domain);
 1140:         if (-e $msgfile) {
 1141:             open(my $fh,"<$msgfile");
 1142:             $endsessionmsg = join('',<$fh>);
 1143:             close($fh);
 1144:         }
 1145:     } elsif (defined($r->dir_config('lonSSOUserLogoutMessageFile'))) {
 1146:         my $msgfile = $r->dir_config('lonSSOUserLogoutMessageFile');
 1147:         if (-e $msgfile) {     
 1148:             open(my $fh,"<$msgfile");
 1149:             $endsessionmsg = join('',<$fh>);
 1150:             close($fh);
 1151:         }
 1152:     }
 1153:     return $endsessionmsg;
 1154: }
 1155: 
 1156: 1;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>