loncom/enrollment/Enrollment.pm - diff

Return to Enrollment.pm CVS log

Up to [LON-CAPA] / loncom / enrollment

Diff for /loncom/enrollment/Enrollment.pm between versions 1.52 and 1.55

-version 1.52, 2017/10/27 13:35:37
+version 1.55, 2021/09/08 12:13:13
  Line 31  use Apache::loncommon();
  use Apache::lonmsg;
  use Apache::lonlocal;
  use HTML::Entities;
+ use HTML::Parser;
  use LONCAPA::Configuration;
+ use Math::Random;
  use Time::Local;
  use lib '/home/httpd/lib/perl';
- Line 329  sub update_LC {
+ Line 331  sub update_LC {
                      }
                  }
  # Check for institutional section change
-                 if (($$currlist{$uname}[$instidx] ne $instsec) && (!$added)) {
+                 if (($$currlist{$uname}[$instidx] ne $instsec) && (!$added) && ($$currlist{$uname}[$type] eq "auto")) {
                      my $modify_instsec_result =
                          &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid,'',$context,$credits,$instsec);
                      if ($modify_instsec_result =~ /^ok/) {
- Line 586  sub create_newuser {
+ Line 588  sub create_newuser {
  # If no account exists and passwords should be generated
      if ($auth eq "internal") {
          if ($authparam eq '') {
-             $authparam = &create_password();
+             $authparam = &create_password($udom);
              if ($authparam eq '') {
                  $authchk = '';
              } else {
- Line 950  sub process_date {
+ Line 952  sub process_date {
  }
  sub create_password {
-     my $passwd = '';
+     my ($udom) = @_;
-     my @letts = ("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z");
+     my %passwdconf = &Apache::lonnet::get_passwdconf($udom);
-     for (my $i=0; $i<8; $i++) {
+     my ($min,$max,@chars);
+     $min = $Apache::lonnet::passwdmin;
+     if (ref($passwdconf{'chars'}) eq 'ARRAY') {
+         if ($passwdconf{'min'} =~ /^\d+$/) {
+             if ($passwdconf{'min'} > $min) {
+                 $min = $passwdconf{'min'};
+             }
+         }
+         if ($passwdconf{'max'} =~ /^\d+$/) {
+             $max = $passwdconf{'max'};
+         }
+         @chars = @{$passwdconf{'chars'}};
+     }
+     my @letts = qw(b c d f g h j k l m n p q r s t v w x y z);
+     my (@included,%reqd);
+     if (@chars) {
+         map { $reqd{$_} = 1; } @chars;
+     }
+     if ($reqd{'uc'}) {
+         my $letter = $letts[int( rand(21) )];
+         $letter =~ tr/a-z/A-Z/;
+         if ($letter ne '') {
+             push(@included,$letter);
+         }
+     }
+     if ($reqd{'lc'}) {
+         my $letter = $letts[int( rand(21) )];
+         if ($letter ne '') {
+             push(@included,$letter);
+         }
+     }
+     if ($reqd{'num'}) {
+         my $number = int( rand(10) );
+         if ($number ne '') {
+             push(@included,$number);
+         }
+     }
+     if ($reqd{'spec'}) {
+         my @specs = qw(! # * & _ - + $);
+         my $special = $specs[int( rand(8) )];
+         if ($special ne '') {
+             push(@included,$special);
+         }
+     }
+     my $start = 0;
+     if (scalar(@included) > 0) {
+         $start = scalar(@included);
+     }
+     my $end = 8;
+     if ($min =~ /^\d+$/) {
+         if ($min > $end) {
+             $end = $min;
+         }
+     }
+     for (my $i=$start; $i<$end; $i++) {
          my $lettnum = int (rand 2);
          my $item = '';
          if ($lettnum) {
-             $item = $letts[int( rand(26) )];
+             $item = $letts[int( rand(21) )];
              my $uppercase = int(rand 2);
              if ($uppercase) {
                  $item =~ tr/a-z/A-Z/;
              }
          } else {
              $item = int( rand(10) );
          }
-         $passwd .= $item;
+         if ($item ne '') {
+             push(@included,$item);
+         }
      }
-     return ($passwd);
+     my $passwd = join('',&Math::Random::random_permutation(@included));
+     return $passwd;
  }
  sub get_courseinfo {

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.52
changed lines
	Added in v.1.55