# The LearningOnline Network
# Preferences
#
# $Id: lonpreferences.pm,v 1.109 2007/07/17 21:11:49 albertel 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/
#
# 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 LONCAPA;
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;
use Apache::lonnet;
use LONCAPA();
#
# 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 wysiwygchanger {
my $r = shift;
my %userenv = &Apache::lonnet::get
('environment',['wysiwygeditor']);
my $onselect='checked="checked"';
my $offselect='';
if ($userenv{'wysiwygeditor'} eq 'on') {
$onselect='';
$offselect='checked="checked"';
}
my $switchoff=&mt('Disable WYSIWYG editor');
my $switchon=&mt('Enable WYSIWYG editor');
$r->print(< '.&mt('Setting WYSIWYG editor to:').' '.&mt($newsetting).' TeX to HTML jsMath Convert to Images '.&mt('Some LON-CAPA users have a long list of '.$lc_role.'s. The Recent '.$role.'s Hotlist feature keeps track of the last N '.$lc_role.'s which have been visited and places a table of these at the top of the '.$lc_role.'s page. People with very few '.$lc_role.'s should leave this feature disabled.').'
ENDLSCREEN
$r->print('
');
}
sub verify_and_change_wysiwyg {
my $r = shift;
my $newsetting=$env{'form.wysiwyg'};
&Apache::lonnet::put('environment',{'wysiwygeditor' => $newsetting});
&Apache::lonnet::appenv('environment.wysiwygeditor' => $newsetting);
$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(<
$jsMath_start
".&mt($role)."".
&Apache::loncommon::end_data_table_header_row().
"\n";
my $count;
foreach $role_key (@sorted_roles) {
my $checked = "";
my $value = $recent_roles{$role_key};
if ($frozen_roles{$role_key}) {
$checked = "checked=\"checked\"";
}
$count++;
$roles_check_list .=
&Apache::loncommon::start_data_table_row().
' '.
" ".
"".
&Apache::loncommon::end_data_table_row(). "\n";
}
$roles_check_list .= "\n";
}
$r->print('
';
if ($hotlist_flag) {
&Apache::lonnet::put('environment',{'recentroles' => $hotlist_flag});
&Apache::lonnet::appenv('environment.recentroles' => $hotlist_flag);
$message=&mt('Recent '.$role.'s Hotlist is Enabled');
} else {
&Apache::lonnet::del('environment',['recentroles']);
&Apache::lonnet::delenv('environment\.recentroles');
$message=&mt('Recent '.$role.'s Hotlist is Disabled');
}
if ($hotlist_n) {
&Apache::lonnet::put('environment',{'recentrolesn' => $hotlist_n});
&Apache::lonnet::appenv('environment.recentrolesn' => $hotlist_n);
if ($hotlist_flag) {
$message.="
".
&mt('Display [_1] Most Recent '.$role.'s',$hotlist_n)."\n";
}
}
# Get list of froze roles and list of recent roles
my @freeze_list = &Apache::loncommon::get_env_multiple('form.freezeroles');
my %freeze = ();
my %roletext = ();
foreach my $key (@freeze_list) {
$freeze{$key}='1';
}
my %recent_roles =
&Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
my %frozen_roles =
&Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
my %role_text = &rolespref_get_role_text([keys(%recent_roles)]);
# Unset any roles that were previously frozen but aren't in list
foreach my $role_key (sort(keys(%recent_roles))) {
if (($frozen_roles{$role_key}) && (!exists($freeze{$role_key}))) {
$message .= "
".&mt('Unfreezing '.$role.': [_1]',$role_text{$role_key})."\n";
&Apache::lonhtmlcommon::store_recent('roles',$role_key,' ',0);
}
}
# Freeze selected roles
foreach my $role_key (@freeze_list) {
if (!$frozen_roles{$role_key}) {
$message .= "
".&mt('Freezing '.$role.': [_1]',$role_text{$role_key})."\n";
&Apache::lonhtmlcommon::store_recent('roles',
$role_key,' ',1);
}
}
$message .= "
\n";
$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';
}
&Apache::lonnet::devalidate_cache_new('namescache',$user.':'.$domain);
$r->print(<
ENDSCREEN
}
sub verify_and_change_icons {
my $r = shift;
my $user = $env{'user.name'};
my $domain = $env{'user.domain'};
my $newicons = $env{'form.menumode'};
&Apache::lonnet::put('environment',{'icons' => $newicons});
&Apache::lonnet::appenv('environment.icons' => $newicons);
$r->print(&mt('Set menu mode to [_1].',$newicons));
}
################################################################
# Clicker Subroutines #
################################################################
sub clickerchanger {
my $r = shift;
my $user = $env{'user.name'};
my $domain = $env{'user.domain'};
my %userenv = &Apache::lonnet::get
('environment',['clickers']);
my $clickers=$userenv{'clickers'};
$clickers=~s/\,/\n/gs;
my $text=&mt('Enter response device ("clicker") numbers');
my $change=&mt('Register');
my $helplink=&Apache::loncommon::help_open_topic('Clicker_Registration', 'Locating your clicker ID');
$r->print(<
$criticalMessageHelp
$lt{'mnot'} (joe\@doe.com):
ENDMSG
my @sortforwards = sort (keys(%allnot));
my $output = &Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_header_row().
' '.
''.&mt('Action').' '.
''.&mt('Notification address').' '.
&mt('Types of message to forward to this address').' '.
&mt('Excerpt retains HTML tags in message').' '.
&Apache::loncommon::end_data_table_header_row();
my $num = 0;
my $counter = 1;
foreach my $item (@sortforwards) {
$output .= &Apache::loncommon::start_data_table_row().
''.$counter.' '.
' '.
' '.
'';
my %chk;
if (defined($allnot{$item}{'crit'})) {
if (defined($allnot{$item}{'reg'})) {
$chk{'all'} = 'checked="checked" ';
} else {
$chk{'crit'} = 'checked="checked" ';
}
} else {
$chk{'reg'} = 'checked="checked" ';
}
foreach my $type ('all','crit','reg') {
$output .= ' ';
}
my $htmlon = '';
my $htmloff = '';
if (grep/^\Q$item\E/,@allow_html) {
$htmlon = 'checked="checked" ';
} else {
$htmloff = 'checked="checked" ';
}
$output .= ' '.
' '.
&Apache::loncommon::end_data_table_row();
$num ++;
$counter ++;
}
my %defchk = (
all => 'checked="checked" ',
crit => '',
reg => '',
);
$output .= &Apache::loncommon::start_data_table_row().
''.$counter.' '.
''.
' ';
foreach my $type ('all','crit','reg') {
$output .= ' ';
}
$output .= ' '.
' '.
&Apache::loncommon::end_data_table_row().
&Apache::loncommon::end_data_table();
$num ++;
$r->print($output);
$r->print(qq|
|);
}
sub get_notifications {
my ($userenv) = @_;
my %allnot;
my @critnot = split(/,/,$userenv->{'critnotification'});
my @regnot = split(/,/,$userenv->{'notification'});
foreach my $item (@critnot) {
$allnot{$item}{crit} = 1;
}
foreach my $item (@regnot) {
$allnot{$item}{reg} = 1;
}
return %allnot;
}
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 = &LONCAPA::clean_username($msuser);
$msdomain = &LONCAPA::clean_domain($msdomain);
if (($msuser) && ($msdomain)) {
if (&Apache::lonnet::homeserver($msuser,$msdomain) ne 'no_host') {
$newscreen.=$msuser.':'.$msdomain.',';
} else {
$message.= &mt('No such user: ').$msuser.':'.$msdomain.'
';
}
}
}
$newscreen=~s/\,$//;
if ($newscreen) {
&Apache::lonnet::put('environment',{'msgforward' => $newscreen});
&Apache::lonnet::appenv('environment.msgforward' => $newscreen);
$message .= &mt('Set message forwarding to: ').''.$newscreen.
'
';
} else {
&Apache::lonnet::del('environment',['msgforward']);
&Apache::lonnet::delenv('environment\.msgforward');
$message.= &mt("Set message forwarding to 'off'.").'
';
}
my $critnotification;
my $notification;
my $notify_with_html;
my $lastnotify = $env{'form.numnotify'}-1;
my $totaladdresses = 0;
for (my $i=0; $i<$env{'form.numnotify'}; $i++) {
if ((!defined($env{'form.del_notify_'.$i})) &&
((($i==$lastnotify) && ($env{'form.add_notify_'.$lastnotify} == 1)) ||
($i<$lastnotify))) {
if (defined($env{'form.address_'.$i})) {
if ($env{'form.notify_type_'.$i} eq 'all') {
$critnotification .= $env{'form.address_'.$i}.',';
$notification .= $env{'form.address_'.$i}.',';
} elsif ($env{'form.notify_type_'.$i} eq 'crit') {
$critnotification .= $env{'form.address_'.$i}.',';
} elsif ($env{'form.notify_type_'.$i} eq 'reg') {
$notification .= $env{'form.address_'.$i}.',';
}
if ($env{'form.html_'.$i} eq '1') {
$notify_with_html .= $env{'form.address_'.$i}.',';
}
$totaladdresses ++;
}
}
}
$critnotification =~ s/,$//;
$critnotification=~s/\s//gs;
$notification =~ s/,$//;
$notification=~s/\s//gs;
$notify_with_html =~ s/,$//;
$notify_with_html =~ s/\s//gs;
if ($notification) {
&Apache::lonnet::put('environment',{'notification' => $notification});
&Apache::lonnet::appenv('environment.notification' => $notification);
$message.=&mt('Set non-critical message notification address(es) to: ').''.$notification.'
';
} else {
&Apache::lonnet::del('environment',['notification']);
&Apache::lonnet::delenv('environment\.notification');
$message.=&mt("Non-critical message notification set to 'off'.").'
';
}
if ($critnotification) {
&Apache::lonnet::put('environment',{'critnotification' => $critnotification});
&Apache::lonnet::appenv('environment.critnotification' => $critnotification);
$message.=&mt('Set critical message notification address(es) to: ').''.$critnotification.'
';
} else {
&Apache::lonnet::del('environment',['critnotification']);
&Apache::lonnet::delenv('environment\.critnotification');
$message.=&mt("Critical message notification set to 'off'.").'
';
}
if ($critnotification || $notification) {
if ($notify_with_html) {
&Apache::lonnet::put('environment',{'notifywithhtml' => $notify_with_html});
&Apache::lonnet::appenv('environment.notifywithhtml' => $notify_with_html);
$message.=&mt('Set address(es) to receive excerpts with html retained: ').''.$notify_with_html.'';
} else {
&Apache::lonnet::del('environment',['notifywithhtml']);
&Apache::lonnet::delenv('environment\.notifywithhtml');
if ($totaladdresses == 1) {
$message.=&mt("Set notification address to receive excerpts with html stripped.");
} else {
$message.=&mt("Set all notification addresses to receive excerpts with html stripped.");
}
}
} else {
&Apache::lonnet::del('environment',['notifywithhtml']);
&Apache::lonnet::delenv('environment\.notifywithhtml');
}
if ($message) {
$message .= '
';
}
&Apache::loncommon::flush_email_cache($user,$domain);
&msgforwardchanger($r,$message);
}
################################################################
# Colors #
################################################################
sub colorschanger {
my $r = shift;
# figure out colors
my $function=&Apache::loncommon::get_users_function();
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 $start_data_table = &Apache::loncommon::start_data_table();
my $chtable='';
foreach my $item (sort(keys(%colortypes))) {
my $curcol=&Apache::loncommon::designparm($function.'.'.$item,$domain);
$chtable.=&Apache::loncommon::start_data_table_row().
''.$colortypes{$item}.' Select '.
&Apache::loncommon::end_data_table_row()."\n";
}
my $end_data_table = &Apache::loncommon::end_data_table();
my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
$r->print(<
';
} else {
&Apache::lonnet::del('environment',[$entry]);
&Apache::lonnet::delenv('environment\.'.$entry);
$message.='Reset '.$colortypes{$item}.'
';
}
}
my $now = time;
&Apache::lonnet::put('environment',{'color.timestamp' => $now});
&Apache::lonnet::appenv('environment.color.timestamp' => $now);
$r->print(<
');
return;
}
} else {
$r->print(&mt('Sorry, the URL generated when you requested reset of your password contained incomplete information.').'
');
return;
}
} else {
$r->print(&mt('Page requested in unexpected context').'
');
return;
}
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
my %hexkey;
$hexkey{'ukey_cpass'} = hex($ukey_cpass);
$hexkey{'lkey_cpass'} = hex($lkey_cpass);
$hexkey{'ukey_npass1'} = hex($ukey_npass1);
$hexkey{'lkey_npass1'} = hex($lkey_npass1);
$hexkey{'ukey_npass2'} = hex($ukey_npass2);
$hexkey{'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(&jscript_send($caller));
$r->print(<
\n". &mt("Invalid username and/or domain")."\n
", $caller,$mailtoken); return 1; } } else { &passwordchanger($r,"\n". &mt("Username and domain were blank")."\n
", $caller,$mailtoken); return 1; } } else { $user = $env{'user.name'}; $domain = $env{'user.domain'}; $homeserver = $env{'user.home'}; } my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain); # Check for authentication types that allow changing of the password. if ($currentauth !~ /^(unix|internal):/) { if ($caller eq 'reset_by_email') { &passwordchanger($r,"\n". &mt("Authentication type for this user can not be changed by this mechanism"). "\n
", $caller,$mailtoken); return 1; } else { return; } } # 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,"\n". &mt("One or more password fields were blank"). "\n
",$caller,$mailtoken); 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 my $tryagain_text = &mt('Please log out and try again.'); if ($caller eq 'reset_by_email') { $tryagain_text = &mt('Please try again later.'); } my $unable=&mt("Unable to retrieve saved token for password decryption"); $r->print(<!"\#$%&\'()*+,-./0123456789:;<=>?\@ ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_\`abcdefghijklmnopqrstuvwxyz{|}~ENDERROR &passwordchanger($r,$errormessage,$caller,$mailtoken); return 1; } # # Change the password (finally) my $result = &Apache::lonnet::changepass ($user,$domain,$currentpass,$newpass1,$homeserver,$caller); # Inform the user the password has (not?) been changed if ($result =~ /^ok$/) { $r->print("
'.$helplink.' | '. ''.$optiontext.' | '. '