--- loncom/interface/createaccount.pm 2012/05/18 04:31:05 1.51
+++ loncom/interface/createaccount.pm 2013/02/05 15:45:18 1.55
@@ -3,7 +3,7 @@
# institutional log-in ID (institutional authentication required - localauth
# or kerberos) or an e-mail address.
#
-# $Id: createaccount.pm,v 1.51 2012/05/18 04:31:05 raeburn Exp $
+# $Id: createaccount.pm,v 1.55 2013/02/05 15:45:18 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -39,7 +39,6 @@ use Apache::lonhtmlcommon;
use Apache::lonlocal;
use Apache::lonauth;
use Apache::resetpw;
-use Authen::Captcha;
use DynaLoader; # for Crypt::DES version
use Crypt::DES;
use LONCAPA qw(:DEFAULT :match);
@@ -382,8 +381,14 @@ sub print_username_form {
}
if (grep(/^email$/,@{$cancreate})) {
$output .= '
'.&mt('Create account with an e-mail address as your username').'
';
- my $captchaform = &create_captcha();
- if ($captchaform) {
+ my ($captchaform,$error) = &Apache::loncommon::captcha_display('usercreation',$lonhost);
+ if ($error) {
+ my $helpdesk = '/adm/helpdesk?origurl=%2fadm%2fcreateaccount';
+ if ($courseid ne '') {
+ $helpdesk .= '&courseid='.$courseid;
+ }
+ $output .= ''.&mt('An error occurred generating the validation code[_1] required for an e-mail address to be used as username.',' ').'
';
}
@@ -503,23 +504,10 @@ sub process_email_request {
$contact_name,$contact_email);
return $output;
} else {
- my $code = $env{'form.code'};
- my $md5sum = $env{'form.crypt'};
- my %captcha_params = &captcha_settings();
- my $captcha = Authen::Captcha->new(
- output_folder => $captcha_params{'output_dir'},
- data_folder => $captcha_params{'db_dir'},
- );
- my $captcha_chk = $captcha->check_code($code,$md5sum);
- my %captcha_hash = (
- 0 => 'Code not checked (file error)',
- -1 => 'Failed: code expired',
- -2 => 'Failed: invalid code (not in database)',
- -3 => 'Failed: invalid code (code does not match crypt)',
- );
+ my ($captcha_chk,$captcha_error) = &Apache::loncommon::captcha_response('usercreation',$server);
if ($captcha_chk != 1) {
$output = &invalid_state('captcha',$domdesc,$contact_name,
- $contact_email,$captcha_hash{$captcha_chk});
+ $contact_email,$captcha_error);
return $output;
}
my $uhome=&Apache::lonnet::homeserver($useremail,$domain);
@@ -817,7 +805,7 @@ sub create_account {
# Error messages
my $error = ''.&mt('Error:').' ';
my $end = '
';
- my $rtnlink = ''.
+ my $rtnlink = ''.
&mt('Return to previous page').''.
&Apache::loncommon::end_page();
if ($retrieved eq 'ok') {
@@ -1031,7 +1019,7 @@ sub username_activation {
my $output;
my $error = ''.&mt('Error:').' ';
my $end = '
';
- my $rtnlink = ''.
+ my $rtnlink = ''.
&mt('Return to previous page').''.
&Apache::loncommon::end_page();
my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
@@ -1180,44 +1168,11 @@ sub linkto_email_help {
}
$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).' ';
+ $msg .= ' '.&mt('You may wish to send an e-mail to the server administrator: [_1] for [_2].',$Apache::lonnet::perlvar{'AdmEMail'},$domdesc).' ';
}
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 = ''."\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 {
my ($lkey,$ukey) = @_;
my $lextkey=hex($lkey);