Annotation of loncom/interface/lonpreferences.pm, revision 1.51
1.1 www 1: # The LearningOnline Network
2: # Preferences
3: #
1.51 ! foxr 4: # $Id: lonpreferences.pm,v 1.50 2004/11/19 20:17:52 albertel Exp $
1.2 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.3 matthew 28: # This package uses the "londes.js" javascript code.
29: #
30: # TODOs that have to be completed:
31: # interface with lonnet to change the password
32:
1.1 www 33: package Apache::lonpreferences;
34:
35: use strict;
36: use Apache::Constants qw(:common);
1.3 matthew 37: use Apache::File;
38: use Crypt::DES;
39: use DynaLoader; # for Crypt::DES version
1.4 matthew 40: use Apache::loncommon();
1.23 matthew 41: use Apache::lonhtmlcommon();
1.32 www 42: use Apache::lonlocal;
1.3 matthew 43:
44: #
45: # Write lonnet::passwd to do the call below.
46: # Use:
47: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
48: #
49: ##################################################
50: # password associated functions #
51: ##################################################
52: sub des_keys {
1.4 matthew 53: # Make a new key for DES encryption.
1.36 www 54: # Each key has two parts which are returned separately.
1.4 matthew 55: # Please note: Each key must be passed through the &hex function
56: # before it is output to the web browser. The hex versions cannot
57: # be used to decrypt.
1.3 matthew 58: my @hexstr=('0','1','2','3','4','5','6','7',
59: '8','9','a','b','c','d','e','f');
60: my $lkey='';
61: for (0..7) {
62: $lkey.=$hexstr[rand(15)];
63: }
64: my $ukey='';
65: for (0..7) {
66: $ukey.=$hexstr[rand(15)];
67: }
68: return ($lkey,$ukey);
69: }
70:
71: sub des_decrypt {
72: my ($key,$cyphertext) = @_;
73: my $keybin=pack("H16",$key);
74: my $cypher;
75: if ($Crypt::DES::VERSION>=2.03) {
76: $cypher=new Crypt::DES $keybin;
77: } else {
78: $cypher=new DES $keybin;
79: }
80: my $plaintext=
81: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
82: $plaintext.=
83: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
1.4 matthew 84: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
1.3 matthew 85: return $plaintext;
86: }
87:
1.4 matthew 88: ################################################################
89: # Handler subroutines #
90: ################################################################
1.9 matthew 91:
92: ################################################################
1.28 www 93: # Language Change Subroutines #
94: ################################################################
1.44 www 95:
96: sub wysiwygchanger {
97: my $r = shift;
98: my %userenv = &Apache::lonnet::get
99: ('environment',['wysiwygeditor']);
100: my $offselect='';
101: my $onselect='checked="1"';
102: if ($userenv{'wysiwygeditor'}) {
103: $onselect='';
104: $offselect='checked="1"';
105: }
106: my $switchoff=&mt('Disable WYSIWYG editor');
107: my $switchon=&mt('Enable WYSIWYG editor');
108: $r->print(<<ENDLSCREEN);
109: <form name="server" action="/adm/preferences" method="post">
110: <input type="hidden" name="action" value="set_wysiwyg" />
111: <br />
112: <input type="radio" name="wysiwyg" value="off" $onselect /> $switchoff<br />
113: <input type="radio" name="wysiwyg" value="on" $offselect /> $switchon
114: ENDLSCREEN
115: $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
116: }
117:
118:
119: sub verify_and_change_wysiwyg {
120: my $r = shift;
121: my $newsetting=$ENV{'form.wysiwyg'};
122: &Apache::lonnet::put('environment',{'wysiwygeditor' => $newsetting});
123: &Apache::lonnet::appenv('environment.wysiwygeditor' => $newsetting);
124: $r->print('<p>'.&mt('Setting WYSIWYG editor to:').' '.&mt($newsetting).'</p>');
125: }
126:
127: ################################################################
128: # Language Change Subroutines #
129: ################################################################
1.28 www 130: sub languagechanger {
131: my $r = shift;
132: my $user = $ENV{'user.name'};
133: my $domain = $ENV{'user.domain'};
134: my %userenv = &Apache::lonnet::get
1.32 www 135: ('environment',['languages']);
1.29 www 136: my $language=$userenv{'languages'};
1.32 www 137:
1.33 www 138: my $pref=&mt('Preferred language');
139: my %langchoices=('' => 'No language preference');
140: foreach (&Apache::loncommon::languageids()) {
141: if (&Apache::loncommon::supportedlanguagecode($_)) {
142: $langchoices{&Apache::loncommon::supportedlanguagecode($_)}
143: = &Apache::loncommon::plainlanguagedescription($_);
144: }
145: }
146: my $selectionbox=&Apache::loncommon::select_form($language,'language',
147: %langchoices);
1.28 www 148: $r->print(<<ENDLSCREEN);
149: <form name="server" action="/adm/preferences" method="post">
150: <input type="hidden" name="action" value="verify_and_change_languages" />
1.33 www 151: <br />$pref: $selectionbox
1.28 www 152: ENDLSCREEN
1.35 matthew 153: $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
1.28 www 154: }
155:
156:
157: sub verify_and_change_languages {
158: my $r = shift;
159: my $user = $ENV{'user.name'};
160: my $domain = $ENV{'user.domain'};
161: # Screenname
162: my $newlanguage = $ENV{'form.language'};
163: $newlanguage=~s/[^\-\w]//g;
164: my $message='';
165: if ($newlanguage) {
1.29 www 166: &Apache::lonnet::put('environment',{'languages' => $newlanguage});
167: &Apache::lonnet::appenv('environment.languages' => $newlanguage);
168: $message='Set new preferred languages to '.$newlanguage;
1.28 www 169: } else {
1.29 www 170: &Apache::lonnet::del('environment',['languages']);
171: &Apache::lonnet::delenv('environment\.languages');
1.28 www 172: $message='Reset preferred language';
173: }
174: $r->print(<<ENDVCSCREEN);
175: </p>
176: $message
177: ENDVCSCREEN
178: }
179:
1.50 albertel 180: ################################################################
181: # Roles Page Preference Change Subroutines #
182: ################################################################
183: sub rolesprefchanger {
184: my $r = shift;
185: my $user = $ENV{'user.name'};
186: my $domain = $ENV{'user.domain'};
187: my %userenv = &Apache::lonnet::get
188: ('environment',['recentroles','recentrolesn']);
189: my $hotlist_flag=$userenv{'recentroles'};
190: my $hotlist_n=$userenv{'recentrolesn'};
191: my $checked;
192: if ($hotlist_flag) {
193: $checked = 'checked="checked"';
194: }
195:
196: if (!$hotlist_n) { $hotlist_n=3; }
197: my $options;
198: for (my $i=1; $i<10; $i++) {
199: my $select;
200: if ($hotlist_n == $i) { $select = 'selected="selected"'; }
201: $options .= "<option $select>$i</option>\n";
202: }
203:
204: $r->print(<<ENDSCREEN);
205: <p>Some LON-CAPA users have a long list of roles. The Recent Roles Hotlist
206: feature keeps track of the last N roles which have been
207: visited and places a table of these at the top of the roles page.
208: People with very few roles should leave this feature disabled.
209: </p>
210:
211: <form name="server" action="/adm/preferences" method="post">
212: <input type="hidden" name="action" value="verify_and_change_rolespref" />
213: <br />Enable Recent Roles Hotlist:
214: <input type="checkbox" $checked name="recentroles" value="true" />
215: <br />Number of roles in Hotlist:
216: <select name="recentrolesn" size="1">
217: $options
218: </select>
219: <br />
220: <input type="submit" value="Change" />
221: </form>
222: ENDSCREEN
223: }
224:
225: sub verify_and_change_rolespref {
226: my $r = shift;
227: my $user = $ENV{'user.name'};
228: my $domain = $ENV{'user.domain'};
229: # Recent Roles Hotlist Flag
230: my $hotlist_flag = $ENV{'form.recentroles'};
231: my $hotlist_n = $ENV{'form.recentrolesn'};
232: my $message='';
233: if ($hotlist_flag) {
234: &Apache::lonnet::put('environment',{'recentroles' => $hotlist_flag});
235: &Apache::lonnet::appenv('environment.recentroles' => $hotlist_flag);
236: $message='Recent Roles Hotlist is Enabled';
237: } else {
238: &Apache::lonnet::del('environment',['recentroles']);
239: &Apache::lonnet::delenv('environment\.recentroles');
240: $message='Recent Roles Hotlist is Disabled';
241: }
242: if ($hotlist_n) {
243: &Apache::lonnet::put('environment',{'recentrolesn' => $hotlist_n});
244: &Apache::lonnet::appenv('environment.recentrolesn' => $hotlist_n);
245: if ($hotlist_flag) {
246: $message.="<br />Display $hotlist_n Most Recent Roles\n";
247: }
248: }
249:
250: $r->print(<<ENDRPSCREEN);
251: </p>
252: $message
253: ENDRPSCREEN
254: }
255:
256:
1.28 www 257:
258: ################################################################
1.9 matthew 259: # Anonymous Discussion Name Change Subroutines #
260: ################################################################
1.5 www 261: sub screennamechanger {
262: my $r = shift;
263: my $user = $ENV{'user.name'};
264: my $domain = $ENV{'user.domain'};
1.14 www 265: my %userenv = &Apache::lonnet::get
266: ('environment',['screenname','nickname']);
1.6 www 267: my $screenname=$userenv{'screenname'};
1.14 www 268: my $nickname=$userenv{'nickname'};
1.5 www 269: $r->print(<<ENDSCREEN);
1.6 www 270: <form name="server" action="/adm/preferences" method="post">
271: <input type="hidden" name="action" value="verify_and_change_screenname" />
1.14 www 272: <br />New screenname (shown if you post anonymously):
1.6 www 273: <input type="text" size="20" value="$screenname" name="screenname" />
1.14 www 274: <br />New nickname (shown if you post non-anonymously):
275: <input type="text" size="20" value="$nickname" name="nickname" />
1.6 www 276: <input type="submit" value="Change" />
277: </form>
1.5 www 278: ENDSCREEN
279: }
1.6 www 280:
281: sub verify_and_change_screenname {
282: my $r = shift;
283: my $user = $ENV{'user.name'};
284: my $domain = $ENV{'user.domain'};
1.14 www 285: # Screenname
1.6 www 286: my $newscreen = $ENV{'form.screenname'};
1.14 www 287: $newscreen=~s/[^ \w]//g;
1.6 www 288: my $message='';
289: if ($newscreen) {
1.7 www 290: &Apache::lonnet::put('environment',{'screenname' => $newscreen});
291: &Apache::lonnet::appenv('environment.screenname' => $newscreen);
1.6 www 292: $message='Set new screenname to '.$newscreen;
293: } else {
294: &Apache::lonnet::del('environment',['screenname']);
1.7 www 295: &Apache::lonnet::delenv('environment\.screenname');
1.6 www 296: $message='Reset screenname';
297: }
1.14 www 298: # Nickname
299: $message.='<br />';
1.17 matthew 300: $newscreen = $ENV{'form.nickname'};
1.14 www 301: $newscreen=~s/[^ \w]//g;
302: if ($newscreen) {
303: &Apache::lonnet::put('environment',{'nickname' => $newscreen});
304: &Apache::lonnet::appenv('environment.nickname' => $newscreen);
305: $message.='Set new nickname to '.$newscreen;
306: } else {
307: &Apache::lonnet::del('environment',['nickname']);
308: &Apache::lonnet::delenv('environment\.nickname');
309: $message.='Reset nickname';
310: }
311:
1.6 www 312: $r->print(<<ENDVCSCREEN);
313: </p>
314: $message
315: ENDVCSCREEN
1.20 www 316: }
317:
318: ################################################################
319: # Message Forward #
320: ################################################################
321:
322: sub msgforwardchanger {
323: my $r = shift;
324: my $user = $ENV{'user.name'};
325: my $domain = $ENV{'user.domain'};
1.26 www 326: my %userenv = &Apache::lonnet::get('environment',['msgforward','notification','critnotification']);
1.20 www 327: my $msgforward=$userenv{'msgforward'};
328: my $notification=$userenv{'notification'};
329: my $critnotification=$userenv{'critnotification'};
1.25 bowersj2 330: my $forwardingHelp = Apache::loncommon::help_open_topic("Prefs_Forwarding",
331: "What are forwarding ".
332: "and notification ".
333: "addresses");
1.27 bowersj2 334: my $criticalMessageHelp = Apache::loncommon::help_open_topic("Course_Critical_Message",
335: "What are critical messages");
336:
1.20 www 337: $r->print(<<ENDMSG);
1.25 bowersj2 338: $forwardingHelp <br />
1.20 www 339: <form name="server" action="/adm/preferences" method="post">
340: <input type="hidden" name="action" value="verify_and_change_msgforward" />
341: New Forwarding Address(es) (<tt>user:domain,user:domain,...</tt>):
342: <input type="text" size="40" value="$msgforward" name="msgforward" /><hr />
343: New Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
344: <input type="text" size="40" value="$notification" name="notification" /><hr />
345: New Critical Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
1.27 bowersj2 346: <input type="text" size="40" value="$critnotification" name="critnotification" />$criticalMessageHelp<hr />
1.20 www 347: <input type="submit" value="Change" />
348: </form>
349: ENDMSG
350: }
351:
352: sub verify_and_change_msgforward {
353: my $r = shift;
354: my $user = $ENV{'user.name'};
355: my $domain = $ENV{'user.domain'};
356: my $newscreen = '';
357: my $message='';
358: foreach (split(/\,/,$ENV{'form.msgforward'})) {
359: my ($msuser,$msdomain)=split(/[\@\:]/,$_);
360: $msuser=~s/\W//g;
361: $msdomain=~s/\W//g;
362: if (($msuser) && ($msdomain)) {
363: if (&Apache::lonnet::homeserver($msuser,$msdomain) ne 'no_host') {
364: $newscreen.=$msuser.':'.$msdomain.',';
365: } else {
366: $message.='No such user: '.$msuser.':'.$msdomain.'<br>';
367: }
368: }
369: }
370: $newscreen=~s/\,$//;
371: if ($newscreen) {
372: &Apache::lonnet::put('environment',{'msgforward' => $newscreen});
373: &Apache::lonnet::appenv('environment.msgforward' => $newscreen);
374: $message.='Set new message forwarding to '.$newscreen.'<br />';
375: } else {
376: &Apache::lonnet::del('environment',['msgforward']);
377: &Apache::lonnet::delenv('environment\.msgforward');
378: $message.='Reset message forwarding<br />';
379: }
380: my $notification=$ENV{'form.notification'};
381: $notification=~s/\s//gs;
382: if ($notification) {
383: &Apache::lonnet::put('environment',{'notification' => $notification});
384: &Apache::lonnet::appenv('environment.notification' => $notification);
385: $message.='Set message notification address to '.$notification.'<br />';
386: } else {
387: &Apache::lonnet::del('environment',['notification']);
388: &Apache::lonnet::delenv('environment\.notification');
389: $message.='Reset message notification<br />';
390: }
391: my $critnotification=$ENV{'form.critnotification'};
392: $critnotification=~s/\s//gs;
393: if ($critnotification) {
394: &Apache::lonnet::put('environment',{'critnotification' => $critnotification});
395: &Apache::lonnet::appenv('environment.critnotification' => $critnotification);
396: $message.='Set critical message notification address to '.$critnotification;
397: } else {
398: &Apache::lonnet::del('environment',['critnotification']);
399: &Apache::lonnet::delenv('environment\.critnotification');
400: $message.='Reset critical message notification<br />';
401: }
402: $r->print(<<ENDVCMSG);
403: </p>
404: $message
405: ENDVCMSG
1.6 www 406: }
407:
1.12 www 408: ################################################################
1.19 www 409: # Colors #
1.12 www 410: ################################################################
411:
1.19 www 412: sub colorschanger {
1.12 www 413: my $r = shift;
1.19 www 414: # figure out colors
415: my $function='student';
416: if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
417: $function='coordinator';
418: }
419: if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
420: $function='admin';
421: }
422: if (($ENV{'request.role'}=~/^(au|ca)/) ||
423: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
424: $function='author';
425: }
426: my $domain=&Apache::loncommon::determinedomain();
427: my %colortypes=('pgbg' => 'Page Background',
428: 'tabbg' => 'Header Background',
429: 'sidebg'=> 'Header Border',
430: 'font' => 'Font',
431: 'link' => 'Un-Visited Link',
432: 'vlink' => 'Visited Link',
433: 'alink' => 'Active Link');
434: my $chtable='';
1.22 matthew 435: foreach my $item (sort(keys(%colortypes))) {
1.19 www 436: my $curcol=&Apache::loncommon::designparm($function.'.'.$item,$domain);
437: $chtable.='<tr><td>'.$colortypes{$item}.'</td><td bgcolor="'.$curcol.
438: '"> </td><td><input name="'.$item.
1.21 www 439: '" size="10" value="'.$curcol.
440: '" /></td><td><a href="javascript:pjump('."'color_custom','".$colortypes{$item}.
1.19 www 441: "','".$curcol."','"
1.21 www 442: .$item."','parmform.pres','psub'".');">Select</a></td></tr>';
1.19 www 443: }
1.23 matthew 444: my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.19 www 445: $r->print(<<ENDCOL);
446: <script>
447:
448: function pclose() {
449: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
450: "height=350,width=350,scrollbars=no,menubar=no");
451: parmwin.close();
452: }
453:
1.23 matthew 454: $pjump_def
1.19 www 455:
456: function psub() {
457: pclose();
458: if (document.parmform.pres_marker.value!='') {
1.21 www 459: if (document.parmform.pres_type.value!='') {
460: eval('document.server.'+
461: document.parmform.pres_marker.value+
1.19 www 462: '.value=document.parmform.pres_value.value;');
1.21 www 463: }
1.19 www 464: } else {
465: document.parmform.pres_value.value='';
466: document.parmform.pres_marker.value='';
467: }
468: }
469:
470:
471: </script>
1.21 www 472: <form name="parmform">
473: <input type="hidden" name="pres_marker" />
474: <input type="hidden" name="pres_type" />
475: <input type="hidden" name="pres_value" />
476: </form>
1.12 www 477: <form name="server" action="/adm/preferences" method="post">
1.19 www 478: <input type="hidden" name="action" value="verify_and_change_colors" />
479: <table border="2">
480: $chtable
481: </table>
1.21 www 482: <input type="submit" value="Change Custom Colors" />
483: <input type="submit" name="resetall" value="Reset All Colors to Default" />
1.12 www 484: </form>
1.19 www 485: ENDCOL
1.12 www 486: }
487:
1.19 www 488: sub verify_and_change_colors {
1.12 www 489: my $r = shift;
1.19 www 490: # figure out colors
491: my $function='student';
492: if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
493: $function='coordinator';
494: }
495: if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
496: $function='admin';
497: }
498: if (($ENV{'request.role'}=~/^(au|ca)/) ||
499: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
500: $function='author';
501: }
502: my $domain=&Apache::loncommon::determinedomain();
503: my %colortypes=('pgbg' => 'Page Background',
504: 'tabbg' => 'Header Background',
505: 'sidebg'=> 'Header Border',
506: 'font' => 'Font',
507: 'link' => 'Un-Visited Link',
508: 'vlink' => 'Visited Link',
509: 'alink' => 'Active Link');
510:
1.12 www 511: my $message='';
1.21 www 512: foreach my $item (keys %colortypes) {
513: my $color=$ENV{'form.'.$item};
514: my $entry='color.'.$function.'.'.$item;
515: if (($color=~/^\#[0-9A-Fa-f]{6}$/) && (!$ENV{'form.resetall'})) {
516: &Apache::lonnet::put('environment',{$entry => $color});
517: &Apache::lonnet::appenv('environment.'.$entry => $color);
518: $message.='Set '.$colortypes{$item}.' to '.$color.'<br />';
519: } else {
520: &Apache::lonnet::del('environment',[$entry]);
521: &Apache::lonnet::delenv('environment\.'.$entry);
522: $message.='Reset '.$colortypes{$item}.'<br />';
523: }
524: }
1.19 www 525: $r->print(<<ENDVCCOL);
1.12 www 526: </p>
527: $message
1.21 www 528: <form name="client" action="/adm/preferences" method="post">
529: <input type="hidden" name="action" value="changecolors" />
530: </form>
1.19 www 531: ENDVCCOL
1.12 www 532: }
533:
1.4 matthew 534: ######################################################
535: # password handler subroutines #
536: ######################################################
1.3 matthew 537: sub passwordchanger {
1.4 matthew 538: # This function is a bit of a mess....
1.3 matthew 539: # Passwords are encrypted using londes.js (DES encryption)
540: my $r = shift;
1.4 matthew 541: my $errormessage = shift;
542: $errormessage = ($errormessage || '');
1.3 matthew 543: my $user = $ENV{'user.name'};
544: my $domain = $ENV{'user.domain'};
545: my $homeserver = $ENV{'user.home'};
546: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
547: # Check for authentication types that allow changing of the password.
548: return if ($currentauth !~ /^(unix|internal):/);
549: #
550: # Generate keys
551: my ($lkey_cpass ,$ukey_cpass ) = &des_keys();
552: my ($lkey_npass1,$ukey_npass1) = &des_keys();
553: my ($lkey_npass2,$ukey_npass2) = &des_keys();
1.4 matthew 554: # Store the keys in the log files
1.3 matthew 555: my $lonhost = $r->dir_config('lonHostID');
556: my $logtoken=Apache::lonnet::reply('tmpput:'
557: .$ukey_cpass . $lkey_cpass .'&'
558: .$ukey_npass1 . $lkey_npass1.'&'
559: .$ukey_npass2 . $lkey_npass2,
560: $lonhost);
1.4 matthew 561: # Hexify the keys for output as javascript variables
1.3 matthew 562: $ukey_cpass = hex($ukey_cpass);
563: $lkey_cpass = hex($lkey_cpass);
564: $ukey_npass1= hex($ukey_npass1);
565: $lkey_npass1= hex($lkey_npass1);
566: $ukey_npass2= hex($ukey_npass2);
567: $lkey_npass2= hex($lkey_npass2);
568: # Output javascript to deal with passwords
1.4 matthew 569: # Output DES javascript
1.9 matthew 570: $r->print("<html><head>");
1.3 matthew 571: {
572: my $include = $r->dir_config('lonIncludes');
573: my $jsh=Apache::File->new($include."/londes.js");
574: $r->print(<$jsh>);
575: }
576: $r->print(<<ENDFORM);
577: <script language="JavaScript">
578:
579: function send() {
580: uextkey=this.document.client.elements.ukey_cpass.value;
581: lextkey=this.document.client.elements.lkey_cpass.value;
582: initkeys();
583:
584: this.document.server.elements.currentpass.value
585: =crypted(this.document.client.elements.currentpass.value);
586:
587: uextkey=this.document.client.elements.ukey_npass1.value;
588: lextkey=this.document.client.elements.lkey_npass1.value;
589: initkeys();
590: this.document.server.elements.newpass_1.value
591: =crypted(this.document.client.elements.newpass_1.value);
592:
593: uextkey=this.document.client.elements.ukey_npass2.value;
594: lextkey=this.document.client.elements.lkey_npass2.value;
595: initkeys();
596: this.document.server.elements.newpass_2.value
597: =crypted(this.document.client.elements.newpass_2.value);
598:
599: this.document.server.submit();
600: }
601:
602: </script>
1.4 matthew 603: $errormessage
1.10 www 604:
1.3 matthew 605: <p>
1.36 www 606: <!-- We separate the forms into 'server' and 'client' in order to
1.3 matthew 607: ensure that unencrypted passwords will not be sent out by a
608: crappy browser -->
609:
610: <form name="server" action="/adm/preferences" method="post">
611: <input type="hidden" name="logtoken" value="$logtoken" />
612: <input type="hidden" name="action" value="verify_and_change_pass" />
613: <input type="hidden" name="currentpass" value="" />
1.4 matthew 614: <input type="hidden" name="newpass_1" value="" />
615: <input type="hidden" name="newpass_2" value="" />
1.3 matthew 616: </form>
617:
618: <form name="client" >
619: <table>
1.4 matthew 620: <tr><td align="right"> Current password: </td>
621: <td><input type="password" name="currentpass" size="10"/> </td></tr>
622: <tr><td align="right"> New password: </td>
623: <td><input type="password" name="newpass_1" size="10" /> </td></tr>
624: <tr><td align="right"> Confirm password: </td>
625: <td><input type="password" name="newpass_2" size="10" /> </td></tr>
1.3 matthew 626: <tr><td colspan="2" align="center">
627: <input type="button" value="Change Password" onClick="send();">
628: </table>
1.4 matthew 629: <input type="hidden" name="ukey_cpass" value="$ukey_cpass" />
630: <input type="hidden" name="lkey_cpass" value="$lkey_cpass" />
1.3 matthew 631: <input type="hidden" name="ukey_npass1" value="$ukey_npass1" />
632: <input type="hidden" name="lkey_npass1" value="$lkey_npass1" />
633: <input type="hidden" name="ukey_npass2" value="$ukey_npass2" />
634: <input type="hidden" name="lkey_npass2" value="$lkey_npass2" />
635: </form>
636: </p>
637: ENDFORM
638: #
639: return;
640: }
641:
642: sub verify_and_change_password {
643: my $r = shift;
644: my $user = $ENV{'user.name'};
645: my $domain = $ENV{'user.domain'};
646: my $homeserver = $ENV{'user.home'};
647: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
1.4 matthew 648: # Check for authentication types that allow changing of the password.
649: return if ($currentauth !~ /^(unix|internal):/);
1.3 matthew 650: #
1.4 matthew 651: $r->print(<<ENDHEADER);
652: <html>
653: <head>
654: <title>LON-CAPA Preferences: Change password for $user</title>
655: </head>
656: ENDHEADER
1.3 matthew 657: #
658: my $currentpass = $ENV{'form.currentpass'};
659: my $newpass1 = $ENV{'form.newpass_1'};
660: my $newpass2 = $ENV{'form.newpass_2'};
661: my $logtoken = $ENV{'form.logtoken'};
662: # Check for empty data
1.4 matthew 663: unless (defined($currentpass) &&
664: defined($newpass1) &&
665: defined($newpass2) ){
666: &passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
667: "Password data was blank.\n</p>");
1.3 matthew 668: return;
669: }
1.16 albertel 670: # Get the keys
671: my $lonhost = $r->dir_config('lonHostID');
1.3 matthew 672: my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
673: if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
1.4 matthew 674: # I do not a have a better idea about how to handle this
1.3 matthew 675: $r->print(<<ENDERROR);
676: <p>
677: <font color="#ff0000">ERROR:</font> Unable to retrieve stored token for
1.4 matthew 678: password decryption. Please log out and try again.
1.3 matthew 679: </p>
680: ENDERROR
1.4 matthew 681: # Probably should log an error here
1.3 matthew 682: return;
683: }
684: my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
1.4 matthew 685: #
1.17 matthew 686: $currentpass = &des_decrypt($ckey ,$currentpass);
687: $newpass1 = &des_decrypt($n1key,$newpass1);
688: $newpass2 = &des_decrypt($n2key,$newpass2);
1.4 matthew 689: #
1.3 matthew 690: if ($newpass1 ne $newpass2) {
1.4 matthew 691: &passwordchanger($r,
692: '<font color="#ff0000">ERROR:</font>'.
693: 'The new passwords you entered do not match. '.
694: 'Please try again.');
695: return;
696: }
697: if (length($newpass1) < 7) {
698: &passwordchanger($r,
699: '<font color="#ff0000">ERROR:</font>'.
700: 'Passwords must be a minimum of 7 characters long. '.
701: 'Please try again.');
1.3 matthew 702: return;
703: }
1.4 matthew 704: #
705: # Check for bad characters
706: my $badpassword = 0;
707: foreach (split(//,$newpass1)) {
708: $badpassword = 1 if ((ord($_)<32)||(ord($_)>126));
709: }
710: if ($badpassword) {
711: # I can't figure out how to enter bad characters on my browser.
712: &passwordchanger($r,<<ENDERROR);
713: <font color="#ff0000">ERROR:</font>
714: The password you entered contained illegal characters.<br />
715: Valid characters are: space and <br />
716: <pre>
717: !"\#$%&\'()*+,-./0123456789:;<=>?\@
718: ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_\`abcdefghijklmnopqrstuvwxyz{|}~
719: </pre>
720: ENDERROR
721: }
722: #
723: # Change the password (finally)
724: my $result = &Apache::lonnet::changepass
725: ($user,$domain,$currentpass,$newpass1,$homeserver);
726: # Inform the user the password has (not?) been changed
727: if ($result =~ /^ok$/) {
728: $r->print(<<"ENDTEXT");
1.9 matthew 729: <h2>The password for $user was successfully changed</h2>
1.4 matthew 730: ENDTEXT
731: } else {
732: # error error: run in circles, scream and shout
733: $r->print(<<ENDERROR);
1.9 matthew 734: <h2><font color="#ff0000">The password for $user was not changed</font></h2>
1.8 matthew 735: Please make sure your old password was entered correctly.
1.4 matthew 736: ENDERROR
737: }
738: return;
1.3 matthew 739: }
740:
1.42 raeburn 741: ################################################################
742: # discussion display subroutines
743: ################################################################
744: sub discussionchanger {
745: my $r = shift;
746: my $user = $ENV{'user.name'};
747: my $domain = $ENV{'user.domain'};
748: my %userenv = &Apache::lonnet::get
1.43 raeburn 749: ('environment',['discdisplay','discmarkread']);
750: my $discdisp = 'allposts';
751: my $discmark = 'onmark';
752:
753: if (defined($userenv{'discdisplay'})) {
754: unless ($userenv{'discdisplay'} eq '') {
755: $discdisp = $userenv{'discdisplay'};
756: }
757: }
758: if (defined($userenv{'discmarkread'})) {
759: unless ($userenv{'discdisplay'} eq '') {
760: $discmark = $userenv{'discmarkread'};
761: }
762: }
763:
764: my $newdisp = 'unread';
765: my $newmark = 'ondisp';
766:
767: my $function = &Apache::loncommon::get_users_function();
768: my $color = &Apache::loncommon::designparm($function.'.tabbg',
769: $ENV{'user.domain'});
770: my %lt = &Apache::lonlocal::texthash(
771: 'pref' => 'Display Preference',
772: 'curr' => 'Current setting ',
773: 'actn' => 'Action',
774: 'sdpf' => 'Set display preferences for discussion posts for both bulletin boards and individual resources in all your courses.',
775: 'prca' => 'Preferences can be set that determine',
776: 'whpo' => 'Which posts are displayed when you display a bulletin board or resource, and',
777: 'unwh' => 'Under what circumstances posts are identfied as "New"',
778: 'allposts' => 'All posts',
779: 'unread' => 'New posts only',
780: 'ondisp' => 'Once displayed',
781: 'onmark' => 'Once marked as read',
782: 'disa' => 'Posts displayed?',
783: 'npmr' => 'New posts cease to be identified as "New"?',
784: 'thde' => 'The preferences you set here can be overridden within each individual discussion.',
785: 'chgt' => 'Change to '
786: );
787: my $dispchange = $lt{'unread'};
788: my $markchange = $lt{'ondisp'};
789: my $currdisp = $lt{'allposts'};
790: my $currmark = $lt{'onmark'};
791:
792: if ($discdisp eq 'unread') {
793: $dispchange = $lt{'allposts'};
794: $currdisp = $lt{'unread'};
795: $newdisp = 'allposts';
796: }
797:
798: if ($discmark eq 'ondisp') {
799: $markchange = $lt{'onmark'};
800: $currmark = $lt{'ondisp'};
801: $newmark = 'onmark';
1.42 raeburn 802: }
1.43 raeburn 803:
804: $r->print(<<"END");
1.42 raeburn 805: <form name="server" action="/adm/preferences" method="post">
806: <input type="hidden" name="action" value="verify_and_change_discussion" />
807: <br />
1.43 raeburn 808: $lt{'sdpf'}<br/> $lt{'prca'} <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol>
809: <br />
810: <br />
811: <table border="0" cellpadding="0" cellspacing="0">
812: <tr>
813: <td width="100%" bgcolor="#000000">
814: <table width="100%" border="0" cellpadding="1" cellspacing="0">
815: <tr>
816: <td width="100%" bgcolor="#000000">
817: <table border="0" cellpadding="3" cellspacing="3" bgcolor="#FFFFFF">
818: <tr bgcolor="$color">
819: <td><b>$lt{'pref'}</b></td>
820: <td><b>$lt{'curr'}</b></td>
821: <td><b>$lt{'actn'}?</b></td>
822: </tr>
823: <tr bgcolor="#dddddd">
824: <td>$lt{'disa'}</td>
825: <td>$lt{$discdisp}</td>
826: <td><input type="checkbox" name="discdisp" /><input type="hidden" name="newdisp" value="$newdisp" /> $lt{'chgt'} "$dispchange"</td>
827: </tr><tr bgcolor="#eeeeee">
828: <td>$lt{'npmr'}</td>
829: <td>$lt{$discmark}</td>
830: <td><input type="checkbox" name="discmark" /><input type="hidden" name="newmark" value="$newmark" /> $lt{'chgt'} "$markchange"</td>
831: </tr>
832: </table>
833: </td>
834: </tr>
835: </table>
836: </td>
837: </tr>
838: </table>
839: <br />
840: <br />
841: <input type="submit" name="sub" value="Store Changes" />
842: <br />
843: <br />
844: Note: $lt{'thde'}
845: </form>
846: END
1.42 raeburn 847: }
848:
849: sub verify_and_change_discussion {
850: my $r = shift;
1.43 raeburn 851: my $user = $ENV{'user.name'};
852: my $domain = $ENV{'user.domain'};
1.42 raeburn 853: my $message='';
1.43 raeburn 854: if (defined($ENV{'form.discdisp'}) ) {
855: my $newdisp = $ENV{'form.newdisp'};
856: if ($newdisp eq 'unread') {
857: $message .='In discussions: only new posts will be displayed.<br/>';
858: &Apache::lonnet::put('environment',{'discdisplay' => $newdisp});
859: &Apache::lonnet::appenv('environment.discdisplay' => $newdisp);
860: } else {
861: $message .= 'In discussions: all posts will be displayed.<br/>';
862: &Apache::lonnet::del('environment',['discdisplay']);
863: &Apache::lonnet::delenv('environment\.discdisplay');
864: }
865: }
866: if (defined($ENV{'form.discmark'}) ) {
867: my $newmark = $ENV{'form.newmark'};
868: if ($newmark eq 'ondisp') {
869: $message.='In discussions: new posts will be cease to be identified as "new" after display.<br/>';
870: &Apache::lonnet::put('environment',{'discmarkread' => $newmark});
871: &Apache::lonnet::appenv('environment.discmarkread' => $newmark);
872: } else {
873: $message.='In discussions: posts will be identified as "new" until marked as read by the reader.<br/>';
874: &Apache::lonnet::del('environment',['discmarkread']);
875: &Apache::lonnet::delenv('environment\.discmarkread');
876: }
1.42 raeburn 877: }
878: $r->print(<<ENDVCSCREEN);
879: </p>
880: $message
881: ENDVCSCREEN
882: }
883:
1.4 matthew 884: ######################################################
885: # other handler subroutines #
886: ######################################################
887:
1.3 matthew 888: ################################################################
889: # Main handler #
890: ################################################################
1.1 www 891: sub handler {
892: my $r = shift;
1.3 matthew 893: my $user = $ENV{'user.name'};
894: my $domain = $ENV{'user.domain'};
1.31 www 895: &Apache::loncommon::content_type($r,'text/html');
1.4 matthew 896: # Some pages contain DES keys and should not be cached.
897: &Apache::loncommon::no_cache($r);
1.1 www 898: $r->send_http_header;
899: return OK if $r->header_only;
1.9 matthew 900: #
1.35 matthew 901: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.44 www 902: ['action','wysiwyg','returnurl']);
1.35 matthew 903: #
904: &Apache::lonhtmlcommon::clear_breadcrumbs();
905: &Apache::lonhtmlcommon::add_breadcrumb
906: ({href => '/adm/preferences',
907: text => 'Set User Preferences'});
908:
909: my @Options;
910: # Determine current authentication method
911: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
912: if ($currentauth =~ /^(unix|internal):/) {
913: push (@Options,({ action => 'changepass',
1.40 www 914: linktext => 'Change Password',
1.35 matthew 915: href => '/adm/preferences',
916: help => 'Change_Password',
917: subroutine => \&passwordchanger,
918: breadcrumb =>
919: { href => '/adm/preferences?action=changepass',
920: text => 'Change Password'},
921: },
922: { action => 'verify_and_change_pass',
923: subroutine => \&verify_and_change_password,
924: breadcrumb =>
925: { href =>'/adm/preferences?action=changepass',
926: text => 'Change Password'},
927: printmenu => 'yes',
928: }));
929: }
930: push (@Options,({ action => 'changescreenname',
931: linktext => 'Change Screen Name',
932: href => '/adm/preferences',
933: help => 'Prefs_Screen_Name_Nickname',
934: subroutine => \&screennamechanger,
935: breadcrumb =>
936: { href => '/adm/preferences?action=changescreenname',
937: text => 'Change Screen Name'},
938: },
939: { action => 'verify_and_change_screenname',
940: subroutine => \&verify_and_change_screenname,
941: breadcrumb =>
942: { href => '/adm/preferences?action=changescreenname',
943: text => 'Change Screen Name'},
944: printmenu => 'yes',
945: }));
946:
947: push (@Options,({ action => 'changemsgforward',
1.49 albertel 948: linktext => 'Change Message Forwarding and Notification Addresses',
1.35 matthew 949: href => '/adm/preferences',
950: help => 'Prefs_Forwarding',
951: breadcrumb =>
952: { href => '/adm/preferences?action=changemsgforward',
953: text => 'Change Message Forwarding'},
954: subroutine => \&msgforwardchanger,
955: },
956: { action => 'verify_and_change_msgforward',
957: breadcrumb =>
958: { href => '/adm/preferences?action=changemsgforward',
959: text => 'Change Message Forwarding'},
960: printmenu => 'yes',
961: subroutine => \&verify_and_change_msgforward }));
962: my $aboutmeaction=
963: '/adm/'.$ENV{'user.domain'}.'/'.$ENV{'user.name'}.'/aboutme';
964: push (@Options,{ action => 'none',
965: linktext =>
1.41 www 966: q{Edit the 'About Me' Personal Information Screen},
1.45 www 967: help => 'Prefs_About_Me',
1.35 matthew 968: href => $aboutmeaction});
969: push (@Options,({ action => 'changecolors',
970: linktext => 'Change Color Scheme',
971: href => '/adm/preferences',
972: help => 'Change_Colors',
973: breadcrumb =>
974: { href => '/adm/preferences?action=changecolors',
975: text => 'Change Colors'},
976: subroutine => \&colorschanger,
977: },
978: { action => 'verify_and_change_colors',
979: breadcrumb =>
980: { href => '/adm/preferences?action=changecolors',
981: text => 'Change Colors'},
982: printmenu => 'yes',
983: subroutine => \&verify_and_change_colors,
984: }));
985: push (@Options,({ action => 'changelanguages',
1.39 www 986: linktext => 'Change Language Preferences',
1.35 matthew 987: href => '/adm/preferences',
1.45 www 988: help => 'Prefs_Language',
1.35 matthew 989: breadcrumb=>
990: { href => '/adm/preferences?action=changelanguages',
991: text => 'Change Language'},
992: subroutine => \&languagechanger,
993: },
994: { action => 'verify_and_change_languages',
995: breadcrumb=>
996: {href => '/adm/preferences?action=changelanguages',
997: text => 'Change Language'},
998: printmenu => 'yes',
999: subroutine=>\&verify_and_change_languages, }
1000: ));
1.44 www 1001: push (@Options,({ action => 'changewysiwyg',
1002: linktext => 'Change WYSIWYG Editor Preferences',
1003: href => '/adm/preferences',
1004: breadcrumb =>
1005: { href => '/adm/preferences?action=changewysiwyg',
1006: text => 'Change WYSIWYG Preferences'},
1007: subroutine => \&wysiwygchanger,
1008: },
1009: { action => 'set_wysiwyg',
1010: breadcrumb =>
1011: { href => '/adm/preferences?action=changewysiwyg',
1012: text => 'Change WYSIWYG Preferences'},
1013: printmenu => 'yes',
1014: subroutine => \&verify_and_change_wysiwyg, }
1015: ));
1.42 raeburn 1016: push (@Options,({ action => 'changediscussions',
1017: linktext => 'Change Discussion Display Preferences',
1018: href => '/adm/preferences',
1.46 raeburn 1019: help => 'Change_Discussion_Display',
1.42 raeburn 1020: breadcrumb =>
1021: { href => '/adm/preferences?action=changediscussions',
1.43 raeburn 1022: text => 'Change Discussion Preferences'},
1.42 raeburn 1023: subroutine => \&discussionchanger,
1024: },
1025: { action => 'verify_and_change_discussion',
1026: breadcrumb =>
1027: { href => '/adm/preferences?action=changediscussions',
1.43 raeburn 1028: text => 'Change Discussion Preferences'},
1.42 raeburn 1029: printmenu => 'yes',
1030: subroutine => \&verify_and_change_discussion, }
1031: ));
1032:
1.50 albertel 1033: push (@Options,({ action => 'changerolespref',
1034: linktext => 'Change Roles Page Preferences',
1035: href => '/adm/preferences',
1036: subroutine => \&rolesprefchanger,
1037: breadcrumb =>
1038: { href => '/adm/preferences?action=changerolespref',
1039: text => 'Change Roles Pref'},
1040: },
1041: { action => 'verify_and_change_rolespref',
1042: subroutine => \&verify_and_change_rolespref,
1043: breadcrumb =>
1044: { href => '/adm/preferences?action=changerolespref',
1045: text => 'Change Roles Preferences'},
1046: printmenu => 'yes',
1047: }));
1048:
1049:
1.51 ! foxr 1050: if ($ENV{'user.name'} =~ /^(albertel|fox|foxr|koretemey|korte|hallmat3|turtle)$/) {
1.35 matthew 1051: push (@Options,({ action => 'debugtoggle',
1052: printmenu => 'yes',
1053: subroutine => \&toggle_debug,
1054: }));
1055: }
1056: $r->print(<<ENDHEADER);
1.1 www 1057: <html>
1058: <head>
1.4 matthew 1059: <title>LON-CAPA Preferences</title>
1.1 www 1060: </head>
1.3 matthew 1061: ENDHEADER
1.35 matthew 1062: my $call = undef;
1.48 albertel 1063: my $help = undef;
1.35 matthew 1064: my $printmenu = 'yes';
1065: foreach my $option (@Options) {
1066: if ($option->{'action'} eq $ENV{'form.action'}) {
1067: $call = $option->{'subroutine'};
1068: $printmenu = $option->{'printmenu'};
1069: if (exists($option->{'breadcrumb'})) {
1070: &Apache::lonhtmlcommon::add_breadcrumb
1071: ($option->{'breadcrumb'});
1072: }
1.48 albertel 1073: $help=$option->{'help'};
1.35 matthew 1074: }
1075: }
1076: $r->print(&Apache::loncommon::bodytag('Change Preferences'));
1077: $r->print(&Apache::lonhtmlcommon::breadcrumbs
1.48 albertel 1078: (undef,'Change Preferences',$help));
1.35 matthew 1079: if (defined($call)) {
1080: $call->($r);
1081: }
1.44 www 1082: if (($printmenu eq 'yes') && (!$ENV{'form.returnurl'})) {
1.35 matthew 1083: my $optionlist = '<table cellpadding="5">';
1084: if ($ENV{'user.name'} =~
1.51 ! foxr 1085: /^(albertel|kortemey|fox|foxr|korte|hallmat3|turtle)$/
1.35 matthew 1086: ) {
1087: push (@Options,({ action => 'debugtoggle',
1088: linktext => 'Toggle Debug Messages',
1089: text => 'Current Debug status is -'.
1090: $ENV{'user.debug'}.'-.',
1091: href => '/adm/preferences',
1092: printmenu => 'yes',
1093: subroutine => \&toggle_debug,
1094: }));
1095: }
1096: foreach my $option(@Options) {
1097: my $optiontext = '';
1098: if (exists($option->{'href'})) {
1099: $optiontext .=
1100: '<a href="'.$option->{'href'}.
1101: '?action='.$option->{'action'}.'">'.
1.47 albertel 1102: &mt($option->{'linktext'}).'</a>';
1.35 matthew 1103: }
1104: if (exists($option->{'text'})) {
1.47 albertel 1105: $optiontext .= ' '.&mt($option->{'text'});
1.35 matthew 1106: }
1107: if ($optiontext ne '') {
1108: $optiontext = '<font size="+1">'.$optiontext.'</font>';
1109: my $helplink = ' ';
1110: if (exists($option->{'help'})) {
1111: $helplink = &Apache::loncommon::help_open_topic
1112: ($option->{'help'});
1113: }
1114: $optionlist .= '<tr>'.
1115: '<td>'.$helplink.'</td>'.
1116: '<td>'.$optiontext.'</td>'.
1117: '</tr>';
1118: }
1.13 www 1119: }
1.35 matthew 1120: $optionlist .= '</table>';
1121: $r->print($optionlist);
1.44 www 1122: } elsif ($ENV{'form.returnurl'}) {
1123: $r->print('<br /><a href="'.$ENV{'form.returnurl'}.'"><font size="+1">'.
1124: &mt('Return').'</font></a>');
1.3 matthew 1125: }
1126: $r->print(<<ENDFOOTER);
1.1 www 1127: </body>
1128: </html>
1.3 matthew 1129: ENDFOOTER
1.1 www 1130: return OK;
1.35 matthew 1131: }
1132:
1133: sub toggle_debug {
1134: if ($ENV{'user.debug'}) {
1135: &Apache::lonnet::delenv('user\.debug');
1136: } else {
1137: &Apache::lonnet::appenv('user.debug' => 1);
1138: }
1.13 www 1139: }
1.1 www 1140:
1141: 1;
1142: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonpreferences.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface