--- loncom/interface/lonpreferences.pm 2001/12/19 17:17:46 1.2 +++ loncom/interface/lonpreferences.pm 2003/04/19 01:34:22 1.19 @@ -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.19 2003/04/19 01:34:22 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,31 +35,603 @@ # # 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 # +################################################################ + +################################################################ +# Anonymous Discussion Name Change Subroutines # +################################################################ +sub screennamechanger { + my $r = shift; + my $user = $ENV{'user.name'}; + my $domain = $ENV{'user.domain'}; + my %userenv = &Apache::lonnet::get + ('environment',['screenname','nickname']); + my $screenname=$userenv{'screenname'}; + my $nickname=$userenv{'nickname'}; + my $bodytag=&Apache::loncommon::bodytag( + 'Change Your Nickname and Anonymous Screen Name'); + $r->print(< +$bodytag + +
+ +
New screenname (shown if you post anonymously): + +
New nickname (shown if you post non-anonymously): + + +
+ + +ENDSCREEN +} + +sub verify_and_change_screenname { + my $r = shift; + my $user = $ENV{'user.name'}; + my $domain = $ENV{'user.domain'}; +# Screenname + my $newscreen = $ENV{'form.screenname'}; + $newscreen=~s/[^ \w]//g; + my $message=''; + if ($newscreen) { + &Apache::lonnet::put('environment',{'screenname' => $newscreen}); + &Apache::lonnet::appenv('environment.screenname' => $newscreen); + $message='Set new screenname to '.$newscreen; + } else { + &Apache::lonnet::del('environment',['screenname']); + &Apache::lonnet::delenv('environment\.screenname'); + $message='Reset screenname'; + } +# Nickname + $message.='
'; + $newscreen = $ENV{'form.nickname'}; + $newscreen=~s/[^ \w]//g; + if ($newscreen) { + &Apache::lonnet::put('environment',{'nickname' => $newscreen}); + &Apache::lonnet::appenv('environment.nickname' => $newscreen); + $message.='Set new nickname to '.$newscreen; + } else { + &Apache::lonnet::del('environment',['nickname']); + &Apache::lonnet::delenv('environment\.nickname'); + $message.='Reset nickname'; + } + my $bodytag=&Apache::loncommon::bodytag( + 'Change Your Nickname and Anonymous Screen Name'); + $r->print(< +$bodytag +

+$message + +ENDVCSCREEN +} + +################################################################ +# Colors # +################################################################ + +sub colorschanger { + my $r = shift; + my $bodytag=&Apache::loncommon::bodytag( + 'Change Color Scheme for Current Role Type'); +# figure out colors + my $function='student'; + if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) { + $function='coordinator'; + } + if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) { + $function='admin'; + } + if (($ENV{'request.role'}=~/^(au|ca)/) || + ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) { + $function='author'; + } + my $domain=&Apache::loncommon::determinedomain(); + my %colortypes=('pgbg' => 'Page Background', + 'tabbg' => 'Header Background', + 'sidebg'=> 'Header Border', + 'font' => 'Font', + 'link' => 'Un-Visited Link', + 'vlink' => 'Visited Link', + 'alink' => 'Active Link'); + my $chtable=''; + foreach my $item (keys %colortypes) { + my $curcol=&Apache::loncommon::designparm($function.'.'.$item,$domain); + $chtable.=''.$colortypes{$item}.'      Select'; + } + $r->print(< + +$bodytag + +
+ + +$chtable +
+ +
+ + +ENDCOL +} + +sub verify_and_change_colors { + my $r = shift; +# figure out colors + my $function='student'; + if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) { + $function='coordinator'; + } + if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) { + $function='admin'; + } + if (($ENV{'request.role'}=~/^(au|ca)/) || + ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) { + $function='author'; + } + my $domain=&Apache::loncommon::determinedomain(); + my %colortypes=('pgbg' => 'Page Background', + 'tabbg' => 'Header Background', + 'sidebg'=> 'Header Border', + 'font' => 'Font', + 'link' => 'Un-Visited Link', + 'vlink' => 'Visited Link', + 'alink' => 'Active Link'); + + my $message=''; +# my $newscreen=''; +# $newscreen=~s/\,$//; +# if ($newscreen) { +# &Apache::lonnet::put('environment',{'msgforward' => $newscreen}); +# &Apache::lonnet::appenv('environment.msgforward' => $newscreen); +# $message.='Set new message forwarding to '.$newscreen.'
'; +# } else { +# &Apache::lonnet::del('environment',['msgforward']); +# &Apache::lonnet::delenv('environment\.msgforward'); +# $message.='Reset message forwarding
'; +# } + + my $bodytag=&Apache::loncommon::bodytag( + 'Change Color Scheme for Current Role Type'); + $r->print(< +$bodytag +

+$message + +ENDVCCOL +} + +###################################################### +# 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 + $r->print(""); + { + my $include = $r->dir_config('lonIncludes'); + my $jsh=Apache::File->new($include."/londes.js"); + $r->print(<$jsh>); + } + my $bodytag=&Apache::loncommon::bodytag('Change Password','', + 'onLoad="init();"'); + $r->print(< +$bodytag + + +$errormessage + +

+ + +

+ + + + + +
+ +
+ + + + + + + +
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); + # + $currentpass = &des_decrypt($ckey ,$currentpass); + $newpass1 = &des_decrypt($n1key,$newpass1); + $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"); +

The password for $user was successfully changed

+ENDTEXT + } else { + # error error: run in circles, scream and shout + $r->print(<The password for $user was not changed +Please make sure your old password was entered correctly. +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(< 1); + } + } + } else { + $r->print(< -The LearningOnline Network with CAPA +LON-CAPA Preferences - -

Preferences

- +ENDHEADER + $r->print(&Apache::loncommon::bodytag('Change Your Preferences')); + # Determine current authentication method + my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain); + if ($currentauth =~ /^(unix|internal):/) { + $r->print(< + + + +ENDPASSWORDFORM + } +# Change screen name + $r->print(< + + + +ENDSCREENNAMEFORM + $r->print(< + + + +ENDMSGFORWARDFORM +# The "about me" page + my $aboutmeaction= + '/adm/'.$ENV{'user.domain'}.'/'.$ENV{'user.name'}.'/aboutme'; + $r->print(< + + + +ENDABOUTME + $r->print(< + + + +ENDCOLORFORM + + if ($ENV{'user.name'} eq 'albertel') { + $r->print(< + + +Current Debug status is -$ENV{'user.debug'}-. + +ENDDEBUG + } + # Other preference setting code should be added here + } + $r->print(< -ENDDOCUMENT +ENDFOOTER return OK; -} +} 1; __END__