--- loncom/interface/createaccount.pm 2009/12/06 23:48:34 1.37.2.1 +++ loncom/interface/createaccount.pm 2011/09/29 14:16:14 1.40.2.5 @@ -3,7 +3,7 @@ # institutional log-in ID (institutional authentication required - localauth # or kerberos) or an e-mail address. # -# $Id: createaccount.pm,v 1.37.2.1 2009/12/06 23:48:34 raeburn Exp $ +# $Id: createaccount.pm,v 1.40.2.5 2011/09/29 14:16:14 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -39,7 +39,7 @@ use Apache::lonhtmlcommon; use Apache::lonlocal; use Apache::lonauth; use Apache::resetpw; -use Captcha::reCAPTCHA; +use Authen::Captcha; use DynaLoader; # for Crypt::DES version use Crypt::DES; use LONCAPA qw(:DEFAULT :match); @@ -139,7 +139,6 @@ sub handler { $start_page = &Apache::loncommon::start_page($title,$js, {'no_inline_link' => 1,}); - my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$domain); my ($cancreate,$statustocreate) = &get_creation_controls($domain,$domconfig{'usercreation'}); @@ -147,7 +146,7 @@ sub handler { &print_header($r,$start_page,$courseid); my $output = '

'.&mt('Account creation unavailable').'

'. ''. - &mt('Creation of a new user account using an e-mail address or an institutional log-in ID as username is not permitted for the GCI WebCenter.').'

'; + &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).'

'; $r->print($output); &print_footer($r); return OK; @@ -286,7 +285,7 @@ sub selfenroll_crumbs { } my $last_crumb; if ($desc ne '') { - $last_crumb = &mt('Self-enroll in [_1]',''.$desc.''); + $last_crumb = &mt('Self-enroll in [_1]',"$desc"); } else { $last_crumb = &mt('Self-enroll'); } @@ -403,7 +402,7 @@ sub print_username_form { } if (grep(/^email$/,@{$cancreate})) { $output .= '

'.&mt('Create account with an e-mail address as your username').'

'; - my $captchaform = &create_recaptcha(); + my $captchaform = &create_captcha(); if ($captchaform) { my $submit_text = &mt('Request LON-CAPA account'); my $emailform = ''; @@ -412,7 +411,7 @@ sub print_username_form { } else { $output .= '
'; } - $output .= '
'. + $output .= ''. &Apache::lonhtmlcommon::start_pick_box()."\n". &Apache::lonhtmlcommon::row_title(&mt('E-mail address'), 'LC_pick_box_title')."\n". @@ -461,13 +460,12 @@ sub login_box { ); my ($lkey,$ukey) = &Apache::lonpreferences::des_keys(); my ($lextkey,$uextkey) = &getkeys($lkey,$ukey); - my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount', + my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount:createaccount', $lonhost); $output = &serverform($logtoken,$lonhost,undef,$courseid,$context); my $unameform = ''; my $upassform = ''; - $output .= ''."\n". - ''. + $output .= ''."\n". &Apache::lonhtmlcommon::start_pick_box()."\n". &Apache::lonhtmlcommon::row_title($titles{$context}, 'LC_pick_box_title')."\n". @@ -476,6 +474,16 @@ sub login_box { &Apache::lonhtmlcommon::row_title(&mt('Password'), 'LC_pick_box_title')."\n". $upassform; + if ($context eq 'selfenroll') { + my $udomform = ''; + $output .= &Apache::lonhtmlcommon::row_closure(1)."\n". + &Apache::lonhtmlcommon::row_title(&mt('Domain'), + 'LC_pick_box_title')."\n". + $udomform."\n"; + } else { + $output .= ''; + } $output .= &Apache::lonhtmlcommon::row_closure(1). &Apache::lonhtmlcommon::row_title(). '
'; my $submit_text = &mt('Create LON-CAPA account'); $output .= '

'.&mt('Login Data').'

'."\n". - ''."\n". &Apache::lonhtmlcommon::start_pick_box()."\n". &Apache::lonhtmlcommon::row_title(&mt('Username'), @@ -783,6 +796,17 @@ sub get_creation_controls { if (ref($usercreation->{'cancreate'}) eq 'HASH') { if (ref($usercreation->{'cancreate'}{'statustocreate'}) eq 'ARRAY') { @statustocreate = @{$usercreation->{'cancreate'}{'statustocreate'}}; + if (@statustocreate == 0) { + my ($othertitle,$usertypes,$types) = + &Apache::loncommon::sorted_inst_types($domain); + if (ref($types) eq 'ARRAY') { + if (@{$types} == 0) { + @statustocreate = ('default'); + } + } else { + @statustocreate = ('default'); + } + } } else { @statustocreate = ('default'); my ($othertitle,$usertypes,$types) = @@ -904,7 +928,7 @@ sub username_check { my (%rulematch,%inst_results,$checkfail,$rowcount,$editable,$output,$msg, %alerts,%curr_rules,%got_rules); &call_rulecheck($username,$domain,\%alerts,\%rulematch, - \%inst_results,\%curr_rules,%got_rules,'username'); + \%inst_results,\%curr_rules,\%got_rules,'username'); if (ref($alerts{'username'}) eq 'HASH') { if (ref($alerts{'username'}{$domain}) eq 'HASH') { if ($alerts{'username'}{$domain}{$username}) { @@ -950,7 +974,7 @@ sub username_check { 'time' => $now, 'domain' => $domain, 'username' => $username); - my $authtoken = &Apache::lonnet::tmpput(\%info,$lonhost); + my $authtoken = &Apache::lonnet::tmpput(\%info,$lonhost,'createaccount'); if ($authtoken !~ /^error/ && $authtoken ne 'no_such_host') { $output .= ''; } else { @@ -961,7 +985,7 @@ sub username_check { } } if ($checkfail) { - $msg = '

'.&mt('Account creation unavailable').'

'; + $msg = '

'.&mt('Account creation unavailable').'

'; if ($checkfail eq 'username') { $msg .= ''. &mt('A LON-CAPA account may not be created with the username you use.'). @@ -987,7 +1011,7 @@ sub username_check { if ($rowcount) { if ($editable) { if ($courseid ne '') { - $msg = '

'.&mt('User information').'

'; + $msg = '

'.&mt('User information').'

'; } $msg .= &mt('To create one, use the table below to provide information about yourself, then click the [_1]Create LON-CAPA account[_2] button.','','').'
'; } else { @@ -1051,7 +1075,7 @@ sub username_activation { # Call modifyuser my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts,%info); &call_rulecheck($username,$domain,\%alerts,\%rulematch, - \%inst_results,\%curr_rules,%got_rules); + \%inst_results,\%curr_rules,\%got_rules); my @userinfo = ('firstname','middlename','lastname','generation', 'permanentemail','id'); my %canmodify = @@ -1124,43 +1148,75 @@ sub invalid_state { my ($error,$domdesc,$contact_name,$contact_email,$msgtext) = @_; my $msg = '

'.&mt('Account creation unavailable').'

'; 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 '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') { - $msg = &mt('Username rules at this institution do not allow the e-mail address you provided to be used as a username.'); + $msg .= &mt('Username rules at this institution do not allow the e-mail address you provided to be used as a username.'); } elsif ($error eq 'userformat') { - $msg = &mt('The e-mail address you provided may not be used as a username at this LON-CAPA institution.'); + $msg .= &mt('The e-mail address you provided may not be used as a username at this LON-CAPA institution.'); } elsif ($error eq 'captcha') { - $msg = &mt('Validation of the code your entered failed.'); + $msg .= &mt('Validation of the code you entered failed.'); } elsif ($error eq 'noemails') { - $msg = &mt('Creation of a new user account using an e-mail address as username is not permitted at this LON-CAPA institution.'); + $msg .= &mt('Creation of a new user account using an e-mail address as username is not permitted at this LON-CAPA institution.'); } $msg .= ''; if ($msgtext) { $msg .= '
'.$msgtext; } - $msg .= &linkto_email_help($contact_email,$domdesc); + $msg .= &linkto_email_help($contact_email,$domdesc,$error); return $msg; } sub linkto_email_help { - my ($contact_email,$domdesc) = @_; + my ($contact_email,$domdesc,$error) = @_; my $msg; + my $href = '/adm/helpdesk'; if ($contact_email ne '') { my $escuri = &HTML::Entities::encode('/adm/createaccount','&<>"'); - $msg .= '
'.&mt('You may wish to contact the [_1]LON-CAPA helpdesk[_2] for [_3].','','',$domdesc).'
'; + $href .= '?origurl='.$escuri; + if ($error eq 'existinguser') { + my $escemail = &HTML::Entities::encode($env{'form.useremail'}); + $href .= '&useremail='.$escemail.'&useraccount='.$escemail; + } + $msg .= '
'.&mt('You may wish to contact the [_1]LON-CAPA helpdesk[_2] for [_3].','','',$domdesc).'
'; } else { $msg .= '
'.&mt('You may wish to send an e-mail to the server administrator: [_1] for [_2].',$Apache::lonnet::perlvar{'AdminEmail'},$domdesc).'
'; } return $msg; } -sub create_recaptcha { - my $captcha = Captcha::reCAPTCHA->new; - return $captcha->get_options_setter({theme => 'white'})."\n". - $captcha->get_html('PUBLICKEY'); # generate public key for IP - # from http://recaptcha.net/ +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 = ''."\n". + &mt('Type in the letters/numbers shown below').' '. + '
'. + ''; + 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 {