[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