[LON-CAPA-cvs] cvs: loncom /interface createaccount.pm loncommon.pm lonpreferences.pm
raeburn
raeburn at source.lon-capa.org
Sun May 5 19:19:48 EDT 2019
raeburn Sun May 5 23:19:48 2019 EDT
Modified files:
/loncom/interface createaccount.pm loncommon.pm lonpreferences.pm
Log:
- Response to incorrect Captcha on account creation page is to display a page
containing a link back to the form, instead of a call to &invalid_state().
- Rules for length and/or characters in a LON-CAPA password (internal auth)
checked server-side when a user self-creates a user account.
- rule-checking code moved from lonpreferences.pm to loncommon.pm to
facilitate reuse.
-------------- next part --------------
Index: loncom/interface/createaccount.pm
diff -u loncom/interface/createaccount.pm:1.77 loncom/interface/createaccount.pm:1.78
--- loncom/interface/createaccount.pm:1.77 Sun May 5 04:00:42 2019
+++ loncom/interface/createaccount.pm Sun May 5 23:19:47 2019
@@ -4,7 +4,7 @@
# 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: createaccount.pm,v 1.77 2019/05/05 04:00:42 raeburn Exp $
+# $Id: createaccount.pm,v 1.78 2019/05/05 23:19:47 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -842,8 +842,24 @@
} else {
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_error);
+ $output = '<span class="LC_warning">'.
+ &mt('Validation of the code you entered failed.').'</span>'.
+ '<br />'.$captcha_error."\n".'<br /><p>'.
+ &mt('[_1]Return[_2] to the previous page to try again.',
+ '<a href="javascript:document.retryemail.submit();">','</a>')."\n".
+ '<form name="retryemail" action="/adm/createaccount" method="post" />'.
+ '<input type="hidden" name="domain" value="'.$domain.'" />'."\n";
+ if ($env{'form.courseid'} =~ /^$match_domain\_$match_courseid$/) {
+ $output .= '<input type="hidden" name="courseid" value="'.$env{'form.courseid'}.'" />'."\n";
+ }
+ if ($env{'form.type'}) {
+ my $usertype = &get_usertype($domain);
+ if ($usertype ne '') {
+ $output .= '<input type="hidden" name="type" value="'.$usertype.'" />'."\n".
+ '<input type="hidden" name="reportedtype" value="'.&mt('Submit').'" />'."\n";
+ }
+ }
+ $output .= '</form></p>';
return $output;
}
my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts);
@@ -901,16 +917,72 @@
$env{'form.logtoken'} =~ s/(`)//g;
if ($env{'form.logtoken'}) {
my $logtoken = $env{'form.logtoken'};
+ my $earlyout;
my $tmpinfo=Apache::lonnet::reply('tmpget:'.$logtoken,$server);
if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
$msg = &mt('Information needed to process your request is missing, inaccessible or expired.')
- .'<br />'.&mt('Return to the previous page to try again.');
+ .'<br /><p>'.&mt('[_1]Return[_2] to the previous page to try again.',
+ '<a href="javascript:document.retryemail.submit();">','</a>');
+ $earlyout = 1;
} else {
my $reply = &Apache::lonnet::reply('tmpdel:'.$logtoken,$server);
unless ($reply eq 'ok') {
$msg .= &mt('Request could not be processed.');
}
}
+# Check if the password entered by the user satisfies domain's requirements
+ my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
+ my ($min,$max, at chars);
+ if (ref($passwdconf{'chars'}) eq 'ARRAY') {
+ if ($passwdconf{'min'} =~ /^\d+$/) {
+ $min = $passwdconf{'min'};
+ }
+ if ($passwdconf{'max'} =~ /^\d+$/) {
+ $max = $passwdconf{'max'};
+ }
+ @chars = @{$passwdconf{'chars'}};
+ } else {
+ $min = 7;
+ }
+ if (($min ne '') || ($max ne '') || (@chars > 0)) {
+ my ($plainpass,$encpass);
+ my $encpass = $env{'form.upass'};
+ if ($encpass eq '') {
+ $msg = &mt('Password retrieved was blank.').
+ '<br /><p>'.&mt('[_1]Return[_2] to the previous page to try again.',
+ '<a href="javascript:document.retryemail.submit();">','</a>');
+ $earlyout = 1;
+ } else {
+# Split the logtoken to retrieve the DES key and decrypt the encypted password
+ my ($key,$caller)=split(/&/,$tmpinfo);
+ if ($caller eq 'createaccount') {
+ $plainpass = &Apache::loncommon::des_decrypt($key,$encpass);
+ my $warning = &Apache::loncommon::check_passwd_rules($domain,$plainpass);
+ if ($warning) {
+ $msg = $warning.
+ '<p>'.&mt('[_1]Return[_2] to the previous page to try again.',
+ '<a href="javascript:document.retryemail.submit();">','</a>');
+ $earlyout = 1;
+ }
+ }
+ }
+ }
+ if ($earlyout) {
+ $msg .= '<form name="retryemail" action="/adm/createaccount" method="post" />'.
+ '<input type="hidden" name="domain" value="'.$domain.'" />'."\n";
+ if ($env{'form.courseid'} =~ /^$match_domain\_$match_courseid$/) {
+ $msg .= '<input type="hidden" name="courseid" value="'.$env{'form.courseid'}.'" />'."\n";
+ }
+ if ($env{'form.type'}) {
+ my $usertype = &get_usertype($domain);
+ if ($usertype ne '') {
+ $msg .= '<input type="hidden" name="type" value="'.$usertype.'" />'.
+ '<input type="hidden" name="reportedtype" value="'.&mt('Submit').'" />'."\n";
+ }
+ }
+ $msg .= '</form></p>';
+ return $msg;
+ }
my %info = ('ip' => $ENV{'REMOTE_ADDR'},
'time' => $now,
'domain' => $domain,
@@ -1711,8 +1783,6 @@
$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.');
- } elsif ($error eq 'captcha') {
- $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.');
} elsif ($error eq 'emailfail') {
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1330 loncom/interface/loncommon.pm:1.1331
--- loncom/interface/loncommon.pm:1.1330 Fri May 3 00:35:46 2019
+++ loncom/interface/loncommon.pm Sun May 5 23:19:47 2019
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1330 2019/05/03 00:35:46 raeburn Exp $
+# $Id: loncommon.pm,v 1.1331 2019/05/05 23:19:47 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3567,6 +3567,75 @@
return ($authnum,%can_assign);
}
+sub check_passwd_rules {
+ my ($domain,$plainpass) = @_;
+ my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
+ my ($min,$max, at chars, at brokerule,$warning);
+ if (ref($passwdconf{'chars'}) eq 'ARRAY') {
+ if ($passwdconf{'min'} =~ /^\d+$/) {
+ $min = $passwdconf{'min'};
+ }
+ if ($passwdconf{'max'} =~ /^\d+$/) {
+ $max = $passwdconf{'max'};
+ }
+ @chars = @{$passwdconf{'chars'}};
+ } else {
+ $min = 7;
+ }
+ if (($min) && (length($plainpass) < $min)) {
+ push(@brokerule,'min');
+ }
+ if (($max) && (length($plainpass) > $max)) {
+ push(@brokerule,'max');
+ }
+ if (@chars) {
+ my %rules;
+ map { $rules{$_} = 1; } @chars;
+ if ($rules{'uc'}) {
+ unless ($plainpass =~ /[A-Z]/) {
+ push(@brokerule,'uc');
+ }
+ }
+ if ($rules{'lc'}) {
+ unless ($plainpass =~ /a-z/) {
+ push(@brokerule,'lc');
+ }
+ }
+ if ($rules{'num'}) {
+ unless ($plainpass =~ /\d/) {
+ push(@brokerule,'num');
+ }
+ }
+ if ($rules{'spec'}) {
+ unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
+ push(@brokerule,'spec');
+ }
+ }
+ }
+ if (@brokerule) {
+ my %rulenames = &Apache::lonlocal::texthash(
+ uc => 'At least one upper case letter',
+ lc => 'At least one lower case letter',
+ num => 'At least one number',
+ spec => 'At least one non-alphanumeric',
+ );
+ $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
+ $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
+ $rulenames{'num'} .= ': 0123456789';
+ $rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{|}~';
+ $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
+ $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
+ $warning = &mt('Password did not satisfy the following:').'<ul>';
+ foreach my $rule ('min','max','uc','ls','num','spec') {
+ if (grep(/^$rule$/, at brokerule)) {
+ $warning .= '<li>'.$rulenames{$rule}.'</li>';
+ }
+ }
+ $warning .= '</ul>';
+ }
+ return $warning;
+}
+
###############################################################
## Get Kerberos Defaults for Domain ##
###############################################################
Index: loncom/interface/lonpreferences.pm
diff -u loncom/interface/lonpreferences.pm:1.232 loncom/interface/lonpreferences.pm:1.233
--- loncom/interface/lonpreferences.pm:1.232 Tue Apr 30 12:56:23 2019
+++ loncom/interface/lonpreferences.pm Sun May 5 23:19:47 2019
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Preferences
#
-# $Id: lonpreferences.pm,v 1.232 2019/04/30 12:56:23 raeburn Exp $
+# $Id: lonpreferences.pm,v 1.233 2019/05/05 23:19:47 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1636,69 +1636,8 @@
return 1;
}
} else {
- my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
- my ($min,$max, at chars, at brokerule);
- if (ref($passwdconf{'chars'}) eq 'ARRAY') {
- if ($passwdconf{'min'} =~ /^\d+$/) {
- $min = $passwdconf{'min'};
- }
- if ($passwdconf{'max'} =~ /^\d+$/) {
- $max = $passwdconf{'max'};
- }
- @chars = @{$passwdconf{'chars'}};
- } else {
- $min = 7;
- }
- if (($min) && (length($newpass1) < $min)) {
- push(@brokerule,'min');
- }
- if (($max) && (length($newpass1) > $max)) {
- push(@brokerule,'max');
- }
- if (@chars) {
- my %rules;
- map { $rules{$_} = 1; } @chars;
- if ($rules{'uc'}) {
- unless ($newpass1 =~ /[A-Z]/) {
- push(@brokerule,'uc');
- }
- }
- if ($rules{'lc'}) {
- unless ($newpass1 =~ /a-z/) {
- push(@brokerule,'lc');
- }
- }
- if ($rules{'num'}) {
- unless ($newpass1 =~ /\d/) {
- push(@brokerule,'num');
- }
- }
- if ($rules{'spec'}) {
- unless ($newpass1 =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
- push(@brokerule,'spec');
- }
- }
- }
- if (@brokerule) {
- my %rulenames = &Apache::lonlocal::texthash(
- uc => 'At least one upper case letter',
- lc => 'At least one lower case letter',
- num => 'At least one number',
- spec => 'At least one non-alphanumeric',
- );
- $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
- $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
- $rulenames{'num'} .= ': 0123456789';
- $rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{|}~';
- $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
- $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
- my $warning = &mt('Password did not satisfy the following:').'<ul>';
- foreach my $rule ('min','max','uc','ls','num','spec') {
- if (grep(/^$rule$/, at brokerule)) {
- $warning .= '<li>'.$rulenames{$rule}.'</li>';
- }
- }
- $warning .= '</ul>';
+ my $warning = &Apache::loncommon::check_passwd_rule($domain,$newpass1);
+ if ($warning) {
&passwordchanger($r,'<span class="LC_warning">'.
$warning.
&mt('Please try again.').'</span>',
More information about the LON-CAPA-cvs
mailing list