--- loncom/interface/lonpreferences.pm 2002/02/15 22:04:39 1.3 +++ loncom/interface/lonpreferences.pm 2002/02/19 21:50:40 1.4 @@ -1,7 +1,7 @@ # The LearningOnline Network # Preferences # -# $Id: lonpreferences.pm,v 1.3 2002/02/15 22:04:39 matthew Exp $ +# $Id: lonpreferences.pm,v 1.4 2002/02/19 21:50:40 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -49,50 +49,22 @@ use Apache::Constants qw(:common); use Apache::File; use Crypt::DES; use DynaLoader; # for Crypt::DES version +use Apache::loncommon(); -#------------------- forms to be output -my $passwordform =< - - - -ENDPASSWORDFORM - -my $environmentform = < -There are currently no environment variables you can change. -

- -ENDENVIRONMENTFORM -#------------------ end of forms to be output - -################################################################ -# Handler subroutines # -################################################################ # # Write lonnet::passwd to do the call below. # Use: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver); # -# I really should write some javascript to check on the client side for -# mismatched passwords, but other problems are more pressing -# ################################################## # password associated functions # ################################################## sub des_keys { - # Make a new key for DES encryption - # Each key has two parts which are returned seperately + # Make a new key for DES encryption. + # Each key has two parts which are returned seperately. + # Please note: Each key must be passed through the &hex function + # before it is output to the web browser. The hex versions cannot + # be used to decrypt. my @hexstr=('0','1','2','3','4','5','6','7', '8','9','a','b','c','d','e','f'); my $lkey=''; @@ -119,16 +91,23 @@ sub des_decrypt { $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16)))); $plaintext.= $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16)))); - $plaintext=unpack("a8",$plaintext); - $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1))); - unpack("a8",$plaintext); + $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) ); return $plaintext; } +################################################################ +# Handler subroutines # +################################################################ + +###################################################### +# password handler subroutines # +###################################################### sub passwordchanger { + # This function is a bit of a mess.... # Passwords are encrypted using londes.js (DES encryption) - # my $r = shift; + my $errormessage = shift; + $errormessage = ($errormessage || ''); my $user = $ENV{'user.name'}; my $domain = $ENV{'user.domain'}; my $homeserver = $ENV{'user.home'}; @@ -140,14 +119,14 @@ sub passwordchanger { my ($lkey_cpass ,$ukey_cpass ) = &des_keys(); my ($lkey_npass1,$ukey_npass1) = &des_keys(); my ($lkey_npass2,$ukey_npass2) = &des_keys(); - # Store the keys + # Store the keys in the log files my $lonhost = $r->dir_config('lonHostID'); my $logtoken=Apache::lonnet::reply('tmpput:' .$ukey_cpass . $lkey_cpass .'&' .$ukey_npass1 . $lkey_npass1.'&' .$ukey_npass2 . $lkey_npass2, $lonhost); - # Hexify these keys + # Hexify the keys for output as javascript variables $ukey_cpass = hex($ukey_cpass); $lkey_cpass = hex($lkey_cpass); $ukey_npass1= hex($ukey_npass1); @@ -155,13 +134,7 @@ sub passwordchanger { $ukey_npass2= hex($ukey_npass2); $lkey_npass2= hex($lkey_npass2); # Output javascript to deal with passwords - $r->print(< - -The LearningOnline Network with CAPA - -ENDHEADER - # Output DES javascript + # Output DES javascript { my $include = $r->dir_config('lonIncludes'); my $jsh=Apache::File->new($include."/londes.js"); @@ -199,6 +172,7 @@ ENDHEADER

Preferences for $user

$user is a member of domain $domain

+$errormessage

Change password for $user

@@ -211,23 +185,23 @@ Change password for $user - - + +
- - - - - - + + + + + +
Current password:
New password:
Confirm password:
Current password:
New password:
Confirm password:
- - + + @@ -245,47 +219,105 @@ sub verify_and_change_password { my $domain = $ENV{'user.domain'}; my $homeserver = $ENV{'user.home'}; my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain); + # Check for authentication types that allow changing of the password. + return if ($currentauth !~ /^(unix|internal):/); # - $r->print("

verify and change password

\n"); + $r->print(< + +LON-CAPA Preferences: Change password for $user + +ENDHEADER # my $currentpass = $ENV{'form.currentpass'}; my $newpass1 = $ENV{'form.newpass_1'}; my $newpass2 = $ENV{'form.newpass_2'}; my $logtoken = $ENV{'form.logtoken'}; # Check for empty data - if (!(defined($currentpass) && - defined($newpass1) && - defined($newpass2))){ - $r->print("ERROR Password data was ". - "blank.\n"); + unless (defined($currentpass) && + defined($newpass1) && + defined($newpass2) ){ + &passwordchanger($r,"

\nERROR". + "Password data was blank.\n

"); return; } # Get the keys my $lonhost = $r->dir_config('lonHostID'); my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost); if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) { + # I do not a have a better idea about how to handle this $r->print(< ERROR: Unable to retrieve stored token for -password decryption. +password decryption. Please log out and try again.

ENDERROR + # Probably should log an error here return; } my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo); - # decrypt + # my $currentpass = &des_decrypt($ckey ,$currentpass); my $newpass1 = &des_decrypt($n1key,$newpass1); my $newpass2 = &des_decrypt($n2key,$newpass2); - # Sanity check + # if ($newpass1 ne $newpass2) { - $r->print('ERROR:The new passwords you '. - 'entered do not match. Please try again.'); - &passwordchanger($r); + &passwordchanger($r, + 'ERROR:'. + 'The new passwords you entered do not match. '. + 'Please try again.'); + return; + } + if (length($newpass1) < 7) { + &passwordchanger($r, + 'ERROR:'. + 'Passwords must be a minimum of 7 characters long. '. + 'Please try again.'); return; } + # + # Check for bad characters + my $badpassword = 0; + foreach (split(//,$newpass1)) { + $badpassword = 1 if ((ord($_)<32)||(ord($_)>126)); + } + if ($badpassword) { + # I can't figure out how to enter bad characters on my browser. + &passwordchanger($r,<ERROR: +The password you entered contained illegal characters.
+Valid characters are: space and
+
+!"\#$%&\'()*+,-./0123456789:;<=>?\@
+ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_\`abcdefghijklmnopqrstuvwxyz{|}~
+
+ENDERROR + } + # + # Change the password (finally) + my $result = &Apache::lonnet::changepass + ($user,$domain,$currentpass,$newpass1,$homeserver); + # Inform the user the password has (not?) been changed + if ($result =~ /^ok$/) { + $r->print(<<"ENDTEXT"); +

Password for $user was successfully changed

+ENDTEXT + } else { + # error error: run in circles, scream and shout + $r->print(<Password for $user was not changed +There was an internal error when attempting to change your password. +Please contact your instructor or the domain coordinator. +ENDERROR + } + return; } +###################################################### +# other handler subroutines # +###################################################### + + ################################################################ # Main handler # ################################################################ @@ -294,6 +326,8 @@ sub handler { my $user = $ENV{'user.name'}; my $domain = $ENV{'user.domain'}; $r->content_type('text/html'); + # Some pages contain DES keys and should not be cached. + &Apache::loncommon::no_cache($r); $r->send_http_header; return OK if $r->header_only; # Spit out the header @@ -305,7 +339,7 @@ sub handler { $r->print(< -The LearningOnline Network with CAPA +LON-CAPA Preferences

Preferences for $user

@@ -314,11 +348,15 @@ ENDHEADER # Determine current authentication method my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain); if ($currentauth =~ /^(unix|internal):/) { - $r->print($passwordform); + $r->print(< + + + +ENDPASSWORDFORM + # Other preference setting code should be added here } - $r->print($environmentform); } - # Spit out the footer $r->print(<