[BACK]Return to createaccount.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/createaccount.pm between versions 1.50 and 1.60

version 1.50, 2012/05/17 18:05:42 version 1.60, 2014/02/20 01:00:33
Line 1 Line 1
 # The LearningOnline Network  # The LearningOnline Network
 # Allow visitors to create a user account with the username being either an   # Allow visitors to create a user account with the username being either an 
 # institutional log-in ID (institutional authentication required - localauth  # institutional log-in ID (institutional authentication required - localauth,
 #  or kerberos) or an e-mail address.  # kerberos, or SSO) or an e-mail address. Requests to use an e-mail address as
   # username may be processed automatically, or may be queued for approval.
 #  #
 # $Id$  # $Id$
 #  #
Line 39  use Apache::lonhtmlcommon; Line 40  use Apache::lonhtmlcommon;
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::lonauth;  use Apache::lonauth;
 use Apache::resetpw;  use Apache::resetpw;
 use Authen::Captcha;  
 use DynaLoader; # for Crypt::DES version  use DynaLoader; # for Crypt::DES version
 use Crypt::DES;  use Crypt::DES;
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
 use HTML::Entities;  use HTML::Entities;
   
 #TODO this module needs documentation  
   
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
Line 57  sub handler { Line 55  sub handler {
   
     my $domain;      my $domain;
   
     my $sso_username = $r->subprocess_env->get('REDIRECT_SSOUserUnknown');      my $sso_username = $r->subprocess_env->get('SSOUserUnknown');
     my $sso_domain = $r->subprocess_env->get('REDIRECT_SSOUserDomain');      my $sso_domain = $r->subprocess_env->get('SSOUserDomain');
   
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['token','courseid']);      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                               ['token','courseid','domain']);
     &Apache::lonacc::get_posted_cgi($r);      &Apache::lonacc::get_posted_cgi($r);
     &Apache::lonlocal::get_language_handle($r);      &Apache::lonlocal::get_language_handle($r);
   
     if ($sso_username ne '' && $sso_domain ne '') {      if ($sso_username ne '' && $sso_domain ne '') {
         $domain = $sso_domain;           $domain = $sso_domain; 
     } else {      } else {
         ($domain, undef) = Apache::lonnet::is_course($env{'form.courseid'});           ($domain, undef) = Apache::lonnet::is_course($env{'form.courseid'});
         $domain ||= &Apache::lonnet::default_login_domain();          unless ($domain) {
               if ($env{'form.phase'} =~ /^username_(activation|validation)$/) {
                   if (($env{'form.udom'} =~ /^$match_domain$/) &&
                       (&Apache::lonnet::domain($env{'form.udom'}) ne '')) {
                       $domain = $env{'form.udom'};
                   } else {
                       $domain = &Apache::lonnet::default_login_domain();
                   }
               } elsif (($env{'form.phase'} eq '') &&
                        ($env{'form.domain'} =~ /^$match_domain$/) &&
                        (&Apache::lonnet::domain($env{'form.domain'}) ne '')) {
                   $domain = $env{'form.domain'};
               } else {
                   $domain = &Apache::lonnet::default_login_domain();
               }
           }
     }      }
     my $domdesc = &Apache::lonnet::domain($domain,'description');      my $domdesc = &Apache::lonnet::domain($domain,'description');
     my $contact_name = &mt('LON-CAPA helpdesk');      my $contact_name = &mt('LON-CAPA helpdesk');
Line 88  sub handler { Line 102  sub handler {
         my $end_page =          my $end_page =
             &Apache::loncommon::end_page();              &Apache::loncommon::end_page();
         $r->print($start_page."\n".'<h2>'.&mt('You are already logged in').'</h2>'.          $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>'.&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);                    '</p><p><a href="/adm/loginproblems.html">'.&mt('Login problems?').'</a></p>'.$end_page);
         return OK;          return OK;
     }      }
Line 109  sub handler { Line 124  sub handler {
   
         my %domconfig =           my %domconfig = 
             &Apache::lonnet::get_dom('configuration',['usercreation'],$domain);              &Apache::lonnet::get_dom('configuration',['usercreation'],$domain);
         my ($cancreate,$statustocreate) =           my ($cancreate,$statustocreate,$emailusername) = 
             &get_creation_controls($domain,$domconfig{'usercreation'});              &get_creation_controls($domain,$domconfig{'usercreation'});
   
         my ($result,$output) =          my ($result,$output) =
             &username_validation($r,$env{'form.uname'},$domain,$domdesc,              &username_validation($r,$env{'form.uname'},$domain,$domdesc,
                                  $contact_name,$contact_email,$courseid,                                   $contact_name,$contact_email,$courseid,
                                  $lonhost,$statustocreate);                                   $lonhost,$statustocreate);
         if ($result eq 'existingaccount') {          if ($result eq 'redirect') {
               $r->internal_redirect('/adm/switchserver');
               return OK;
           } elsif ($result eq 'existingaccount') {
             $r->print($output);              $r->print($output);
             &print_footer($r);              &print_footer($r);
             return OK;              return OK;
         } else {          } else {
             $start_page =               $start_page = &Apache::loncommon::start_page($title,$js); 
                 &Apache::loncommon::start_page($title,$js);  
             &print_header($r,$start_page,$courseid);              &print_header($r,$start_page,$courseid);
             $r->print($output);              $r->print($output);
             &print_footer($r);                  &print_footer($r);    
             return OK;              return OK;
         }          }
     }      }
     $start_page =      $start_page = &Apache::loncommon::start_page($title,$js);
         &Apache::loncommon::start_page($title,$js);  
   
     my %domconfig =       my %domconfig = 
         &Apache::lonnet::get_dom('configuration',['usercreation'],$domain);          &Apache::lonnet::get_dom('configuration',['usercreation'],$domain);
     my ($cancreate,$statustocreate) = &get_creation_controls($domain,$domconfig{'usercreation'});      my ($cancreate,$statustocreate,$emailusername) = 
           &get_creation_controls($domain,$domconfig{'usercreation'});
     if (@{$cancreate} == 0) {      if (@{$cancreate} == 0) {
         &print_header($r,$start_page,$courseid);          &print_header($r,$start_page,$courseid);
         my $output = '<h3>'.&mt('Account creation unavailable').'</h3>'.          my $output = '<h3>'.&mt('Account creation unavailable').'</h3>'.
                      '<span class="LC_warning">'.                       '<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 />';                       &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);          $r->print($output);
         &print_footer($r);          &print_footer($r);
         return OK;          return OK;
Line 166  sub handler { Line 184  sub handler {
         return OK;          return OK;
     }      }
   
     my ($output,$nostart,$noend);      my ($output,$nostart,$noend,$redirect);
     my $token = $env{'form.token'};      my $token = $env{'form.token'};
     if ($token) {      if ($token) {
         ($output,$nostart,$noend) =           ($output,$nostart,$noend,$redirect) = 
             &process_mailtoken($r,$token,$contact_name,$contact_email,$domain,              &process_mailtoken($r,$token,$contact_name,$contact_email,$domain,
                                $domdesc,$lonhost,$include,$start_page);                                 $domdesc,$lonhost,$include,$start_page,$cancreate,
         if ($nostart) {                                 $domconfig{'usercreation'});
           if ($redirect) {
               $r->internal_redirect('/adm/switchserver');
               return OK;
           } elsif ($nostart) {
             if ($noend) {              if ($noend) {
                 return OK;                  return OK;
             } else {              } else {
Line 191  sub handler { Line 213  sub handler {
     if ($env{'form.phase'} eq 'username_activation') {      if ($env{'form.phase'} eq 'username_activation') {
         (my $result,$output,$nostart) =           (my $result,$output,$nostart) = 
             &username_activation($r,$env{'form.uname'},$domain,$domdesc,              &username_activation($r,$env{'form.uname'},$domain,$domdesc,
                                  $lonhost,$courseid);                                   $courseid);
         if ($result eq 'ok') {          if ($result eq 'redirect') {
               $r->internal_redirect('/adm/switchserver');
               return OK; 
           } elsif ($result eq 'ok') {
             if ($nostart) {              if ($nostart) {
                 return OK;                  return OK;
             }              }
Line 215  sub handler { Line 240  sub handler {
         }          }
     } elsif ($env{'form.create_with_email'}) {      } elsif ($env{'form.create_with_email'}) {
         &print_header($r,$start_page,$courseid);          &print_header($r,$start_page,$courseid);
         $output = &process_email_request($env{'form.useremail'},$domain,$domdesc,          $output = &process_email_request($env{'form.uname'},$domain,$domdesc,
                                          $contact_name,$contact_email,$cancreate,                                           $contact_name,$contact_email,$cancreate,
                                          $lonhost,$domconfig{'usercreation'},                                           $lonhost,$domconfig{'usercreation'},
                                          $courseid);                                           $emailusername,$courseid);
     } elsif (!$token) {      } elsif (!$token) {
         &print_header($r,$start_page,$courseid);          &print_header($r,$start_page,$courseid);
         my $now=time;          my $now=time;
           my $gotlondes;
         if (grep(/^login$/,@{$cancreate})) {          if (grep(/^login$/,@{$cancreate})) {
             my $jsh=Apache::File->new($include."/londes.js");              if (open(my $jsh,"<$include/londes.js")) {
             $r->print(<$jsh>);                  while(my $line = <$jsh>) {
             $r->print(&javascript_setforms($now));                      $r->print($line);
                   }
                   close($jsh);
                   $r->print(&javascript_setforms($now));
                   $gotlondes = 1;
               }
         }          }
         if (grep(/^email$/,@{$cancreate})) {          if (grep(/^email(|approval)$/,@{$cancreate})) {
             $r->print(&javascript_validmail());              $r->print(&javascript_validmail());
         }          }
         $output = &print_username_form($domain,$domdesc,$cancreate,$now,$lonhost,          $output = &print_username_form($r,$domain,$domdesc,$cancreate,$now,$lonhost,
                                        $courseid);                                         $include,$courseid,$gotlondes,$emailusername);
     }      }
     $r->print($output);      $r->print($output);
     &print_footer($r);      &print_footer($r);
Line 259  sub print_footer { Line 290  sub print_footer {
         $r->print('<form name="backupcrumbs" method="post" action="">'.          $r->print('<form name="backupcrumbs" method="post" action="">'.
                   &Apache::lonhtmlcommon::echo_form_input(['backto','logtoken',                    &Apache::lonhtmlcommon::echo_form_input(['backto','logtoken',
                       'token','serverid','uname','upass','phase','create_with_email',                        'token','serverid','uname','upass','phase','create_with_email',
                       'code','useremail','crypt','cfirstname','clastname',                        'code','crypt','cfirstname','clastname',
                         'recaptcha_challenge_field','recaptcha_response_field',
                       'cmiddlename','cgeneration','cpermanentemail','cid']).                        'cmiddlename','cgeneration','cpermanentemail','cid']).
                   '</form>');                    '</form>');
     }      }
Line 290  sub selfenroll_crumbs { Line 322  sub selfenroll_crumbs {
 }  }
   
 sub javascript_setforms {  sub javascript_setforms {
     my ($now) =  @_;      my ($now,$emailusername,$captcha) =  @_;
       my $setuserinfo; 
       if (ref($emailusername) eq 'HASH') {
           foreach my $key (sort(keys(%{$emailusername}))) {
               $setuserinfo .= '      server.elements.'.$key.'.value=client.elements.'.$key.'.value;'."\n";
           }
           if ($captcha eq 'original') {
               $setuserinfo .= '      server.elements.code.value=client.elements.code.value;'."\n".
                               '      server.elements.crypt.value=client.elements.crypt.value;'."\n";
           } elsif ($captcha eq 'recaptcha') {
               $setuserinfo .= '      server.elements.recaptcha_challenge_field.value=client.elements.recaptcha_challenge_field.value;'."\n".
                               '      server.elements.recaptcha_response_field.value=client.elements.recaptcha_response_field.value;'."\n";
           }
       }
     my $js = <<ENDSCRIPT;      my $js = <<ENDSCRIPT;
  <script type="text/javascript" language="JavaScript">  <script type="text/javascript">
     function send() {  // <![CDATA[
         this.document.server.elements.uname.value = this.document.client.elements.uname.value;      function send(one,two,context) {
         this.document.server.elements.udom.value = this.document.client.elements.udom.value;          var server;
         uextkey=this.document.client.elements.uextkey.value;          var client;
         lextkey=this.document.client.elements.lextkey.value;          if (document.forms[one]) {
         initkeys();              server = document.forms[one];
               if (document.forms[two]) {
         this.document.server.elements.upass.value                  client = document.forms[two];
             = crypted(this.document.client.elements.upass$now.value);                  server.elements.uname.value = client.elements.uname.value;
                   server.elements.udom.value = client.elements.udom.value;
         this.document.client.elements.uname.value='';  
         this.document.client.elements.upass$now.value='';                  uextkey=client.elements.uextkey.value;
                   lextkey=client.elements.lextkey.value;
         this.document.server.submit();                  initkeys();
   
                   server.elements.upass.value
                       = crypted(client.elements.upass$now.value);
   
                   client.elements.uname.value='';
                   client.elements.upass$now.value='';
                   if (context == 'email') {
                       $setuserinfo
                       client.elements.upasscheck$now.value='';
                   }
                   server.submit();
               }
           }
         return false;          return false;
     }      }
  </script>  // ]]>
   </script>
 ENDSCRIPT  ENDSCRIPT
     return $js;      return $js;
 }  }
   
 sub javascript_checkpass {  sub javascript_checkpass {
     my ($now) = @_;      my ($now,$context) = @_;
     my $nopass = &mt('You must enter a password.');      my $nopass = &mt('You must enter a password.');
     my $mismatchpass = &mt('The passwords you entered did not match.').'\\n'.      my $mismatchpass = &mt('The passwords you entered did not match.').'\\n'.
                        &mt('Please try again.');                          &mt('Please try again.'); 
     my $js = <<"ENDSCRIPT";      my $js = <<"ENDSCRIPT";
 <script type="text/javascript" language="JavaScript">  <script type="text/javascript">
     function checkpass() {  // <![CDATA[
         var upass = this.document.client.elements.upass$now.value;      function checkpass(one,two) {
         var upasscheck = this.document.client.elements.upasscheck$now.value;          var client;
         if (upass == '') {          if (document.forms[two]) {
             alert("$nopass");              client = document.forms[two]; 
             return false;              var upass = client.elements.upass$now.value;
         }              var upasscheck = client.elements.upasscheck$now.value;
         if (upass == upasscheck) {              if (upass == '') {
             this.document.client.elements.upasscheck$now.value='';                  alert("$nopass");
             send();                  return false;
             return false;              }
         } else {              if (upass == upasscheck) {
             alert("$mismatchpass");                  client.elements.upasscheck$now.value='';
             return false;                  if (validate_email(client)) {
                       send(one,two,'$context');
                   } 
                   return false;
               } else {
                   alert("$mismatchpass");
                   return false;
               }
         }          }
           return false; 
     }      }
   // ]]>
 </script>  </script>
 ENDSCRIPT  ENDSCRIPT
     return $js;      return $js;
Line 348  sub javascript_validmail { Line 416  sub javascript_validmail {
                notv  => 'is not a valid e-mail address',                 notv  => 'is not a valid e-mail address',
     );      );
     my $output =  "\n".'<script type="text/javascript">'."\n".      my $output =  "\n".'<script type="text/javascript">'."\n".
                     '// <![CDATA['."\n".
                   &Apache::lonhtmlcommon::javascript_valid_email()."\n";                    &Apache::lonhtmlcommon::javascript_valid_email()."\n";
     $output .= <<"ENDSCRIPT";      $output .= <<"ENDSCRIPT";
 function validate_email() {  function validate_email(client) {
     field = document.createaccount.useremail;      field = client.uname;
     if (validmail(field) == false) {      if (validmail(field) == false) {
         alert("$lt{'email'}: "+field.value+" $lt{'notv'}.");          alert("$lt{'email'}: "+field.value+" $lt{'notv'}.");
         return false;          return false;
Line 359  function validate_email() { Line 428  function validate_email() {
     return true;      return true;
 }  }
 ENDSCRIPT  ENDSCRIPT
     $output .= "\n".'</script>'."\n";      $output .= "\n".'// ]]>'."\n".'</script>'."\n";
     return $output;      return $output;
 }  }
   
 sub print_username_form {  sub print_username_form {
     my ($domain,$domdesc,$cancreate,$now,$lonhost,$courseid) = @_;      my ($r,$domain,$domdesc,$cancreate,$now,$lonhost,$include,$courseid,$gotlondes,$emailusername) = @_;
     my %lt = &Apache::lonlocal::texthash(      my %lt = &Apache::lonlocal::texthash (
                                          unam => 'username',                                           unam => 'username',
                                          udom => 'domain',                                           udom => 'domain',
                                          uemail => 'E-mail address in LON-CAPA',                                           uemail => 'E-mail address in LON-CAPA',
                                          proc => 'Proceed');                                           proc => 'Proceed',
                                            crac => 'Create account with a username provided by this institution',
                                            clca => 'Create LON-CAPA account',
                                            type => 'Type in your log-in ID and password to find out.',
                                            plse => 'Please provide a password for your new account.',
                                            info => 'Please provide user information and a password for your new account.',
                                            yopw => 'Your password will be encrypted when sent (and stored).',
                                            );
     my $output;      my $output;
     if (ref($cancreate) eq 'ARRAY') {      if (ref($cancreate) eq 'ARRAY') {
         if (grep(/^login$/,@{$cancreate})) {          if (grep(/^login$/,@{$cancreate})) {
             my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);              my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
             if ((($domdefaults{'auth_def'} =~/^krb/) && ($domdefaults{'auth_arg_def'} ne '')) || ($domdefaults{'auth_def'} eq 'localauth')) {              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>';                  $output = '<div class="LC_left_float"><h3>'.$lt{'crac'}.'</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 />').
                 $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 />';                             '<br /><br />'.
                 $output .= &login_box($now,$lonhost,$courseid,$submit_text,                             $lt{'type'}.
                              '<br /><br />';
                   $output .= &login_box($now,$lonhost,$courseid,$lt{'clca'},
                                       $domain,'createaccount').'</div>';                                        $domain,'createaccount').'</div>';
             }              }
         }          }
         if (grep(/^email$/,@{$cancreate})) {          if (grep(/^email(|approval)$/,@{$cancreate})) {
             $output .= '<div class="LC_left_float"><h3>'.&mt('Create account with an e-mail address as your username').'</h3>';              $output .= '<div class="LC_left_float"><h3>'.&mt('Create account with an e-mail address as your username').'</h3>';
             my $captchaform = &create_captcha();              my ($captchaform,$error,$captcha) = &Apache::loncommon::captcha_display('usercreation',$lonhost);
             if ($captchaform) {              if ($error) {
                 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';                  my $helpdesk = '/adm/helpdesk?origurl=%2fadm%2fcreateaccount';
                 if ($courseid ne '') {                  if ($courseid ne '') {
                     $helpdesk .= '&courseid='.$courseid;                      $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 .= '<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()">');
               } else {
                   if (grep(/^login$/,@{$cancreate})) {
                       $output .= &mt('If you do not have a log-in ID at your institution, [_1]provide your e-mail address to request a LON-CAPA account.','<br />').'<br /><br />'.
                                  $lt{'plse'}.'<br />'.
                                  $lt{'yopw'}.'<br />';
                   } else {
                       my $prompt = $lt{'plse'};
                       if (ref($emailusername) eq 'HASH') {
                           foreach my $key (keys(%{$emailusername})) {
                               if ($emailusername->{$key}) {
                                   $prompt = $lt{'info'};
                                   last;
                               }
                           }
                       }
                       $output .= $prompt.'<br />'.
                                  $lt{'yopw'}.'<br />';
                   }
                   $output .= &print_dataentry_form($r,$domain,$lonhost,$include,$now,$captchaform,
                                                    $courseid,$gotlondes,$emailusername,$captcha);
             }              }
             $output .= '</div>';              $output .= '</div>';
         }          }
Line 440  sub login_box { Line 512  sub login_box {
                                               createaccount => 'Log-in ID',                                                createaccount => 'Log-in ID',
                                               selfenroll    => 'Username',                                                selfenroll    => 'Username',
                                             );                                              );
     my ($lkey,$ukey) = &Apache::lonpreferences::des_keys();      my ($lkey,$ukey) = &Apache::loncommon::des_keys();
     my ($lextkey,$uextkey) = &getkeys($lkey,$ukey);      my ($lextkey,$uextkey) = &getkeys($lkey,$ukey);
     my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount:createaccount',      my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount:createaccount',
                                        $lonhost);                                         $lonhost);
     $output = &serverform($logtoken,$lonhost,undef,$courseid,$context);      $output = &serverform($logtoken,$lonhost,undef,$courseid,$context);
     my $unameform = '<input type="text" name="uname" size="20" value="" />';      my $unameform = '<input type="text" name="uname" size="20" value="" autocomplete="off" />';
     my $upassform = '<input type="password" name="upass'.$now.'" size="20" />';      my $upassform = '<input type="password" name="upass'.$now.'" size="20" autocomplete="off" />';
     $output .= '<form name="client" method="post" action="" onsubmit="return(send());">'."\n".      $output .= '<form name="client" method="post" action="" onsubmit="return(send('."'server','client'".'));">'."\n".
                &Apache::lonhtmlcommon::start_pick_box()."\n".                 &Apache::lonhtmlcommon::start_pick_box()."\n".
                &Apache::lonhtmlcommon::row_title($titles{$context},                 &Apache::lonhtmlcommon::row_title($titles{$context},
                                                  'LC_pick_box_title')."\n".                                                   'LC_pick_box_title')."\n".
Line 486  sub login_box { Line 558  sub login_box {
   
 sub process_email_request {  sub process_email_request {
     my ($useremail,$domain,$domdesc,$contact_name,$contact_email,$cancreate,      my ($useremail,$domain,$domdesc,$contact_name,$contact_email,$cancreate,
         $server,$settings,$courseid) = @_;          $server,$settings,$emailusername,$courseid) = @_;
     $useremail = $env{'form.useremail'};  
     my $output;      my $output;
     if (ref($cancreate) eq 'ARRAY') {      if (ref($cancreate) eq 'ARRAY') {
         if (!grep(/^email$/,@{$cancreate})) {          if (!grep(/^email(|approval)$/,@{$cancreate})) {
             $output = &invalid_state('noemails',$domdesc,              $output = &invalid_state('noemails',$domdesc,
                                      $contact_name,$contact_email);                                       $contact_name,$contact_email);
             return $output;              return $output;
Line 499  sub process_email_request { Line 570  sub process_email_request {
                                      $contact_name,$contact_email);                                       $contact_name,$contact_email);
             return $output;              return $output;
         } else {          } else {
               $useremail =~ s/^\s+|\s+$//g;
               my $uname=&LONCAPA::clean_username($useremail);
               if ($useremail ne $uname) {
                   $output = &invalid_state('badusername',$domdesc,
                                            $contact_name,$contact_email);
                   return $output;
               }
             my $uhome = &Apache::lonnet::homeserver($useremail,$domain);              my $uhome = &Apache::lonnet::homeserver($useremail,$domain);
             if ($uhome ne 'no_host') {              if ($uhome ne 'no_host') {
                 $output = &invalid_state('existinguser',$domdesc,                  $output = &invalid_state('existinguser',$domdesc,
                                          $contact_name,$contact_email);                                           $contact_name,$contact_email);
                 return $output;                  return $output;
             } else {              } else {
                 my $code = $env{'form.code'};                  my ($captcha_chk,$captcha_error) = &Apache::loncommon::captcha_response('usercreation',$server);
                 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) {                  if ($captcha_chk != 1) {
                     $output = &invalid_state('captcha',$domdesc,$contact_name,                      $output = &invalid_state('captcha',$domdesc,$contact_name,
                                              $contact_email,$captcha_hash{$captcha_chk});                                               $contact_email,$captcha_error);
                     return $output;                      return $output;
                 }                  }
                 my $uhome=&Apache::lonnet::homeserver($useremail,$domain);                  my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts);
                 if ($uhome eq 'no_host') {                  &call_rulecheck($useremail,$domain,\%alerts,\%rulematch,
                     my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts);                                  \%inst_results,\%curr_rules,\%got_rules,'username');
                     &call_rulecheck($useremail,$domain,\%alerts,\%rulematch,                  if (ref($alerts{'username'}) eq 'HASH') {
                                     \%inst_results,\%curr_rules,\%got_rules,'username');                      if (ref($alerts{'username'}{$domain}) eq 'HASH') {
                     if (ref($alerts{'username'}) eq 'HASH') {                          if ($alerts{'username'}{$domain}{$useremail}) {
                         if (ref($alerts{'username'}{$domain}) eq 'HASH') {                              $output = &invalid_state('userrules',$domdesc,
                             if ($alerts{'username'}{$domain}{$useremail}) {                                                       $contact_name,$contact_email);
                                 $output = &invalid_state('userrules',$domdesc,                              return $output;
                                                          $contact_name,$contact_email);  
                                 return $output;  
                             }  
                         }                          }
                     }                      }
                     my $format_msg =                   }
                         &guest_format_check($useremail,$domain,$cancreate,                  my $format_msg = 
                                             $settings);                      &guest_format_check($useremail,$domain,$cancreate,
                     if ($format_msg) {                                          $settings);
                         $output = &invalid_state('userformat',$domdesc,$contact_name,                  if ($format_msg) {
                                                  $contact_email,$format_msg);                      $output = &invalid_state('userformat',$domdesc,$contact_name,
                         return $output;                                               $contact_email,$format_msg);
                     }                      return $output;
                 }                  }
             }              }
         }          }
         $output = &send_token($domain,$useremail,$server,$domdesc,$contact_name,          $output = &send_token($domain,$useremail,$server,$domdesc,$contact_name,
                           $contact_email,$courseid);                                $contact_email,$courseid,$emailusername);
     }      }
     return $output;      return $output;
 }  }
Line 570  sub call_rulecheck { Line 632  sub call_rulecheck {
 }  }
   
 sub send_token {  sub send_token {
     my ($domain,$email,$server,$domdesc,$contact_name,$contact_email,$courseid) = @_;      my ($domain,$email,$server,$domdesc,$contact_name,$contact_email,$courseid,$emailusername) = @_;
     my $msg = '<h3>'.&mt('Account creation status').'</h3>'.      my $msg = '<h3>'.&mt('Account creation status').'</h3>'.
               &mt('Thank you for your request to create a new LON-CAPA account.').                &mt('Thank you for your request to create a new LON-CAPA account.').
               '<br /><br />';                '<br /><br />';
     my $now = time;      my $now = time;
     my %info = ('ip'         => $ENV{'REMOTE_ADDR'},      $env{'form.logtoken'} =~ s/(`)//g;
                 'time'       => $now,      if ($env{'form.logtoken'}) {
                 'domain'     => $domain,          my $logtoken = $env{'form.logtoken'};
                 'username'   => $email,          my $tmpinfo=Apache::lonnet::reply('tmpget:'.$logtoken,$server);
                 'courseid'   => $courseid);          if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
     my $token = &Apache::lonnet::tmpput(\%info,$server,'createaccount');              $msg = &mt('Information needed to process your request is missing, inaccessible or expired.')
     if ($token !~ /^error/ && $token ne 'no_such_host') {                    .'<br />'.&mt('Return to the previous page to try again.');
         my $esc_token = &escape($token);          } else {
         my $showtime = localtime(time);              my $reply = &Apache::lonnet::reply('tmpdel:'.$logtoken,$server);
         my $mailmsg = &mt('A request was submitted on [_1] for creation of a LON-CAPA account at the following institution: [_2].',$showtime,$domdesc).' '.              unless ($reply eq 'ok') {
              &mt('To complete this process please open a web browser and enter the following URL in the address/location box: [_1]',                  $msg .= &mt('Request could not be processed.');
                  &Apache::lonnet::absolute_url().'/adm/createaccount?token='.$esc_token);              }
         my $result = &Apache::resetpw::send_mail($domdesc,$email,$mailmsg,$contact_name,          }
                                                  $contact_email);          my %info = ('ip'         => $ENV{'REMOTE_ADDR'},
         if ($result eq 'ok') {                      'time'       => $now,
             $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>');                      'domain'     => $domain,
                       'username'   => $email,
                       'courseid'   => $courseid,
                       'upass'      => $env{'form.upass'},
                       'serverid'   => $env{'form.serverid'},
                       'tmpinfo'    => $tmpinfo);
   
           if (ref($emailusername) eq 'HASH') {
               foreach my $item (keys(%{$emailusername})) {
                   $info{$item} = $env{'form.'.$item};
                   $info{$item} =~ s/(`)//g;
               }
           }
           my $token = &Apache::lonnet::tmpput(\%info,$server,'createaccount');
           if ($token !~ /^error/ && $token ne 'no_such_host') {
               my $esc_token = &escape($token);
               my $showtime = localtime(time);
               my $mailmsg = &mt('A request was submitted on [_1] for creation of a LON-CAPA account at the following institution: [_2].',$showtime,$domdesc).' '.
                             &mt('To complete this process please open a web browser and enter the following URL in the address/location box: [_1]',
                             &Apache::lonnet::absolute_url().'/adm/createaccount?token='.$esc_token);
               my $result = &Apache::resetpw::send_mail($domdesc,$email,$mailmsg,$contact_name,
                                                        $contact_email);
               if ($result eq 'ok') {
                   $msg .= &mt('A message has been sent to the e-mail address you provided.').'<br />'.
                           &mt('The message includes the web address for the link you will use to complete the account creation process.').'<br />'.
                           &mt("The link included in the message will be valid for the next [_1]two[_2] hours.",'<b>','</b>');
               } else {
                   $msg .= '<span class="LC_error">'.
                           &mt('An error occurred when sending a message to the e-mail address you provided.').'</span><br />'.
                           ' '.&mt('Please contact the [_1] ([_2]) for assistance.',$contact_name,$contact_email);
               }
         } else {          } else {
             $msg .= '<span class="LC_error">'.              $msg .= '<span class="LC_error">'.
                     &mt('An error occurred when sending a message to the e-mail address you provided.').'</span><br />'.                      &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);                      ' '.&mt('Please contact the [_1] ([_2]) for assistance.',$contact_name,$contact_email);
         }          }
     } else {      } else {
         $msg .= '<span class="LC_error">'.          $msg .=  $msg = &mt('Information needed to process your request is missing, inaccessible or expired.')
                 &mt('An error occurred creating a token required for the account creation process.').'</span><br />'.                  .'<br />'.&mt('Return to the previous page to try again.');
                 ' '.&mt('Please contact the [_1] ([_2]) for assistance.',$contact_name,$contact_email);  
     }      }
     return $msg;      return $msg;
 }  }
   
 sub process_mailtoken {  sub process_mailtoken {
     my ($r,$token,$contact_name,$contact_email,$domain,$domdesc,$lonhost,      my ($r,$token,$contact_name,$contact_email,$domain,$domdesc,$lonhost,
         $include,$start_page) = @_;          $include,$start_page,$cancreate,$settings) = @_;
     my ($msg,$nostart,$noend);      my ($msg,$nostart,$noend,$redirect);
     my %data = &Apache::lonnet::tmpget($token);      my %data = &Apache::lonnet::tmpget($token);
     my $now = time;      my $now = time;
     if (keys(%data) == 0) {      if (keys(%data) == 0) {
         $msg = &mt('Sorry, the URL you provided to complete creation of a new LON-CAPA account was invalid.')          $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('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>');                 .' '.&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;          return $msg;
     }      }
     if (($data{'time'} =~ /^\d+$/) &&      if (($data{'time'} =~ /^\d+$/) &&
         ($data{'domain'} ne '') &&          ($data{'domain'} ne '') &&
         ($data{'username'}  =~ /^[^\@]+\@[^\@]+\.[^\@\.]+$/)) {          ($data{'username'}  =~ /^[^\@]+\@[^\@]+\.[^\@\.]+$/)) {
         if ($now - $data{'time'} < 7200) {          if ($now - $data{'time'} < 7200) {
             if ($env{'form.phase'} eq 'createaccount') {  # Check if request should be queued.
                 my ($result,$output) = &create_account($r,$domain,$lonhost,              if (ref($cancreate) eq 'ARRAY') {
                                                        $data{'username'},$domdesc);                  if (grep(/^email$/,@{$cancreate})) {
                 if ($result eq 'ok') {                      my ($result,$output,$uhome) = 
                     $msg = $output;                           &create_account($r,$domain,$domdesc,\%data);
                     my $shownow = &Apache::lonlocal::locallocaltime($now);                      if ($result eq 'ok') {
                     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";                          $msg = $output;
                     my $mailresult = &Apache::resetpw::send_mail($domdesc,$data{'email'},                          my $shownow = &Apache::lonlocal::locallocaltime($now);
                                                                  $mailmsg,$contact_name,                          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";
                                                                  $contact_email);                          my $mailresult = &Apache::resetpw::send_mail($domdesc,$data{'email'},
                     if ($mailresult eq 'ok') {                                                                       $mailmsg,$contact_name,
                         $msg .= &mt('An e-mail confirming creation of your new LON-CAPA account has been sent to [_1].',$data{'username'});                                                                       $contact_email);
                           if ($mailresult eq 'ok') {
                               $msg .= &mt('An e-mail confirming creation of your new LON-CAPA account has been sent to [_1].',$data{'username'});
                           } else {
                               $msg .= &mt('An error occurred when sending e-mail to [_1] confirming creation of your LON-CAPA account.',$data{'username'});
                           }
                           $redirect = &start_session($r,$data{'username'},$domain,$uhome,
                                                      $data{'courseid'},$token);
                           $nostart = 1;
                           $noend = 1;
                     } else {                      } else {
                         $msg .= &mt('An error occurred when sending e-mail to [_1] confirming creation of your LON-CAPA account.',$data{'username'});                          $msg .= &mt('A problem occurred when attempting to create your new LON-CAPA account.')
                                  .'<br />'.$output;
                           if (($contact_name ne '') && ($contact_email ne '')) {
                               $msg .= &mt('Please contact the [_1] ([_2]) for assistance.',$contact_name,$contact_email);
                           }
                     }                      }
                     &start_session($r, $data{'username'}, $domain, $lonhost,                      my $delete = &Apache::lonnet::tmpdel($token);
                         $data{'courseid'}, $token);                  } elsif (grep(/^emailapproval$/,@{$cancreate})) {
                     $nostart = 1;                      $msg = &store_request($domain,$data{'username'},'approval',\%data,$settings);
                     $noend = 1;                      my $delete = &Apache::lonnet::tmpdel($token);
                 } else {                  } else {
                     $msg .= &mt('A problem occurred when attempting to create your new LON-CAPA account.')                      $msg = &invalid_state('noemails',$domdesc,$contact_name,$contact_email);
                            .'<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 {              } 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 = &invalid_state('noemails',$domdesc,$contact_name,$contact_email);
                 $msg .= &print_dataentry_form($r,$domain,$lonhost,$include,$token,$now,$data{'username'},$start_page);  
                 $nostart = 1;  
             }              }
         } else {          } else {
             $msg = &mt('Sorry, the token generated when you requested creation of an account has expired.')              $msg = &mt('Sorry, the token generated when you requested creation of an account has expired.')
Line 659  sub process_mailtoken { Line 759  sub process_mailtoken {
         $msg .= &mt('Sorry, the URL generated when you requested creation of an account contained incomplete information.')          $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>');                 .' '.&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);      return ($msg,$nostart,$noend,$redirect);
 }  }
   
 sub start_session {  sub start_session {
     my ($r, $username, $domain, $lonhost, $courseid, $token) = @_;      my ($r,$username,$domain,$uhome,$courseid,$token) = @_;
   
     if ($r->dir_config('lonBalancer') eq 'yes') {      if ($r->dir_config('lonBalancer') eq 'yes') {
         Apache::lonauth::success($r, $username, $domain, $lonhost,          Apache::lonauth::success($r, $username, $domain, $uhome,
             'noredirect', undef, {});              'noredirect', undef, {});
   
         Apache::lonnet::tmpdel($token) if $token;          Apache::lonnet::tmpdel($token) if $token;
   
         $r->internal_redirect('/adm/switchserver');          return 'redirect';
     } else {      } else {
         $courseid = Apache::lonnet::is_course($courseid);           $courseid = Apache::lonnet::is_course($courseid); 
   
         Apache::lonauth::success($r, $username, $domain, $lonhost,          Apache::lonauth::success($r, $username, $domain, $uhome,
             ($courseid ? "/adm/selfenroll?courseid=$courseid" : '/adm/roles'),              ($courseid ? "/adm/selfenroll?courseid=$courseid" : '/adm/roles'),
             undef, {});               undef, {}); 
     }      }
Line 689  sub start_session { Line 789  sub start_session {
 # Stores token to store DES-key and stage during creation session  # Stores token to store DES-key and stage during creation session
 #  #
 sub print_dataentry_form {  sub print_dataentry_form {
     my ($r,$domain,$lonhost,$include,$mailtoken,$now,$username,$start_page) = @_;      my ($r,$domain,$lonhost,$include,$now,$captchaform,$courseid,$gotlondes,$emailusername,$captcha) = @_;
     my ($error,$output);      my ($error,$output);
     &print_header($r,$start_page);      unless ($gotlondes) {
     if (open(my $jsh,"<$include/londes.js")) {          if (open(my $jsh,"<$include/londes.js")) {
         while(my $line = <$jsh>) {              while(my $line = <$jsh>) {
             $r->print($line);                  $r->print($line);
         }              }
         close($jsh);              close($jsh);
         $output .= &javascript_setforms($now)."\n".&javascript_checkpass($now);              $output = &javascript_setforms($now,$emailusername,$captcha)."\n";
         my ($lkey,$ukey) = &Apache::lonpreferences::des_keys();              $gotlondes = 1;
           }
       }
       if ($gotlondes) {
           $output .= &javascript_checkpass($now,'email');
           my ($lkey,$ukey) = &Apache::loncommon::des_keys();
         my ($lextkey,$uextkey) = &getkeys($lkey,$ukey);          my ($lextkey,$uextkey) = &getkeys($lkey,$ukey);
         my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount:createaccount',          my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount:createaccount',
                                            $lonhost);                                             $lonhost);
         my $formtag = '<form name="server" method="post" target="_top" action="/adm/createaccount">';          $output .=
         my ($datatable,$rowcount) =              '<form name="createaccount" method="post" target="_top" action="/adm/createaccount">';
             &Apache::loncreateuser::personal_data_display($username,$domain,          if ($courseid ne '') {
                                                           'email','selfcreate');              $output .= '<input type="hidden" name="courseid" value="'.$courseid.'"/>'."\n";
         if ($rowcount) {          }
             $output .= '<div class="LC_left_float">'.$formtag.$datatable;          if (ref($emailusername) eq 'HASH') {
         } else {              foreach my $field (sort(keys(%{$emailusername}))) {
             $output .= $formtag;                  $output .= '<input type="hidden" name="'.$field.'" value="" />'."\n";
               }
           }
           if ($captcha eq 'original') {
               $output .= '
      <input type="hidden" name="crypt" value="" />
      <input type="hidden" name="code" value="" />
   ';
           } elsif ($captcha eq 'recaptcha') {
               $output .= '
      <input type="hidden" name="recaptcha_challenge_field" value="" />
      <input type="hidden" name="recaptcha_response_field" value="" />
   ';
         }          }
         $output .= <<"ENDSERVERFORM";          $output .= <<"ENDSERVERFORM";
    <input type="hidden" name="logtoken" value="$logtoken" />     <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="serverid" value="$lonhost" />
    <input type="hidden" name="uname" value="" />     <input type="hidden" name="uname" value="" />
    <input type="hidden" name="upass" value="" />     <input type="hidden" name="upass" value="" />
    <input type="hidden" name="udom" value="" />     <input type="hidden" name="udom" value="" />
    <input type="hidden" name="phase" value="createaccount" />     <input type="hidden" name="phase" value="createaccount" />
      <input type="hidden" name="create_with_email" value="1" />
   </form>    </form>
 ENDSERVERFORM  ENDSERVERFORM
           my $beginclientform = '<form name="newemail" method="post" action="" '.
                                 'onsubmit="return checkpass('."'createaccount','newemail'".');">'."\n";
           my $endclientform = '<input type="hidden" name="udom" value="'.$domain.'" />'."\n".
                               '<input type="hidden" name="lextkey" value="'.$lextkey.'" />'."\n".
                               '<input type="hidden" name="uextkey" value="'.$uextkey.'" />'."\n".
                               '</form>';
           my ($datatable,$rowcount) =
               &Apache::loncreateuser::personal_data_display('',$domain,'email','selfcreate',
                                                             '','',$now,$captchaform,
                                                             $emailusername);
         if ($rowcount) {          if ($rowcount) {
             $output .= '</div>'.              $output .= '<div class="LC_left_float">'.$beginclientform.$datatable.$endclientform;
                        '<div class="LC_left_float">';          } else {
               $output .= $beginclientform.$endclientform;
         }          }
         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" action="" '.  
                    '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) {          if ($rowcount) {
             $output .= '</div>'."\n".              $output .= '</div>'."\n".
                        '<div class="LC_clear_float_footer"></div>'."\n";                         '<div class="LC_clear_float_footer"></div>'."\n";
Line 773  ENDSERVERFORM Line 869  ENDSERVERFORM
   
 sub get_creation_controls {  sub get_creation_controls {
     my ($domain,$usercreation) = @_;      my ($domain,$usercreation) = @_;
     my (@cancreate,@statustocreate);      my (@cancreate,@statustocreate,$emailusername);
     if (ref($usercreation) eq 'HASH') {      if (ref($usercreation) eq 'HASH') {
         if (ref($usercreation->{'cancreate'}) eq 'HASH') {          if (ref($usercreation->{'cancreate'}) eq 'HASH') {
             if (ref($usercreation->{'cancreate'}{'statustocreate'}) eq 'ARRAY') {              if (ref($usercreation->{'cancreate'}{'statustocreate'}) eq 'ARRAY') {
Line 803  sub get_creation_controls { Line 899  sub get_creation_controls {
                      ($usercreation->{'cancreate'}{'selfcreate'} ne '')) {                       ($usercreation->{'cancreate'}{'selfcreate'} ne '')) {
                 @cancreate = ($usercreation->{'cancreate'}{'selfcreate'});                  @cancreate = ($usercreation->{'cancreate'}{'selfcreate'});
             }              }
               if (ref($usercreation->{'cancreate'}{'emailusername'}) eq 'HASH') {
                   $emailusername = $usercreation->{'cancreate'}{'emailusername'};
               } else {
                   $emailusername =  {'lastname' => '1', 'firstname' => 1, };
               }
         }          }
     }      }
     return (\@cancreate,\@statustocreate);      return (\@cancreate,\@statustocreate,$emailusername);
 }  }
   
 sub create_account {  sub create_account {
     my ($r,$domain,$lonhost,$username,$domdesc) = @_;      my ($r,$domain,$domdesc,$dataref) = @_;
 # Get the token info      my $error    = '<span class="LC_error">'.&mt('Error:').' ';
     my ($retrieved,$output,$upass) = &process_credentials($env{'form.logtoken'},      my $end      = '</span><br /><br />';
                                                           $env{'form.serverid'});       my $rtnlink  = '<a href="javascript:history.back();">'.
 # $retrieved is 'ok' if things worked  
 # $output is user error output  
 # $upass is the decrypted password  
     # 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>'.                      &mt('Return to previous page').'</a>'.
                     &Apache::loncommon::end_page();                      &Apache::loncommon::end_page();
     if ($retrieved eq 'ok') {      my $output;
         if ($env{'form.courseid'} ne '') {      if (ref($dataref) eq 'HASH') {
 # See if we are allowed to use this username per domain rules (number of characters, etc)          my ($username,$encpass,$serverid,$courseid,$id,$firstname,$middlename,$lastname,
             my ($result,$userchkmsg) = &check_id($username,$domain,$domdesc);              $generation);
             if ($result eq 'fail') {          $username   = $dataref->{'username'};
                 $output = $error.&mt('Invalid ID format').$end.          $encpass    = $dataref->{'upass'};
                           $userchkmsg.$rtnlink;          $serverid   = $dataref->{'serverid'};
                 return ('fail',$output);          $courseid   = $dataref->{'courseid'};
           $id         = $dataref->{'id'};
           $firstname  = $dataref->{'firstname'};
           $middlename = $dataref->{'middlename'};
           $lastname   = $dataref->{'lastname'};
           $generation = $dataref->{'generation'};
          
           my $currhome = &Apache::lonnet::homeserver($username,$domain);
           unless ($currhome eq 'no_host') {
               $output = &mt('User account requested for username: [_1] in domain: [_2] already exists.',$username,$domain);
               return ('fail',$error.$output.$end.$rtnlink);
           }
   
   # Split the logtoken to retrieve the DES key and decrypt the encypted password
   
           my ($key,$caller)=split(/&/,$dataref->{'tmpinfo'});
           if ($caller eq 'createaccount') {
               my $upass = &Apache::loncommon::des_decrypt($key,$encpass);
   
   # See if we are allowed to use the proposed student/employee ID,
   # as per domain rules; if not, student/employee will be left blank.
   
               if ($id ne '') {
                   my ($result,$userchkmsg) = &check_id($username,$domain,$id,$domdesc,'email');
                   if ($result eq 'fail') {
                       $output = $error.&mt('Invalid ID format').$end.
                                 $userchkmsg;
                       undef($id);
                   }
             }              }
   
   # Create an internally authenticated account with password $upass
   # if the user account does not already exist.
   # Assign student/employee id, first name, last name, etc.
   
               my $result =
                   &Apache::lonnet::modifyuser($domain,$username,$id,
                                               'internal',$upass,$firstname,$middlename,
                                               $lastname,$generation,undef,undef,$username);
               $output = &mt('Generating user: [_1]',$result);
   
   # Now that the user account exists, retrieve the homeserver, and include it in the output.
   
               my $uhome = &Apache::lonnet::homeserver($username,$domain);
               $output .= '<br />'.&mt('Home server: [_1]',$uhome).' '.
                          &Apache::lonnet::hostname($uhome).'<br /><br />';
               return ('ok',$output,$uhome);
           } else {
               $output = &mt('Unable to retrieve your account creation information - unexpected context');
               undef($encpass);
               return ('fail',$error.$output.$end.$rtnlink);
         }          }
     } else {      } else {
           $output = &mt('Unable to retrieve information for your account request.');
         return ('fail',$error.$output.$end.$rtnlink);          return ('fail',$error.$output.$end.$rtnlink);
     }      }
     # Yes! We can do this. Valid token, valid username format  
     # Create an internally authenticated account with password $upass   
     # if the account does not exist yet  
     # Assign student/staff number $env{'form.cid'}, first name, last name, etc  
     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);  
     # Now that the user exists, we can have a homeserver  
     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 {  sub username_validation {
     my ($r,$username,$domain,$domdesc,$contact_name,$contact_email,$courseid,      my ($r,$username,$domain,$domdesc,$contact_name,$contact_email,$courseid,
         $lonhost,$statustocreate) = @_;          $lonhost,$statustocreate) = @_;
   # $r: request object
 # $username,$domain: for the user who needs to be validated  # $username,$domain: for the user who needs to be validated
 # $domdesc: full name of the domain (for error messages)  # $domdesc: full name of the domain (for error messages)
 # $contact_name, $contact_email: name and email for user assistance (for error messages in &username_check  # $contact_name, $contact_email: name and email for user assistance (for error messages in &username_check)
 # $courseid: ID of the course that the user should be validated for, goes into start_session  # $courseid: ID of the course if user came to username_validation via self-enroll link,
   #             passed to start_session()
   # $lonhost: LON-CAPA lonHostID
 # $statustocreate: -> inststatus in username_check ('faculty', 'staff', 'student', ...)  # $statustocreate: -> inststatus in username_check ('faculty', 'staff', 'student', ...)
     
     my ($retrieved,$output,$upass);  #
   # Sanitize incoming username and domain
   #
     $username= &LONCAPA::clean_username($username);      $username= &LONCAPA::clean_username($username);
     $domain = &LONCAPA::clean_domain($domain);      $domain = &LONCAPA::clean_domain($domain);
   
   #
   # Check if LON-CAPA account already exists for $username:$domain
   #
     my $uhome = &Apache::lonnet::homeserver($username,$domain);      my $uhome = &Apache::lonnet::homeserver($username,$domain);
   
     ($retrieved,$output,$upass) = &process_credentials($env{'form.logtoken'},      my $output;
                                                        $env{'form.serverid'});  
     if ($retrieved ne 'ok') {  # Retrieve DES key from server using logtoken
    
       my $tmpinfo=Apache::lonnet::reply('tmpget:'.$env{'form.logtoken'},$env{'form.serverid'});
       if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
           $output = &mt('Information needed to verify your login information is missing, inaccessible or expired.')
                    .'<br />'.&mt('You may need to reload the previous page to obtain a new token.');
           return ('fail',$output);
       } else {
           my $reply = &Apache::lonnet::reply('tmpdel:'.$env{'form.logtoken'},$env{'form.serverid'});
           unless ($reply eq 'ok') {
               $output = &mt('Session could not be opened.');
               return ('fail',$output); 
           }
       }
   
   # Split the logtoken to retrieve the DES key and decrypt the encypted password
   
       my ($key,$caller)=split(/&/,$tmpinfo);
       my $upass;
       if ($caller eq 'createaccount') {
           $upass = &Apache::loncommon::des_decrypt($key,$env{'form.upass'});
       } else {
           $output = &mt('Unable to retrieve your log-in information - unexpected context');
         return ('fail',$output);          return ('fail',$output);
     }      }
     if ($uhome ne 'no_host') {      if ($uhome ne 'no_host') {
         my $result = &Apache::lonnet::authenticate($username,$upass,$domain);          my $result = &Apache::lonnet::authenticate($username,$upass,$domain);
         if ($result ne 'no_host') {           if ($result ne 'no_host') { 
             &start_session($r, $username, $domain, $lonhost, $courseid);              my $redirect = &start_session($r,$username,$domain,$uhome,$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.');              if ($redirect) {
                   return ($redirect);
               }
               $output = '<br /><br />'.
                         &mt('A LON-CAPA account already exists for username [_1] at this institution ([_2]).',
                             '<tt>'.$username.'</tt>',$domdesc).'<br />'.
                         &mt('The password entered was also correct so you have been logged in.');
             return ('existingaccount',$output);              return ('existingaccount',$output);
         } else {          } else {
             $output = &login_failure_msg($courseid);              $output = &login_failure_msg($courseid);
Line 885  sub username_validation { Line 1050  sub username_validation {
         my $primlibserv = &Apache::lonnet::domain($domain,'primary');          my $primlibserv = &Apache::lonnet::domain($domain,'primary');
         my $authok;          my $authok;
         my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);          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')) {          if ((($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) || 
                ($domdefaults{'auth_def'} eq 'localauth')) {
             my $checkdefauth = 1;              my $checkdefauth = 1;
             $authok =               $authok = 
                 &Apache::lonnet::reply("encrypt:auth:$domain:$username:$upass:$checkdefauth",$primlibserv);                  &Apache::lonnet::reply("encrypt:auth:$domain:$username:$upass:$checkdefauth",$primlibserv);
Line 1029  sub username_check { Line 1195  sub username_check {
 }  }
   
 sub username_activation {  sub username_activation {
     my ($r,$username,$domain,$domdesc,$lonhost,$courseid) = @_;      my ($r,$username,$domain,$domdesc,$courseid) = @_;
     my $output;      my $output;
     my $error     = '<span class="LC_error">'.&mt('Error:').' ';      my $error     = '<span class="LC_error">'.&mt('Error:').' ';
     my $end       = '</span><br /><br />';      my $end       = '</span><br /><br />';
     my $rtnlink   = '<a href="javascript:history.back();" />'.      my $rtnlink   = '<a href="javascript:history.back();">'.
                     &mt('Return to previous page').'</a>'.                      &mt('Return to previous page').'</a>'.
                     &Apache::loncommon::end_page();                      &Apache::loncommon::end_page();
     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);      my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
Line 1055  sub username_activation { Line 1221  sub username_activation {
         $output = &mt('Sorry, your authentication has expired.');          $output = &mt('Sorry, your authentication has expired.');
     }      }
     if ($earlyout ne '') {      if ($earlyout ne '') {
         $output .= '<br />'.&mt('Please [_1]start again[_2].','<a href="/adm/createaccount">','</a>');          my $link = '/adm/createaccount';
           if (&Apache::lonnet::domain($domain) ne '') {
               $link .= "?domain=$domain"; 
           }
           $output .= '<br />'.&mt('Please [_1]start again[_2].',
                                   '<a href="'.$link.'">','</a>');
         return($earlyout,$output);          return($earlyout,$output);
     }      }
     if ((($domdefaults{'auth_def'} =~/^krb(4|5)$/) &&       if ((($domdefaults{'auth_def'} =~/^krb(4|5)$/) && 
          ($domdefaults{'auth_arg_def'} ne '')) ||            ($domdefaults{'auth_arg_def'} ne '')) || 
         ($domdefaults{'auth_def'} eq 'localauth')) {          ($domdefaults{'auth_def'} eq 'localauth')) {
         if ($env{'form.courseid'} ne '') {          if ($env{'form.courseid'} ne '') {
             my ($result,$userchkmsg) = &check_id($username,$domain,$domdesc);              my $id = $env{'form.cid'}; 
               my ($result,$userchkmsg) = &check_id($username,$domain,$id,$domdesc,'institutional');
             if ($result eq 'fail') {              if ($result eq 'fail') {
                 $output = $error.&mt('Invalid ID format').$end.                  $output = $error.&mt('Invalid ID format').$end.
                           $userchkmsg.$rtnlink;                            $userchkmsg.$rtnlink;
Line 1099  sub username_activation { Line 1271  sub username_activation {
         if ($result eq 'ok') {          if ($result eq 'ok') {
             my $delete = &Apache::lonnet::tmpdel($env{'form.authtoken'});              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);              $output = &mt('A LON-CAPA account has been created for username: [_1] in domain: [_2].',$username,$domain);
             &start_session($r, $username, $domain, $lonhost, $courseid);              my $uhome=&Apache::lonnet::homeserver($username,$domain,'true');
             my $nostart = 1;              my $nostart = 1;
             return ('ok',$output,$nostart);              my $response = 'ok';
               my $redirect = &start_session($r,$username,$domain,$uhome,$courseid);
               if ($redirect) {
                   $response = $redirect;
               }
               return ($response,$output,$nostart);
         } else {          } else {
             $output = &mt('Account creation failed for username: [_1] in domain: [_2].',$username,$domain).'<br /><span class="LC_error">'.&mt('Error: [_1]',$result).'</span>';              $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);              return ('fail',$output);
Line 1113  sub username_activation { Line 1290  sub username_activation {
 }  }
   
 sub check_id {  sub check_id {
     my ($username,$domain,$domdesc) = @_;      my ($username,$domain,$id,$domdesc,$usernametype) = @_;
     # Check ID format      # Check student/employee ID format
     # Is $username in an okay format for $domain       # Is proposed student/employee ID acceptable according to domain's rules.  
     # (right number of characters, special characters, etc - follow domain rules)?  
     # $domdesc is just used for user error messages      # $domdesc is just used for user error messages
     my (%alerts,%rulematch,%inst_results,%curr_rules,%checkhash);      my (%alerts,%rulematch,%inst_results,%curr_rules,%checkhash);
     my %checks = ('id' => 1);      my %checks = ('id' => 1);
     %{$checkhash{$username.':'.$domain}} = (      %{$checkhash{$username.':'.$domain}} = (
                                             'newuser' => 1,                                              'newuser' => 1,
                                             'id' => $env{'form.cid'},                                              'id' => $id,
                                            );                                             );
     &Apache::loncommon::user_rule_check(\%checkhash,\%checks,\%alerts,      &Apache::loncommon::user_rule_check(\%checkhash,\%checks,\%alerts,
                                         \%rulematch,\%inst_results,\%curr_rules);                                          \%rulematch,\%inst_results,\%curr_rules);
Line 1131  sub check_id { Line 1307  sub check_id {
             if ($alerts{'id'}{$domain}{$env{'form.cid'}}) {              if ($alerts{'id'}{$domain}{$env{'form.cid'}}) {
                 my $userchkmsg;                  my $userchkmsg;
                 if (ref($curr_rules{$domain}) eq 'HASH') {                  if (ref($curr_rules{$domain}) eq 'HASH') {
                     $userchkmsg  =                      if ($usernametype eq 'email') {
                         &Apache::loncommon::instrule_disallow_msg('id',                          $userchkmsg = &mt('A student/employee ID has not been set because the value suggested matched the format used for institutional users in the domain, and you are using an e-mail address as username, not an institutional username.');
                                                            $domdesc,1).                      } else {
                         &Apache::loncommon::user_rule_formats($domain,                          $userchkmsg =
                               $domdesc,$curr_rules{$domain}{'id'},'id');                              &Apache::loncommon::instrule_disallow_msg('id',
                                                                         $domdesc,1).
                               &Apache::loncommon::user_rule_formats($domain,
                                   $domdesc,$curr_rules{$domain}{'id'},'id');
                       }
                 }                  }
                 return ('fail',$userchkmsg);                  return ('fail',$userchkmsg);
             }              }
Line 1149  sub invalid_state { Line 1329  sub invalid_state {
     my $msg = '<h3>'.&mt('Account creation unavailable').'</h3><span class="LC_error">';      my $msg = '<h3>'.&mt('Account creation unavailable').'</h3><span class="LC_error">';
     if ($error eq 'baduseremail') {      if ($error eq 'baduseremail') {
         $msg .= &mt('The e-mail address you provided does not appear to be a valid address.');          $msg .= &mt('The e-mail address you provided does not appear to be a valid address.');
       } elsif ($error eq 'badusername') {
           $msg .= &mt('The e-mail address you provided contains characters which prevent its use as a username in LON-CAPA.');
     } elsif ($error eq 'existinguser') {      } 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.');          $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') {      } elsif ($error eq 'userrules') {
Line 1181  sub linkto_email_help { Line 1363  sub linkto_email_help {
         }          }
         $msg .= '<br />'.&mt('You may wish to contact the [_1]LON-CAPA helpdesk[_2] for [_3].','<a href="'.$href.'">','</a>',$domdesc).'<br />';          $msg .= '<br />'.&mt('You may wish to contact the [_1]LON-CAPA helpdesk[_2] for [_3].','<a href="'.$href.'">','</a>',$domdesc).'<br />';
     } else {      } 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 />';          $msg .= '<br />'.&mt('You may wish to send an e-mail to the server administrator: [_1] for [_2].',$Apache::lonnet::perlvar{'AdmEMail'},$domdesc).'<br />';
     }      }
     return $msg;      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 {  sub getkeys {
     my ($lkey,$ukey) = @_;      my ($lkey,$ukey) = @_;
     my $lextkey=hex($lkey);      my $lextkey=hex($lkey);
Line 1255  ENDSERVERFORM Line 1404  ENDSERVERFORM
     return $output;      return $output;
 }  }
   
 sub process_credentials {  sub store_request {
 #      my ($dom,$username,$val,$dataref,$settings) = @_;
 # Fetches the information from the logtoken via tmpget      my $output;
 # Token contains the DES-key and the stage of the process (would only be "createaccount")      my $domconfiguser = &Apache::lonnet::get_domainconfiguser($dom);
 # $lonhost in this routine is *not* necessarily the machine that this runs on,      my $key = &escape($username);
 # but $env{'form.serverid'}, the machine that issued the token.       my $now = time();
 #      if (&Apache::lonnet::put('usernamequeue', { $key.'_'.$val => $now },
     my ($logtoken,$lonhost) = @_;                               $dom,$domconfiguser) eq 'ok') {
     my $tmpinfo=Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);          if (ref($dataref) eq 'HASH') {
     my ($retrieved,$output,$upass);              my $logtoken = $dataref->{'tmpinfo'};
     if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {              my $serverid = $dataref->{'serverid'}; 
         $output = &mt('Information needed to verify your login information is missing, inaccessible or expired.')              if ($logtoken && $serverid) {
                  .'<br />'.&mt('You may need to reload the previous page to obtain a new token.');                  my $tmpinfo=Apache::lonnet::reply('tmpget:'.$logtoken,$serverid);
         return ($retrieved,$output,$upass);                   unless (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
     } else {                      my $reply = &Apache::lonnet::reply('tmpdel:'.$logtoken,$serverid);
         my $reply = &Apache::lonnet::reply('tmpdel:'.$logtoken,$lonhost);                      if ($reply eq 'ok') {
         if ($reply eq 'ok') {                          my ($key,$caller)=split(/&/,$tmpinfo);
             $retrieved = 'ok';                          $dataref->{'key'} = $key;
         } else {                          undef($dataref->{'tmpinfo'});
             $output = &mt('Session could not be opened.');                          undef($dataref->{'serverid'});
                       }
                   }
               }
         }          }
     }          my %userrequest = ( $username => $dataref );
     my ($key,$caller)=split(/&/,$tmpinfo);          $userrequest{$username}{timestamp} = $now;
     if ($caller eq 'createaccount') {          $userrequest{$username}{status} = $val;
         $upass = &Apache::lonpreferences::des_decrypt($key,$env{'form.upass'});          my $notifylist;
           if (ref($settings) eq 'HASH') {
               if (ref($settings->{'cancreate'}) eq 'HASH') {
                   if (ref($settings->{'cancreate'}{'notify'}) eq 'HASH') {
                       my $notifylist = $settings->{'cancreate'}{'notify'}{'approval'};
                       if ($notifylist) {
                           my $sender = $domconfiguser.':'.$dom;
                           my $domdesc = &Apache::lonnet::domain($dom,'description');
                           my $fullname;
                           if (ref($dataref) eq 'HASH') {
                               if ($dataref->{'firstname'}) {
                                   $fullname = $dataref->{'firstname'};
                               }
                               if ($dataref->{'lastname'}) {
                                   $fullname .= ' '.$dataref->{'lastname'};
                               }
                               $fullname =~ s/^\s+|\s+$//g; 
                           }
                           &Apache::loncoursequeueadmin::send_selfserve_notification($notifylist,
                                                        "$fullname ($username)",
                                                        undef,$domdesc,$now,'usernamereq',$sender);
                       }
                   }
               }
           }
           my $userresult =
               &Apache::lonnet::put('nohist_requestedusernames',\%userrequest,$dom,$domconfiguser);
           $output = '<p class="LC_info">'.
                     &mt('Your request for a LON-CAPA account has been submitted for approval.').
                     '</p>'.
                     '<p class="LC_info">'.
                     &mt('An e-mail will be sent to [_1] when your request has been reviewed by an administrator and action has been taken.',$username).
                     '</p>';
     } else {      } else {
         $output = &mt('Unable to retrieve your log-in information - unexpected context');          $output = '<span class="LC_error">'.
                     &mt('An error occurred when attempting to save your request for a LON-CAPA account.');
                     '</span>';
     }      }
 # $retrieved is 'ok' if retrieved okay      return $output;
 # $output is screen output for the user  
 # $upass is $env{'form.upass'}, decrypted with the DES-key, if stage was 'createaccount'  
   
     return ($retrieved,$output,$upass);  
 }  }
   
 sub guest_format_check {  sub guest_format_check {
Line 1313  sub guest_format_check { Line 1495  sub guest_format_check {
     }      }
     if ($format_match) {      if ($format_match) {
         ($login) = ($useremail =~ /^([^\@]+)\@/);          ($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 />';          $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 (ref($cancreate) eq 'ARRAY') {
             if (grep(/^login$/,@{$cancreate})) {              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 />';                   $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 />'; 
Removed from v.1.50  
changed lines
  Added in v.1.60

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.