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

Diff for /loncom/interface/createaccount.pm between versions 1.49 and 1.56

version 1.49, 2012/05/17 17:41:48 version 1.56, 2013/06/05 12:46:39
Line 39  use Apache::lonhtmlcommon; Line 39  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);
Line 60  sub handler { Line 59  sub handler {
     my $sso_username = $r->subprocess_env->get('REDIRECT_SSOUserUnknown');      my $sso_username = $r->subprocess_env->get('REDIRECT_SSOUserUnknown');
     my $sso_domain = $r->subprocess_env->get('REDIRECT_SSOUserDomain');      my $sso_domain = $r->subprocess_env->get('REDIRECT_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 121  sub handler { Line 136  sub handler {
             &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);
Line 191  sub handler { Line 204  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 'ok') {
             if ($nostart) {              if ($nostart) {
                 return OK;                  return OK;
Line 384  sub print_username_form { Line 397  sub print_username_form {
         }          }
         if (grep(/^email$/,@{$cancreate})) {          if (grep(/^email$/,@{$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) = &Apache::loncommon::captcha_display('usercreation',$lonhost);
             if ($captchaform) {              if ($error) {
                   my $helpdesk = '/adm/helpdesk?origurl=%2fadm%2fcreateaccount';
                   if ($courseid ne '') {
                       $helpdesk .= '&courseid='.$courseid;
                   }
                   $output .= '<span class="LC_error">'.&mt('An error occurred generating the validation code[_1] required for 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 {
                 my $submit_text = &mt('Request LON-CAPA account');                  my $submit_text = &mt('Request LON-CAPA account');
                 my $emailform = '<input type="text" name="useremail" size="25" value="" />';                  my $emailform = '<input type="text" name="useremail" size="25" value="" />';
                 if (grep(/^login$/,@{$cancreate})) {                  if (grep(/^login$/,@{$cancreate})) {
Line 396  sub print_username_form { Line 415  sub print_username_form {
                 $output .=  '<form name="createaccount" method="post" onsubmit="return validate_email()" action="/adm/createaccount">'.                  $output .=  '<form name="createaccount" method="post" onsubmit="return validate_email()" action="/adm/createaccount">'.
                             &Apache::lonhtmlcommon::start_pick_box()."\n".                              &Apache::lonhtmlcommon::start_pick_box()."\n".
                             &Apache::lonhtmlcommon::row_title(&mt('E-mail address'),                              &Apache::lonhtmlcommon::row_title(&mt('E-mail address'),
                                                              'LC_pick_box_title')."\n".                                                                'LC_pick_box_title')."\n".
                             $emailform."\n".                              $emailform."\n";
                             &Apache::lonhtmlcommon::row_closure(1).                  if ($captchaform) {
                             &Apache::lonhtmlcommon::row_title(&mt('Validation'),                      $output .= &Apache::lonhtmlcommon::row_closure(1).
                                                              'LC_pick_box_title')."\n".                                 &Apache::lonhtmlcommon::row_title(&mt('Validation'),
                             $captchaform."\n".'<br /><br />';                                                                   'LC_pick_box_title')."\n".
                                  $captchaform."\n".'<br /><br />';
                   }
                 if ($courseid ne '') {                  if ($courseid ne '') {
                     $output .= '<input type="hidden" name="courseid" value="'.$courseid.'"/>'."\n";                       $output .= '<input type="hidden" name="courseid" value="'.$courseid.'"/>'."\n"; 
                 }                  }
Line 415  sub print_username_form { Line 436  sub print_username_form {
                     $output .= &Apache::lonhtmlcommon::echo_form_input(['courseid']);                      $output .= &Apache::lonhtmlcommon::echo_form_input(['courseid']);
                 }                  }
                 $output .= '</form>';                  $output .= '</form>';
             } else {  
                 my $helpdesk = '/adm/helpdesk?origurl=%2fadm%2fcreateaccount';  
                 if ($courseid ne '') {  
                     $helpdesk .= '&courseid='.$courseid;  
                 }  
                 $output .= '<span class="LC_error">'.&mt('An error occurred generating the validation code[_1] required for an e-mail address to be used as username.','<br />').'</span><br /><br />'.&mt('[_1]Contact the helpdesk[_2] or [_3]reload[_2] the page and try again.','<a href="'.$helpdesk.'">','</a>','<a href="javascript:window.location.reload()">');  
             }              }
             $output .= '</div>';              $output .= '</div>';
         }          }
Line 505  sub process_email_request { Line 520  sub process_email_request {
                                          $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 $uhome=&Apache::lonnet::homeserver($useremail,$domain);
Line 621  sub process_mailtoken { Line 623  sub process_mailtoken {
         ($data{'username'}  =~ /^[^\@]+\@[^\@]+\.[^\@\.]+$/)) {          ($data{'username'}  =~ /^[^\@]+\@[^\@]+\.[^\@\.]+$/)) {
         if ($now - $data{'time'} < 7200) {          if ($now - $data{'time'} < 7200) {
             if ($env{'form.phase'} eq 'createaccount') {              if ($env{'form.phase'} eq 'createaccount') {
                 my ($result,$output) = &create_account($r,$domain,$lonhost,                  my ($result,$output,$uhome) = 
                                                        $data{'username'},$domdesc);                      &create_account($r,$domain,$data{'username'},$domdesc);
                 if ($result eq 'ok') {                  if ($result eq 'ok') {
                     $msg = $output;                       $msg = $output; 
                     my $shownow = &Apache::lonlocal::locallocaltime($now);                      my $shownow = &Apache::lonlocal::locallocaltime($now);
Line 635  sub process_mailtoken { Line 637  sub process_mailtoken {
                     } else {                      } else {
                         $msg .= &mt('An error occurred when sending e-mail to [_1] confirming creation of your LON-CAPA account.',$data{'username'});                          $msg .= &mt('An error occurred when sending e-mail to [_1] confirming creation of your LON-CAPA account.',$data{'username'});
                     }                      }
                     &start_session($r, $data{'username'}, $domain, $lonhost,                      &start_session($r,$data{'username'},$domain,$uhome,
                         $data{'courseid'}, $token);                                     $data{'courseid'},$token);
                     $nostart = 1;                      $nostart = 1;
                     $noend = 1;                      $noend = 1;
                 } else {                  } else {
Line 663  sub process_mailtoken { Line 665  sub process_mailtoken {
 }  }
   
 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;
Line 675  sub start_session { Line 677  sub start_session {
     } 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 683  sub start_session { Line 685  sub start_session {
     return;      return;
 }  }
   
   #
   # The screen that the user gets to create his or her account
   # Desired username, desired password, etc
   # Stores token to store DES-key and stage during creation session
   #
 sub print_dataentry_form {  sub print_dataentry_form {
     my ($r,$domain,$lonhost,$include,$mailtoken,$now,$username,$start_page) = @_;      my ($r,$domain,$lonhost,$include,$mailtoken,$now,$username,$start_page) = @_;
     my ($error,$output);      my ($error,$output);
Line 763  ENDSERVERFORM Line 769  ENDSERVERFORM
     return $output;      return $output;
 }  }
   
   #
   # Retrieve rules for generating accounts from domain configuration
   # Can the user make a new account or just self-enroll?
   
 sub get_creation_controls {  sub get_creation_controls {
     my ($domain,$usercreation) = @_;      my ($domain,$usercreation) = @_;
     my (@cancreate,@statustocreate);      my (@cancreate,@statustocreate);
Line 801  sub get_creation_controls { Line 811  sub get_creation_controls {
 }  }
   
 sub create_account {  sub create_account {
     my ($r,$domain,$lonhost,$username,$domdesc) = @_;      my ($r,$domain,$username,$domdesc) = @_;
   # Get the token info
     my ($retrieved,$output,$upass) = &process_credentials($env{'form.logtoken'},      my ($retrieved,$output,$upass) = &process_credentials($env{'form.logtoken'},
                                                           $env{'form.serverid'});                                                             $env{'form.serverid'}); 
   # $retrieved is 'ok' if things worked
   # $output is user error output
   # $upass is the decrypted password
     # Error messages      # Error messages
     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();
     if ($retrieved eq 'ok') {      if ($retrieved eq 'ok') {
         if ($env{'form.courseid'} ne '') {          if ($env{'form.courseid'} ne '') {
   # See if we are allowed to use this username per domain rules (number of characters, etc)
             my ($result,$userchkmsg) = &check_id($username,$domain,$domdesc);              my ($result,$userchkmsg) = &check_id($username,$domain,$domdesc);
             if ($result eq 'fail') {              if ($result eq 'fail') {
                 $output = $error.&mt('Invalid ID format').$end.                  $output = $error.&mt('Invalid ID format').$end.
Line 822  sub create_account { Line 837  sub create_account {
     } else {      } else {
         return ('fail',$error.$output.$end.$rtnlink);          return ('fail',$error.$output.$end.$rtnlink);
     }      }
     # Call modifyuser      # 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 =       my $result = 
         &Apache::lonnet::modifyuser($domain,$username,$env{'form.cid'},          &Apache::lonnet::modifyuser($domain,$username,$env{'form.cid'},
                                     'internal',$upass,$env{'form.cfirstname'},                                      'internal',$upass,$env{'form.cfirstname'},
                                     $env{'form.cmiddlename'},$env{'form.clastname'},                                      $env{'form.cmiddlename'},$env{'form.clastname'},
                                     $env{'form.cgeneration'},undef,undef,$username);                                      $env{'form.cgeneration'},undef,undef,$username);
     $output = &mt('Generating user: [_1]',$result);      $output = &mt('Generating user: [_1]',$result);
       # Now that the user exists, we can have a homeserver
     my $uhome = &Apache::lonnet::homeserver($username,$domain);      my $uhome = &Apache::lonnet::homeserver($username,$domain);
     $output .= '<br />'.&mt('Home server: [_1]',$uhome).' '.      $output .= '<br />'.&mt('Home server: [_1]',$uhome).' '.
               &Apache::lonnet::hostname($uhome).'<br /><br />';                &Apache::lonnet::hostname($uhome).'<br /><br />';
     return ('ok',$output);      return ('ok',$output,$uhome);
 }  }
   
 sub username_validation {  sub username_validation {
Line 858  sub username_validation { Line 877  sub username_validation {
     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);              &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.');              $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 {
Line 1012  sub username_check { Line 1031  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 1038  sub username_activation { Line 1057  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)$/) && 
Line 1082  sub username_activation { Line 1106  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');
               &start_session($r,$username,$domain,$uhome,$courseid);
             my $nostart = 1;              my $nostart = 1;
             return ('ok',$output,$nostart);              return ('ok',$output,$nostart);
         } else {          } else {
Line 1098  sub username_activation { Line 1123  sub username_activation {
 sub check_id {  sub check_id {
     my ($username,$domain,$domdesc) = @_;      my ($username,$domain,$domdesc) = @_;
     # Check ID format      # Check ID format
       # Is $username in an okay format for $domain 
       # (right number of characters, special characters, etc - follow domain rules)?
       # $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}} = (
Line 1161  sub linkto_email_help { Line 1189  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);
Removed from v.1.49  
changed lines
  Added in v.1.56

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