--- loncom/interface/lonpreferences.pm 2001/12/19 17:17:46 1.2 +++ loncom/interface/lonpreferences.pm 2002/03/30 23:27:00 1.6 @@ -1,7 +1,7 @@ # The LearningOnline Network # Preferences # -# $Id: lonpreferences.pm,v 1.2 2001/12/19 17:17:46 albertel Exp $ +# $Id: lonpreferences.pm,v 1.6 2002/03/30 23:27:00 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,29 +35,402 @@ # # 3/1 Gerd Kortemeyer # +# 2/13/02 2/14 2/15 Matthew Hall +# +# This package uses the "londes.js" javascript code. +# +# TODOs that have to be completed: +# interface with lonnet to change the password + package Apache::lonpreferences; use strict; use Apache::Constants qw(:common); +use Apache::File; +use Crypt::DES; +use DynaLoader; # for Crypt::DES version +use Apache::loncommon(); + +# +# Write lonnet::passwd to do the call below. +# Use: +# my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver); +# +################################################## +# password associated functions # +################################################## +sub des_keys { + # 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=''; + for (0..7) { + $lkey.=$hexstr[rand(15)]; + } + my $ukey=''; + for (0..7) { + $ukey.=$hexstr[rand(15)]; + } + return ($lkey,$ukey); +} + +sub des_decrypt { + my ($key,$cyphertext) = @_; + my $keybin=pack("H16",$key); + my $cypher; + if ($Crypt::DES::VERSION>=2.03) { + $cypher=new Crypt::DES $keybin; + } else { + $cypher=new DES $keybin; + } + my $plaintext= + $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16)))); + $plaintext.= + $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16)))); + $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) ); + return $plaintext; +} + +################################################################ +# Handler subroutines # +################################################################ +sub screennamechanger { + my $r = shift; + my $errormessage = shift; + $errormessage = ($errormessage || ''); + my $user = $ENV{'user.name'}; + my $domain = $ENV{'user.domain'}; + my $homeserver = $ENV{'user.home'}; + my %userenv = &Apache::lonnet::get('environment',['screenname']); + my $screenname=$userenv{'screenname'}; + $r->print(< + +

Preferences for $user

+

$user is a member of domain $domain

+$errormessage +

+Change anonymous discussion screen name for $user +

+ +
+ +New screenname: + + +
+ + +ENDSCREEN +} + +sub verify_and_change_screenname { + my $r = shift; + my $user = $ENV{'user.name'}; + my $domain = $ENV{'user.domain'}; + my $homeserver = $ENV{'user.home'}; + my $newscreen = $ENV{'form.screenname'}; + $newscreen=~s/\W//g; + my $message=''; + if ($newscreen) { + my %tmp; + $tmp{'screenname'}=$newscreen; + &Apache::lonnet::put('environment',\%tmp); + $message='Set new screenname to '.$newscreen; + } else { + &Apache::lonnet::del('environment',['screenname']); + $message='Reset screenname'; + } + $r->print(< + +

Preferences for $user

+

$user is a member of domain $domain

+

+Change anonymous discussion screen name for $user +

+$message + +ENDVCSCREEN +} + +###################################################### +# 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'}; + my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain); + # Check for authentication types that allow changing of the password. + return if ($currentauth !~ /^(unix|internal):/); + # + # Generate keys + my ($lkey_cpass ,$ukey_cpass ) = &des_keys(); + my ($lkey_npass1,$ukey_npass1) = &des_keys(); + my ($lkey_npass2,$ukey_npass2) = &des_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 the keys for output as javascript variables + $ukey_cpass = hex($ukey_cpass); + $lkey_cpass = hex($lkey_cpass); + $ukey_npass1= hex($ukey_npass1); + $lkey_npass1= hex($lkey_npass1); + $ukey_npass2= hex($ukey_npass2); + $lkey_npass2= hex($lkey_npass2); + # Output javascript to deal with passwords + # Output DES javascript + { + my $include = $r->dir_config('lonIncludes'); + my $jsh=Apache::File->new($include."/londes.js"); + $r->print(<$jsh>); + } + $r->print(< + +

Preferences for $user

+

$user is a member of domain $domain

+$errormessage +

+Change password for $user +

+

+ + +

+ + + + + +
+ +
+ + + + + + + +
Current password:
New password:
Confirm password:
+ +
+ + + + + + +
+

+ENDFORM + # + return; +} + +sub verify_and_change_password { + my $r = shift; + my $user = $ENV{'user.name'}; + 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(< + +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 + 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. Please log out and try again. +

+ENDERROR + # Probably should log an error here + return; + } + my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo); + # + my $currentpass = &des_decrypt($ckey ,$currentpass); + my $newpass1 = &des_decrypt($n1key,$newpass1); + my $newpass2 = &des_decrypt($n2key,$newpass2); + # + if ($newpass1 ne $newpass2) { + &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 # +################################################################ sub handler { my $r = shift; + 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; - -# --------------------------------------------------- Print login screen header - $r->print(<print(< -The LearningOnline Network with CAPA +LON-CAPA Preferences - -

Preferences

- + +

Preferences for $user

+

$user is a member of domain $domain

+ENDHEADER + # Determine current authentication method + my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain); + if ($currentauth =~ /^(unix|internal):/) { + $r->print(< + + + +ENDPASSWORDFORM +# Change screen name + $r->print(< + + + +ENDSCREENNAMEFORM + # Other preference setting code should be added here + } + } + $r->print(< -ENDDOCUMENT +ENDFOOTER return OK; }