--- loncom/interface/lonpreferences.pm 2001/01/03 16:20:59 1.1
+++ loncom/interface/lonpreferences.pm 2004/03/08 17:31:37 1.36
@@ -1,6 +1,30 @@
# The LearningOnline Network
# Preferences
#
+# $Id: lonpreferences.pm,v 1.36 2004/03/08 17:31:37 www Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
+#
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
+#
# (Internal Server Error Handler
#
# (Login Screen
@@ -11,31 +35,811 @@
#
# 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();
+use Apache::lonhtmlcommon();
+use Apache::lonlocal;
+
+#
+# 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 separately.
+ # 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 #
+################################################################
+
+################################################################
+# Language Change Subroutines #
+################################################################
+sub languagechanger {
+ my $r = shift;
+ my $user = $ENV{'user.name'};
+ my $domain = $ENV{'user.domain'};
+ my %userenv = &Apache::lonnet::get
+ ('environment',['languages']);
+ my $language=$userenv{'languages'};
+
+ my $pref=&mt('Preferred language');
+ my %langchoices=('' => 'No language preference');
+ foreach (&Apache::loncommon::languageids()) {
+ if (&Apache::loncommon::supportedlanguagecode($_)) {
+ $langchoices{&Apache::loncommon::supportedlanguagecode($_)}
+ = &Apache::loncommon::plainlanguagedescription($_);
+ }
+ }
+ my $selectionbox=&Apache::loncommon::select_form($language,'language',
+ %langchoices);
+ $r->print(<
+
+ $pref: $selectionbox
+ENDLSCREEN
+ $r->print(' ');
+}
+
+
+sub verify_and_change_languages {
+ my $r = shift;
+ my $user = $ENV{'user.name'};
+ my $domain = $ENV{'user.domain'};
+# Screenname
+ my $newlanguage = $ENV{'form.language'};
+ $newlanguage=~s/[^\-\w]//g;
+ my $message='';
+ if ($newlanguage) {
+ &Apache::lonnet::put('environment',{'languages' => $newlanguage});
+ &Apache::lonnet::appenv('environment.languages' => $newlanguage);
+ $message='Set new preferred languages to '.$newlanguage;
+ } else {
+ &Apache::lonnet::del('environment',['languages']);
+ &Apache::lonnet::delenv('environment\.languages');
+ $message='Reset preferred language';
+ }
+ $r->print(<
+$message
+ENDVCSCREEN
+}
+
+
+################################################################
+# 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'};
+ $r->print(<
+
+ 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';
+ }
+
+ $r->print(<
+$message
+ENDVCSCREEN
+}
+
+################################################################
+# Message Forward #
+################################################################
+
+sub msgforwardchanger {
+ my $r = shift;
+ my $user = $ENV{'user.name'};
+ my $domain = $ENV{'user.domain'};
+ my %userenv = &Apache::lonnet::get('environment',['msgforward','notification','critnotification']);
+ my $msgforward=$userenv{'msgforward'};
+ my $notification=$userenv{'notification'};
+ my $critnotification=$userenv{'critnotification'};
+ my $forwardingHelp = Apache::loncommon::help_open_topic("Prefs_Forwarding",
+ "What are forwarding ".
+ "and notification ".
+ "addresses");
+ my $criticalMessageHelp = Apache::loncommon::help_open_topic("Course_Critical_Message",
+ "What are critical messages");
+
+ $r->print(<
+
+ENDMSG
+}
+
+sub verify_and_change_msgforward {
+ my $r = shift;
+ my $user = $ENV{'user.name'};
+ my $domain = $ENV{'user.domain'};
+ my $newscreen = '';
+ my $message='';
+ foreach (split(/\,/,$ENV{'form.msgforward'})) {
+ my ($msuser,$msdomain)=split(/[\@\:]/,$_);
+ $msuser=~s/\W//g;
+ $msdomain=~s/\W//g;
+ if (($msuser) && ($msdomain)) {
+ if (&Apache::lonnet::homeserver($msuser,$msdomain) ne 'no_host') {
+ $newscreen.=$msuser.':'.$msdomain.',';
+ } else {
+ $message.='No such user: '.$msuser.':'.$msdomain.' ';
+ }
+ }
+ }
+ $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 $notification=$ENV{'form.notification'};
+ $notification=~s/\s//gs;
+ if ($notification) {
+ &Apache::lonnet::put('environment',{'notification' => $notification});
+ &Apache::lonnet::appenv('environment.notification' => $notification);
+ $message.='Set message notification address to '.$notification.' ';
+ } else {
+ &Apache::lonnet::del('environment',['notification']);
+ &Apache::lonnet::delenv('environment\.notification');
+ $message.='Reset message notification ';
+ }
+ my $critnotification=$ENV{'form.critnotification'};
+ $critnotification=~s/\s//gs;
+ if ($critnotification) {
+ &Apache::lonnet::put('environment',{'critnotification' => $critnotification});
+ &Apache::lonnet::appenv('environment.critnotification' => $critnotification);
+ $message.='Set critical message notification address to '.$critnotification;
+ } else {
+ &Apache::lonnet::del('environment',['critnotification']);
+ &Apache::lonnet::delenv('environment\.critnotification');
+ $message.='Reset critical message notification ';
+ }
+ $r->print(<
+$message
+ENDVCMSG
+}
+
+################################################################
+# Colors #
+################################################################
+
+sub colorschanger {
+ 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 $chtable='';
+ foreach my $item (sort(keys(%colortypes))) {
+ my $curcol=&Apache::loncommon::designparm($function.'.'.$item,$domain);
+ $chtable.='
';
+ }
+ my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
+ $r->print(<
+
+ function pclose() {
+ parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
+ "height=350,width=350,scrollbars=no,menubar=no");
+ parmwin.close();
+ }
+
+ $pjump_def
+
+ function psub() {
+ pclose();
+ if (document.parmform.pres_marker.value!='') {
+ if (document.parmform.pres_type.value!='') {
+ eval('document.server.'+
+ document.parmform.pres_marker.value+
+ '.value=document.parmform.pres_value.value;');
+ }
+ } else {
+ document.parmform.pres_value.value='';
+ document.parmform.pres_marker.value='';
+ }
+ }
+
+
+
+
+
+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='';
+ foreach my $item (keys %colortypes) {
+ my $color=$ENV{'form.'.$item};
+ my $entry='color.'.$function.'.'.$item;
+ if (($color=~/^\#[0-9A-Fa-f]{6}$/) && (!$ENV{'form.resetall'})) {
+ &Apache::lonnet::put('environment',{$entry => $color});
+ &Apache::lonnet::appenv('environment.'.$entry => $color);
+ $message.='Set '.$colortypes{$item}.' to '.$color.' ';
+ } else {
+ &Apache::lonnet::del('environment',[$entry]);
+ &Apache::lonnet::delenv('environment\.'.$entry);
+ $message.='Reset '.$colortypes{$item}.' ';
+ }
+ }
+ $r->print(<
+$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>);
+ }
+ $r->print(<
+
+ function send() {
+ uextkey=this.document.client.elements.ukey_cpass.value;
+ lextkey=this.document.client.elements.lkey_cpass.value;
+ initkeys();
+
+ this.document.server.elements.currentpass.value
+ =crypted(this.document.client.elements.currentpass.value);
+
+ uextkey=this.document.client.elements.ukey_npass1.value;
+ lextkey=this.document.client.elements.lkey_npass1.value;
+ initkeys();
+ this.document.server.elements.newpass_1.value
+ =crypted(this.document.client.elements.newpass_1.value);
+
+ uextkey=this.document.client.elements.ukey_npass2.value;
+ lextkey=this.document.client.elements.lkey_npass2.value;
+ initkeys();
+ this.document.server.elements.newpass_2.value
+ =crypted(this.document.client.elements.newpass_2.value);
+
+ this.document.server.submit();
+ }
+
+
+$errormessage
+
+
+
+
+
+
+
+
+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
+
+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");
+