--- loncom/interface/lonpreferences.pm 2001/12/19 17:17:46 1.2 +++ loncom/interface/lonpreferences.pm 2002/02/15 22:04:39 1.3 @@ -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.3 2002/02/15 22:04:39 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,29 +35,294 @@ # # 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 + +#------------------- 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 + 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=unpack("a8",$plaintext); + $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1))); + unpack("a8",$plaintext); + return $plaintext; +} + +sub passwordchanger { + # Passwords are encrypted using londes.js (DES encryption) + # + 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):/); + # + # 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 + 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 + $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 + $r->print(< + +The LearningOnline Network with CAPA + +ENDHEADER + # 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

+

+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); + # + $r->print("

verify and change password

\n"); + # + 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"); + 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')) { + $r->print(< +ERROR: Unable to retrieve stored token for +password decryption. +

+ENDERROR + 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); + return; + } +} + +################################################################ +# Main handler # +################################################################ sub handler { my $r = shift; + my $user = $ENV{'user.name'}; + my $domain = $ENV{'user.domain'}; $r->content_type('text/html'); $r->send_http_header; return OK if $r->header_only; - -# --------------------------------------------------- Print login screen header - $r->print(<print(< The LearningOnline Network with CAPA - -

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($passwordform); + } + $r->print($environmentform); + } + # Spit out the footer + $r->print(< -ENDDOCUMENT +ENDFOOTER return OK; }