[LON-CAPA-cvs] cvs: loncom(loncapaMITrelate_1) /interface createaccount.pm
raeburn
raeburn at source.lon-capa.org
Sun Feb 5 21:36:29 EST 2012
raeburn Mon Feb 6 02:36:29 2012 EDT
Modified files: (Branch: loncapaMITrelate_1)
/loncom/interface createaccount.pm
Log:
- Customatization for MITrelate.
- Forward port: 1.37.2.1, 1.37.2.2, 1.37.2.3, 1.37.2.4, 1.37.2.5.
-------------- next part --------------
Index: loncom/interface/createaccount.pm
diff -u loncom/interface/createaccount.pm:1.40.2.5 loncom/interface/createaccount.pm:1.40.2.5.2.1
--- loncom/interface/createaccount.pm:1.40.2.5 Thu Sep 29 14:16:14 2011
+++ loncom/interface/createaccount.pm Mon Feb 6 02:36:29 2012
@@ -3,7 +3,7 @@
# institutional log-in ID (institutional authentication required - localauth
# or kerberos) or an e-mail address.
#
-# $Id: createaccount.pm,v 1.40.2.5 2011/09/29 14:16:14 raeburn Exp $
+# $Id: createaccount.pm,v 1.40.2.5.2.1 2012/02/06 02:36:29 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -39,7 +39,7 @@
use Apache::lonlocal;
use Apache::lonauth;
use Apache::resetpw;
-use Authen::Captcha;
+use Captcha::reCAPTCHA;
use DynaLoader; # for Crypt::DES version
use Crypt::DES;
use LONCAPA qw(:DEFAULT :match);
@@ -146,7 +146,7 @@
&print_header($r,$start_page,$courseid);
my $output = '<h3>'.&mt('Account creation unavailable').'</h3>'.
'<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 for [_1].',$domdesc).'</span><br /><br />';
$r->print($output);
&print_footer($r);
return OK;
@@ -245,6 +245,15 @@
return OK;
}
+sub get_custom_name {
+ my ($domain) = @_;
+ if ($domain eq 'relate') {
+ return 'Learn-Physics';
+ } else {
+ return lc($domain);
+ }
+}
+
sub print_header {
my ($r,$start_page,$courseid) = @_;
$r->print($start_page);
@@ -373,6 +382,13 @@
if (validmail(field) == false) {
alert("$lt{'email'}: "+field.value+" $lt{'notv'}.");
return false;
+ } else {
+ var emailaddr = field.value;
+ var lcemail = emailaddr.toLowerCase();
+ if (emailaddr != lcemail) {
+ field.value = lcemail;
+ alert("Learn-Physics usernames are all lower case.\\nAccordingly your username will be "+lcemail+" once activated.");
+ }
}
return true;
}
@@ -402,7 +418,7 @@
}
if (grep(/^email$/,@{$cancreate})) {
$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 = &create_recaptcha();
if ($captchaform) {
my $submit_text = &mt('Request LON-CAPA account');
my $emailform = '<input type="text" name="useremail" size="25" value="" />';
@@ -419,7 +435,8 @@
&Apache::lonhtmlcommon::row_closure(1).
&Apache::lonhtmlcommon::row_title(&mt('Validation'),
'LC_pick_box_title')."\n".
- $captchaform."\n".'<br /><br />';
+ $captchaform."\n".
+ &mt('If either word is hard to read, [_1] will replace them.','<image src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').'<br /><br />';
if ($courseid ne '') {
$output .= '<input type="hidden" name="courseid" value="'.$courseid.'"/>'."\n";
}
@@ -466,6 +483,7 @@
my $unameform = '<input type="text" name="uname" size="20" value="" />';
my $upassform = '<input type="password" name="upass'.$now.'" size="20" />';
$output .= '<form name="client" method="post" action="" onsubmit="return(send());">'."\n".
+ '<input type="hidden" name="udom" value="'.$domain.'" />'.
&Apache::lonhtmlcommon::start_pick_box()."\n".
&Apache::lonhtmlcommon::row_title($titles{$context},
'LC_pick_box_title')."\n".
@@ -473,18 +491,8 @@
&Apache::lonhtmlcommon::row_closure(1)."\n".
&Apache::lonhtmlcommon::row_title(&mt('Password'),
'LC_pick_box_title')."\n".
- $upassform;
- if ($context eq 'selfenroll') {
- my $udomform = '<input type="text" name="udom" size="10" value="'.
- $domain.'" />';
- $output .= &Apache::lonhtmlcommon::row_closure(1)."\n".
- &Apache::lonhtmlcommon::row_title(&mt('Domain'),
- 'LC_pick_box_title')."\n".
- $udomform."\n";
- } else {
- $output .= '<input type="hidden" name="udom" value="'.$domain.'" />';
- }
- $output .= &Apache::lonhtmlcommon::row_closure(1).
+ $upassform.
+ &Apache::lonhtmlcommon::row_closure(1).
&Apache::lonhtmlcommon::row_title().
'<br /><input type="submit" name="username_validation" value="'.
$submit_text.'" />'."\n";
@@ -505,7 +513,7 @@
sub process_email_request {
my ($useremail,$domain,$domdesc,$contact_name,$contact_email,$cancreate,
$server,$settings,$courseid) = @_;
- $useremail = $env{'form.useremail'};
+ $useremail = lc($env{'form.useremail'});
my $output;
if (ref($cancreate) eq 'ARRAY') {
if (!grep(/^email$/,@{$cancreate})) {
@@ -520,26 +528,21 @@
my $uhome = &Apache::lonnet::homeserver($useremail,$domain);
if ($uhome ne 'no_host') {
$output = &invalid_state('existinguser',$domdesc,
- $contact_name,$contact_email);
+ $contact_name,$contact_email,'',$useremail);
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)',
- );
- if ($captcha_chk != 1) {
+ my $captcha = Captcha::reCAPTCHA->new;
+ my $captcha_result =
+ $captcha->check_answer(
+ 'PRIVATEKEY',
+ $ENV{'REMOTE_ADDR'},
+ $env{'form.recaptcha_challenge_field'},
+ $env{'form.recaptcha_response_field'},
+ );
+ if (!$captcha_result->{is_valid}) {
$output = &invalid_state('captcha',$domdesc,$contact_name,
- $contact_email,$captcha_hash{$captcha_chk});
+ $contact_email);
+
return $output;
}
my $uhome=&Apache::lonnet::homeserver($useremail,$domain);
@@ -602,9 +605,9 @@
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).' '.
+ my $mailmsg = &mt('A request was submitted on [_1] for creation of a [_1] account.',$showtime,$domdesc).). "\n".
&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);
+ "\n\n".&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') {
@@ -644,7 +647,7 @@
if ($result eq 'ok') {
$msg = $output;
my $shownow = &Apache::lonlocal::locallocaltime($now);
- 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";
+ my $mailmsg = &mt('A [_1] account 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";
my $mailresult = &Apache::resetpw::send_mail($domdesc,$data{'email'},
$mailmsg,$contact_name,
$contact_email);
@@ -1145,12 +1148,16 @@
}
sub invalid_state {
- my ($error,$domdesc,$contact_name,$contact_email,$msgtext) = @_;
+ my ($error,$domdesc,$contact_name,$contact_email,$msgtext,$useremail) = @_;
my $msg = '<h3>'.&mt('Account creation unavailable').'</h3><span class="LC_error">';
if ($error eq 'baduseremail') {
$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.');
+ my $uname = &HTML::Entities::encode($useremail);
+ $msg .= &mt('The e-mail address you provided is already in use as a username in LON-CAPA at this institution.').'</span><br /><br /><span class="LC_warning">'.&mt('You can either:').'<ul>'.
+ '<li>'.&mt('Return to the [_1]log-in page[_2] and enter your password.','<a href="/adm/login?username='.$uname.'">','</a>').'</li>'.
+ '<li>'.&mt('or, if you do not remember your password, visit the "[_1]Forgot your password?[_2]" page.','<a href="/adm/resetpw?uname='.$uname.'&useremail='.$uname.'&referrer=createaccount">','</a>').
+ '</li></ul>';
} 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.');
} elsif ($error eq 'userformat') {
@@ -1186,37 +1193,11 @@
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').' '.
- '<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 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 getkeys {
More information about the LON-CAPA-cvs
mailing list