Annotation of loncom/interface/lonpreferences.pm, revision 1.45
1.1 www 1: # The LearningOnline Network
2: # Preferences
3: #
1.45 ! www 4: # $Id: lonpreferences.pm,v 1.44 2004/06/08 01:32:02 www 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:
180:
181: ################################################################
1.9 matthew 182: # Anonymous Discussion Name Change Subroutines #
183: ################################################################
1.5 www 184: sub screennamechanger {
185: my $r = shift;
186: my $user = $ENV{'user.name'};
187: my $domain = $ENV{'user.domain'};
1.14 www 188: my %userenv = &Apache::lonnet::get
189: ('environment',['screenname','nickname']);
1.6 www 190: my $screenname=$userenv{'screenname'};
1.14 www 191: my $nickname=$userenv{'nickname'};
1.5 www 192: $r->print(<<ENDSCREEN);
1.6 www 193: <form name="server" action="/adm/preferences" method="post">
194: <input type="hidden" name="action" value="verify_and_change_screenname" />
1.14 www 195: <br />New screenname (shown if you post anonymously):
1.6 www 196: <input type="text" size="20" value="$screenname" name="screenname" />
1.14 www 197: <br />New nickname (shown if you post non-anonymously):
198: <input type="text" size="20" value="$nickname" name="nickname" />
1.6 www 199: <input type="submit" value="Change" />
200: </form>
1.5 www 201: ENDSCREEN
202: }
1.6 www 203:
204: sub verify_and_change_screenname {
205: my $r = shift;
206: my $user = $ENV{'user.name'};
207: my $domain = $ENV{'user.domain'};
1.14 www 208: # Screenname
1.6 www 209: my $newscreen = $ENV{'form.screenname'};
1.14 www 210: $newscreen=~s/[^ \w]//g;
1.6 www 211: my $message='';
212: if ($newscreen) {
1.7 www 213: &Apache::lonnet::put('environment',{'screenname' => $newscreen});
214: &Apache::lonnet::appenv('environment.screenname' => $newscreen);
1.6 www 215: $message='Set new screenname to '.$newscreen;
216: } else {
217: &Apache::lonnet::del('environment',['screenname']);
1.7 www 218: &Apache::lonnet::delenv('environment\.screenname');
1.6 www 219: $message='Reset screenname';
220: }
1.14 www 221: # Nickname
222: $message.='<br />';
1.17 matthew 223: $newscreen = $ENV{'form.nickname'};
1.14 www 224: $newscreen=~s/[^ \w]//g;
225: if ($newscreen) {
226: &Apache::lonnet::put('environment',{'nickname' => $newscreen});
227: &Apache::lonnet::appenv('environment.nickname' => $newscreen);
228: $message.='Set new nickname to '.$newscreen;
229: } else {
230: &Apache::lonnet::del('environment',['nickname']);
231: &Apache::lonnet::delenv('environment\.nickname');
232: $message.='Reset nickname';
233: }
234:
1.6 www 235: $r->print(<<ENDVCSCREEN);
236: </p>
237: $message
238: ENDVCSCREEN
1.20 www 239: }
240:
241: ################################################################
242: # Message Forward #
243: ################################################################
244:
245: sub msgforwardchanger {
246: my $r = shift;
247: my $user = $ENV{'user.name'};
248: my $domain = $ENV{'user.domain'};
1.26 www 249: my %userenv = &Apache::lonnet::get('environment',['msgforward','notification','critnotification']);
1.20 www 250: my $msgforward=$userenv{'msgforward'};
251: my $notification=$userenv{'notification'};
252: my $critnotification=$userenv{'critnotification'};
1.25 bowersj2 253: my $forwardingHelp = Apache::loncommon::help_open_topic("Prefs_Forwarding",
254: "What are forwarding ".
255: "and notification ".
256: "addresses");
1.27 bowersj2 257: my $criticalMessageHelp = Apache::loncommon::help_open_topic("Course_Critical_Message",
258: "What are critical messages");
259:
1.20 www 260: $r->print(<<ENDMSG);
1.25 bowersj2 261: $forwardingHelp <br />
1.20 www 262: <form name="server" action="/adm/preferences" method="post">
263: <input type="hidden" name="action" value="verify_and_change_msgforward" />
264: New Forwarding Address(es) (<tt>user:domain,user:domain,...</tt>):
265: <input type="text" size="40" value="$msgforward" name="msgforward" /><hr />
266: New Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
267: <input type="text" size="40" value="$notification" name="notification" /><hr />
268: New Critical Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
1.27 bowersj2 269: <input type="text" size="40" value="$critnotification" name="critnotification" />$criticalMessageHelp<hr />
1.20 www 270: <input type="submit" value="Change" />
271: </form>
272: ENDMSG
273: }
274:
275: sub verify_and_change_msgforward {
276: my $r = shift;
277: my $user = $ENV{'user.name'};
278: my $domain = $ENV{'user.domain'};
279: my $newscreen = '';
280: my $message='';
281: foreach (split(/\,/,$ENV{'form.msgforward'})) {
282: my ($msuser,$msdomain)=split(/[\@\:]/,$_);
283: $msuser=~s/\W//g;
284: $msdomain=~s/\W//g;
285: if (($msuser) && ($msdomain)) {
286: if (&Apache::lonnet::homeserver($msuser,$msdomain) ne 'no_host') {
287: $newscreen.=$msuser.':'.$msdomain.',';
288: } else {
289: $message.='No such user: '.$msuser.':'.$msdomain.'<br>';
290: }
291: }
292: }
293: $newscreen=~s/\,$//;
294: if ($newscreen) {
295: &Apache::lonnet::put('environment',{'msgforward' => $newscreen});
296: &Apache::lonnet::appenv('environment.msgforward' => $newscreen);
297: $message.='Set new message forwarding to '.$newscreen.'<br />';
298: } else {
299: &Apache::lonnet::del('environment',['msgforward']);
300: &Apache::lonnet::delenv('environment\.msgforward');
301: $message.='Reset message forwarding<br />';
302: }
303: my $notification=$ENV{'form.notification'};
304: $notification=~s/\s//gs;
305: if ($notification) {
306: &Apache::lonnet::put('environment',{'notification' => $notification});
307: &Apache::lonnet::appenv('environment.notification' => $notification);
308: $message.='Set message notification address to '.$notification.'<br />';
309: } else {
310: &Apache::lonnet::del('environment',['notification']);
311: &Apache::lonnet::delenv('environment\.notification');
312: $message.='Reset message notification<br />';
313: }
314: my $critnotification=$ENV{'form.critnotification'};
315: $critnotification=~s/\s//gs;
316: if ($critnotification) {
317: &Apache::lonnet::put('environment',{'critnotification' => $critnotification});
318: &Apache::lonnet::appenv('environment.critnotification' => $critnotification);
319: $message.='Set critical message notification address to '.$critnotification;
320: } else {
321: &Apache::lonnet::del('environment',['critnotification']);
322: &Apache::lonnet::delenv('environment\.critnotification');
323: $message.='Reset critical message notification<br />';
324: }
325: $r->print(<<ENDVCMSG);
326: </p>
327: $message
328: ENDVCMSG
1.6 www 329: }
330:
1.12 www 331: ################################################################
1.19 www 332: # Colors #
1.12 www 333: ################################################################
334:
1.19 www 335: sub colorschanger {
1.12 www 336: my $r = shift;
1.19 www 337: # figure out colors
338: my $function='student';
339: if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
340: $function='coordinator';
341: }
342: if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
343: $function='admin';
344: }
345: if (($ENV{'request.role'}=~/^(au|ca)/) ||
346: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
347: $function='author';
348: }
349: my $domain=&Apache::loncommon::determinedomain();
350: my %colortypes=('pgbg' => 'Page Background',
351: 'tabbg' => 'Header Background',
352: 'sidebg'=> 'Header Border',
353: 'font' => 'Font',
354: 'link' => 'Un-Visited Link',
355: 'vlink' => 'Visited Link',
356: 'alink' => 'Active Link');
357: my $chtable='';
1.22 matthew 358: foreach my $item (sort(keys(%colortypes))) {
1.19 www 359: my $curcol=&Apache::loncommon::designparm($function.'.'.$item,$domain);
360: $chtable.='<tr><td>'.$colortypes{$item}.'</td><td bgcolor="'.$curcol.
361: '"> </td><td><input name="'.$item.
1.21 www 362: '" size="10" value="'.$curcol.
363: '" /></td><td><a href="javascript:pjump('."'color_custom','".$colortypes{$item}.
1.19 www 364: "','".$curcol."','"
1.21 www 365: .$item."','parmform.pres','psub'".');">Select</a></td></tr>';
1.19 www 366: }
1.23 matthew 367: my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.19 www 368: $r->print(<<ENDCOL);
369: <script>
370:
371: function pclose() {
372: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
373: "height=350,width=350,scrollbars=no,menubar=no");
374: parmwin.close();
375: }
376:
1.23 matthew 377: $pjump_def
1.19 www 378:
379: function psub() {
380: pclose();
381: if (document.parmform.pres_marker.value!='') {
1.21 www 382: if (document.parmform.pres_type.value!='') {
383: eval('document.server.'+
384: document.parmform.pres_marker.value+
1.19 www 385: '.value=document.parmform.pres_value.value;');
1.21 www 386: }
1.19 www 387: } else {
388: document.parmform.pres_value.value='';
389: document.parmform.pres_marker.value='';
390: }
391: }
392:
393:
394: </script>
1.21 www 395: <form name="parmform">
396: <input type="hidden" name="pres_marker" />
397: <input type="hidden" name="pres_type" />
398: <input type="hidden" name="pres_value" />
399: </form>
1.12 www 400: <form name="server" action="/adm/preferences" method="post">
1.19 www 401: <input type="hidden" name="action" value="verify_and_change_colors" />
402: <table border="2">
403: $chtable
404: </table>
1.21 www 405: <input type="submit" value="Change Custom Colors" />
406: <input type="submit" name="resetall" value="Reset All Colors to Default" />
1.12 www 407: </form>
1.19 www 408: ENDCOL
1.12 www 409: }
410:
1.19 www 411: sub verify_and_change_colors {
1.12 www 412: my $r = shift;
1.19 www 413: # figure out colors
414: my $function='student';
415: if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
416: $function='coordinator';
417: }
418: if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
419: $function='admin';
420: }
421: if (($ENV{'request.role'}=~/^(au|ca)/) ||
422: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
423: $function='author';
424: }
425: my $domain=&Apache::loncommon::determinedomain();
426: my %colortypes=('pgbg' => 'Page Background',
427: 'tabbg' => 'Header Background',
428: 'sidebg'=> 'Header Border',
429: 'font' => 'Font',
430: 'link' => 'Un-Visited Link',
431: 'vlink' => 'Visited Link',
432: 'alink' => 'Active Link');
433:
1.12 www 434: my $message='';
1.21 www 435: foreach my $item (keys %colortypes) {
436: my $color=$ENV{'form.'.$item};
437: my $entry='color.'.$function.'.'.$item;
438: if (($color=~/^\#[0-9A-Fa-f]{6}$/) && (!$ENV{'form.resetall'})) {
439: &Apache::lonnet::put('environment',{$entry => $color});
440: &Apache::lonnet::appenv('environment.'.$entry => $color);
441: $message.='Set '.$colortypes{$item}.' to '.$color.'<br />';
442: } else {
443: &Apache::lonnet::del('environment',[$entry]);
444: &Apache::lonnet::delenv('environment\.'.$entry);
445: $message.='Reset '.$colortypes{$item}.'<br />';
446: }
447: }
1.19 www 448: $r->print(<<ENDVCCOL);
1.12 www 449: </p>
450: $message
1.21 www 451: <form name="client" action="/adm/preferences" method="post">
452: <input type="hidden" name="action" value="changecolors" />
453: </form>
1.19 www 454: ENDVCCOL
1.12 www 455: }
456:
1.4 matthew 457: ######################################################
458: # password handler subroutines #
459: ######################################################
1.3 matthew 460: sub passwordchanger {
1.4 matthew 461: # This function is a bit of a mess....
1.3 matthew 462: # Passwords are encrypted using londes.js (DES encryption)
463: my $r = shift;
1.4 matthew 464: my $errormessage = shift;
465: $errormessage = ($errormessage || '');
1.3 matthew 466: my $user = $ENV{'user.name'};
467: my $domain = $ENV{'user.domain'};
468: my $homeserver = $ENV{'user.home'};
469: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
470: # Check for authentication types that allow changing of the password.
471: return if ($currentauth !~ /^(unix|internal):/);
472: #
473: # Generate keys
474: my ($lkey_cpass ,$ukey_cpass ) = &des_keys();
475: my ($lkey_npass1,$ukey_npass1) = &des_keys();
476: my ($lkey_npass2,$ukey_npass2) = &des_keys();
1.4 matthew 477: # Store the keys in the log files
1.3 matthew 478: my $lonhost = $r->dir_config('lonHostID');
479: my $logtoken=Apache::lonnet::reply('tmpput:'
480: .$ukey_cpass . $lkey_cpass .'&'
481: .$ukey_npass1 . $lkey_npass1.'&'
482: .$ukey_npass2 . $lkey_npass2,
483: $lonhost);
1.4 matthew 484: # Hexify the keys for output as javascript variables
1.3 matthew 485: $ukey_cpass = hex($ukey_cpass);
486: $lkey_cpass = hex($lkey_cpass);
487: $ukey_npass1= hex($ukey_npass1);
488: $lkey_npass1= hex($lkey_npass1);
489: $ukey_npass2= hex($ukey_npass2);
490: $lkey_npass2= hex($lkey_npass2);
491: # Output javascript to deal with passwords
1.4 matthew 492: # Output DES javascript
1.9 matthew 493: $r->print("<html><head>");
1.3 matthew 494: {
495: my $include = $r->dir_config('lonIncludes');
496: my $jsh=Apache::File->new($include."/londes.js");
497: $r->print(<$jsh>);
498: }
499: $r->print(<<ENDFORM);
500: <script language="JavaScript">
501:
502: function send() {
503: uextkey=this.document.client.elements.ukey_cpass.value;
504: lextkey=this.document.client.elements.lkey_cpass.value;
505: initkeys();
506:
507: this.document.server.elements.currentpass.value
508: =crypted(this.document.client.elements.currentpass.value);
509:
510: uextkey=this.document.client.elements.ukey_npass1.value;
511: lextkey=this.document.client.elements.lkey_npass1.value;
512: initkeys();
513: this.document.server.elements.newpass_1.value
514: =crypted(this.document.client.elements.newpass_1.value);
515:
516: uextkey=this.document.client.elements.ukey_npass2.value;
517: lextkey=this.document.client.elements.lkey_npass2.value;
518: initkeys();
519: this.document.server.elements.newpass_2.value
520: =crypted(this.document.client.elements.newpass_2.value);
521:
522: this.document.server.submit();
523: }
524:
525: </script>
1.4 matthew 526: $errormessage
1.10 www 527:
1.3 matthew 528: <p>
1.36 www 529: <!-- We separate the forms into 'server' and 'client' in order to
1.3 matthew 530: ensure that unencrypted passwords will not be sent out by a
531: crappy browser -->
532:
533: <form name="server" action="/adm/preferences" method="post">
534: <input type="hidden" name="logtoken" value="$logtoken" />
535: <input type="hidden" name="action" value="verify_and_change_pass" />
536: <input type="hidden" name="currentpass" value="" />
1.4 matthew 537: <input type="hidden" name="newpass_1" value="" />
538: <input type="hidden" name="newpass_2" value="" />
1.3 matthew 539: </form>
540:
541: <form name="client" >
542: <table>
1.4 matthew 543: <tr><td align="right"> Current password: </td>
544: <td><input type="password" name="currentpass" size="10"/> </td></tr>
545: <tr><td align="right"> New password: </td>
546: <td><input type="password" name="newpass_1" size="10" /> </td></tr>
547: <tr><td align="right"> Confirm password: </td>
548: <td><input type="password" name="newpass_2" size="10" /> </td></tr>
1.3 matthew 549: <tr><td colspan="2" align="center">
550: <input type="button" value="Change Password" onClick="send();">
551: </table>
1.4 matthew 552: <input type="hidden" name="ukey_cpass" value="$ukey_cpass" />
553: <input type="hidden" name="lkey_cpass" value="$lkey_cpass" />
1.3 matthew 554: <input type="hidden" name="ukey_npass1" value="$ukey_npass1" />
555: <input type="hidden" name="lkey_npass1" value="$lkey_npass1" />
556: <input type="hidden" name="ukey_npass2" value="$ukey_npass2" />
557: <input type="hidden" name="lkey_npass2" value="$lkey_npass2" />
558: </form>
559: </p>
560: ENDFORM
561: #
562: return;
563: }
564:
565: sub verify_and_change_password {
566: my $r = shift;
567: my $user = $ENV{'user.name'};
568: my $domain = $ENV{'user.domain'};
569: my $homeserver = $ENV{'user.home'};
570: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
1.4 matthew 571: # Check for authentication types that allow changing of the password.
572: return if ($currentauth !~ /^(unix|internal):/);
1.3 matthew 573: #
1.4 matthew 574: $r->print(<<ENDHEADER);
575: <html>
576: <head>
577: <title>LON-CAPA Preferences: Change password for $user</title>
578: </head>
579: ENDHEADER
1.3 matthew 580: #
581: my $currentpass = $ENV{'form.currentpass'};
582: my $newpass1 = $ENV{'form.newpass_1'};
583: my $newpass2 = $ENV{'form.newpass_2'};
584: my $logtoken = $ENV{'form.logtoken'};
585: # Check for empty data
1.4 matthew 586: unless (defined($currentpass) &&
587: defined($newpass1) &&
588: defined($newpass2) ){
589: &passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
590: "Password data was blank.\n</p>");
1.3 matthew 591: return;
592: }
1.16 albertel 593: # Get the keys
594: my $lonhost = $r->dir_config('lonHostID');
1.3 matthew 595: my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
596: if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
1.4 matthew 597: # I do not a have a better idea about how to handle this
1.3 matthew 598: $r->print(<<ENDERROR);
599: <p>
600: <font color="#ff0000">ERROR:</font> Unable to retrieve stored token for
1.4 matthew 601: password decryption. Please log out and try again.
1.3 matthew 602: </p>
603: ENDERROR
1.4 matthew 604: # Probably should log an error here
1.3 matthew 605: return;
606: }
607: my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
1.4 matthew 608: #
1.17 matthew 609: $currentpass = &des_decrypt($ckey ,$currentpass);
610: $newpass1 = &des_decrypt($n1key,$newpass1);
611: $newpass2 = &des_decrypt($n2key,$newpass2);
1.4 matthew 612: #
1.3 matthew 613: if ($newpass1 ne $newpass2) {
1.4 matthew 614: &passwordchanger($r,
615: '<font color="#ff0000">ERROR:</font>'.
616: 'The new passwords you entered do not match. '.
617: 'Please try again.');
618: return;
619: }
620: if (length($newpass1) < 7) {
621: &passwordchanger($r,
622: '<font color="#ff0000">ERROR:</font>'.
623: 'Passwords must be a minimum of 7 characters long. '.
624: 'Please try again.');
1.3 matthew 625: return;
626: }
1.4 matthew 627: #
628: # Check for bad characters
629: my $badpassword = 0;
630: foreach (split(//,$newpass1)) {
631: $badpassword = 1 if ((ord($_)<32)||(ord($_)>126));
632: }
633: if ($badpassword) {
634: # I can't figure out how to enter bad characters on my browser.
635: &passwordchanger($r,<<ENDERROR);
636: <font color="#ff0000">ERROR:</font>
637: The password you entered contained illegal characters.<br />
638: Valid characters are: space and <br />
639: <pre>
640: !"\#$%&\'()*+,-./0123456789:;<=>?\@
641: ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_\`abcdefghijklmnopqrstuvwxyz{|}~
642: </pre>
643: ENDERROR
644: }
645: #
646: # Change the password (finally)
647: my $result = &Apache::lonnet::changepass
648: ($user,$domain,$currentpass,$newpass1,$homeserver);
649: # Inform the user the password has (not?) been changed
650: if ($result =~ /^ok$/) {
651: $r->print(<<"ENDTEXT");
1.9 matthew 652: <h2>The password for $user was successfully changed</h2>
1.4 matthew 653: ENDTEXT
654: } else {
655: # error error: run in circles, scream and shout
656: $r->print(<<ENDERROR);
1.9 matthew 657: <h2><font color="#ff0000">The password for $user was not changed</font></h2>
1.8 matthew 658: Please make sure your old password was entered correctly.
1.4 matthew 659: ENDERROR
660: }
661: return;
1.3 matthew 662: }
663:
1.42 raeburn 664: ################################################################
665: # discussion display subroutines
666: ################################################################
667: sub discussionchanger {
668: my $r = shift;
669: my $user = $ENV{'user.name'};
670: my $domain = $ENV{'user.domain'};
671: my %userenv = &Apache::lonnet::get
1.43 raeburn 672: ('environment',['discdisplay','discmarkread']);
673: my $discdisp = 'allposts';
674: my $discmark = 'onmark';
675:
676: if (defined($userenv{'discdisplay'})) {
677: unless ($userenv{'discdisplay'} eq '') {
678: $discdisp = $userenv{'discdisplay'};
679: }
680: }
681: if (defined($userenv{'discmarkread'})) {
682: unless ($userenv{'discdisplay'} eq '') {
683: $discmark = $userenv{'discmarkread'};
684: }
685: }
686:
687: my $newdisp = 'unread';
688: my $newmark = 'ondisp';
689:
690: my $function = &Apache::loncommon::get_users_function();
691: my $color = &Apache::loncommon::designparm($function.'.tabbg',
692: $ENV{'user.domain'});
693: my %lt = &Apache::lonlocal::texthash(
694: 'pref' => 'Display Preference',
695: 'curr' => 'Current setting ',
696: 'actn' => 'Action',
697: 'sdpf' => 'Set display preferences for discussion posts for both bulletin boards and individual resources in all your courses.',
698: 'prca' => 'Preferences can be set that determine',
699: 'whpo' => 'Which posts are displayed when you display a bulletin board or resource, and',
700: 'unwh' => 'Under what circumstances posts are identfied as "New"',
701: 'allposts' => 'All posts',
702: 'unread' => 'New posts only',
703: 'ondisp' => 'Once displayed',
704: 'onmark' => 'Once marked as read',
705: 'disa' => 'Posts displayed?',
706: 'npmr' => 'New posts cease to be identified as "New"?',
707: 'thde' => 'The preferences you set here can be overridden within each individual discussion.',
708: 'chgt' => 'Change to '
709: );
710: my $dispchange = $lt{'unread'};
711: my $markchange = $lt{'ondisp'};
712: my $currdisp = $lt{'allposts'};
713: my $currmark = $lt{'onmark'};
714:
715: if ($discdisp eq 'unread') {
716: $dispchange = $lt{'allposts'};
717: $currdisp = $lt{'unread'};
718: $newdisp = 'allposts';
719: }
720:
721: if ($discmark eq 'ondisp') {
722: $markchange = $lt{'onmark'};
723: $currmark = $lt{'ondisp'};
724: $newmark = 'onmark';
1.42 raeburn 725: }
1.43 raeburn 726:
727: $r->print(<<"END");
1.42 raeburn 728: <form name="server" action="/adm/preferences" method="post">
729: <input type="hidden" name="action" value="verify_and_change_discussion" />
730: <br />
1.43 raeburn 731: $lt{'sdpf'}<br/> $lt{'prca'} <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol>
732: <br />
733: <br />
734: <table border="0" cellpadding="0" cellspacing="0">
735: <tr>
736: <td width="100%" bgcolor="#000000">
737: <table width="100%" border="0" cellpadding="1" cellspacing="0">
738: <tr>
739: <td width="100%" bgcolor="#000000">
740: <table border="0" cellpadding="3" cellspacing="3" bgcolor="#FFFFFF">
741: <tr bgcolor="$color">
742: <td><b>$lt{'pref'}</b></td>
743: <td><b>$lt{'curr'}</b></td>
744: <td><b>$lt{'actn'}?</b></td>
745: </tr>
746: <tr bgcolor="#dddddd">
747: <td>$lt{'disa'}</td>
748: <td>$lt{$discdisp}</td>
749: <td><input type="checkbox" name="discdisp" /><input type="hidden" name="newdisp" value="$newdisp" /> $lt{'chgt'} "$dispchange"</td>
750: </tr><tr bgcolor="#eeeeee">
751: <td>$lt{'npmr'}</td>
752: <td>$lt{$discmark}</td>
753: <td><input type="checkbox" name="discmark" /><input type="hidden" name="newmark" value="$newmark" /> $lt{'chgt'} "$markchange"</td>
754: </tr>
755: </table>
756: </td>
757: </tr>
758: </table>
759: </td>
760: </tr>
761: </table>
762: <br />
763: <br />
764: <input type="submit" name="sub" value="Store Changes" />
765: <br />
766: <br />
767: Note: $lt{'thde'}
768: </form>
769: END
1.42 raeburn 770: }
771:
772: sub verify_and_change_discussion {
773: my $r = shift;
1.43 raeburn 774: my $user = $ENV{'user.name'};
775: my $domain = $ENV{'user.domain'};
1.42 raeburn 776: my $message='';
1.43 raeburn 777: if (defined($ENV{'form.discdisp'}) ) {
778: my $newdisp = $ENV{'form.newdisp'};
779: if ($newdisp eq 'unread') {
780: $message .='In discussions: only new posts will be displayed.<br/>';
781: &Apache::lonnet::put('environment',{'discdisplay' => $newdisp});
782: &Apache::lonnet::appenv('environment.discdisplay' => $newdisp);
783: } else {
784: $message .= 'In discussions: all posts will be displayed.<br/>';
785: &Apache::lonnet::del('environment',['discdisplay']);
786: &Apache::lonnet::delenv('environment\.discdisplay');
787: }
788: }
789: if (defined($ENV{'form.discmark'}) ) {
790: my $newmark = $ENV{'form.newmark'};
791: if ($newmark eq 'ondisp') {
792: $message.='In discussions: new posts will be cease to be identified as "new" after display.<br/>';
793: &Apache::lonnet::put('environment',{'discmarkread' => $newmark});
794: &Apache::lonnet::appenv('environment.discmarkread' => $newmark);
795: } else {
796: $message.='In discussions: posts will be identified as "new" until marked as read by the reader.<br/>';
797: &Apache::lonnet::del('environment',['discmarkread']);
798: &Apache::lonnet::delenv('environment\.discmarkread');
799: }
1.42 raeburn 800: }
801: $r->print(<<ENDVCSCREEN);
802: </p>
803: $message
804: ENDVCSCREEN
805: }
806:
1.4 matthew 807: ######################################################
808: # other handler subroutines #
809: ######################################################
810:
1.3 matthew 811: ################################################################
812: # Main handler #
813: ################################################################
1.1 www 814: sub handler {
815: my $r = shift;
1.3 matthew 816: my $user = $ENV{'user.name'};
817: my $domain = $ENV{'user.domain'};
1.31 www 818: &Apache::loncommon::content_type($r,'text/html');
1.4 matthew 819: # Some pages contain DES keys and should not be cached.
820: &Apache::loncommon::no_cache($r);
1.1 www 821: $r->send_http_header;
822: return OK if $r->header_only;
1.9 matthew 823: #
1.35 matthew 824: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.44 www 825: ['action','wysiwyg','returnurl']);
1.35 matthew 826: #
827: &Apache::lonhtmlcommon::clear_breadcrumbs();
828: &Apache::lonhtmlcommon::add_breadcrumb
829: ({href => '/adm/preferences',
830: text => 'Set User Preferences'});
831:
832: my @Options;
833: # Determine current authentication method
834: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
835: if ($currentauth =~ /^(unix|internal):/) {
836: push (@Options,({ action => 'changepass',
1.40 www 837: linktext => 'Change Password',
1.35 matthew 838: href => '/adm/preferences',
839: help => 'Change_Password',
840: subroutine => \&passwordchanger,
841: breadcrumb =>
842: { href => '/adm/preferences?action=changepass',
843: text => 'Change Password'},
844: },
845: { action => 'verify_and_change_pass',
846: subroutine => \&verify_and_change_password,
847: breadcrumb =>
848: { href =>'/adm/preferences?action=changepass',
849: text => 'Change Password'},
850: printmenu => 'yes',
851: }));
852: }
853: push (@Options,({ action => 'changescreenname',
854: linktext => 'Change Screen Name',
855: href => '/adm/preferences',
856: help => 'Prefs_Screen_Name_Nickname',
857: subroutine => \&screennamechanger,
858: breadcrumb =>
859: { href => '/adm/preferences?action=changescreenname',
860: text => 'Change Screen Name'},
861: },
862: { action => 'verify_and_change_screenname',
863: subroutine => \&verify_and_change_screenname,
864: breadcrumb =>
865: { href => '/adm/preferences?action=changescreenname',
866: text => 'Change Screen Name'},
867: printmenu => 'yes',
868: }));
869:
870: push (@Options,({ action => 'changemsgforward',
871: linktext => 'Change Message Forwarding',
872: text => 'and Notification Addresses',
873: href => '/adm/preferences',
874: help => 'Prefs_Forwarding',
875: breadcrumb =>
876: { href => '/adm/preferences?action=changemsgforward',
877: text => 'Change Message Forwarding'},
878: subroutine => \&msgforwardchanger,
879: },
880: { action => 'verify_and_change_msgforward',
881: breadcrumb =>
882: { href => '/adm/preferences?action=changemsgforward',
883: text => 'Change Message Forwarding'},
884: printmenu => 'yes',
885: subroutine => \&verify_and_change_msgforward }));
886: my $aboutmeaction=
887: '/adm/'.$ENV{'user.domain'}.'/'.$ENV{'user.name'}.'/aboutme';
888: push (@Options,{ action => 'none',
889: linktext =>
1.41 www 890: q{Edit the 'About Me' Personal Information Screen},
1.45 ! www 891: help => 'Prefs_About_Me',
1.35 matthew 892: href => $aboutmeaction});
893: push (@Options,({ action => 'changecolors',
894: linktext => 'Change Color Scheme',
895: href => '/adm/preferences',
896: help => 'Change_Colors',
897: breadcrumb =>
898: { href => '/adm/preferences?action=changecolors',
899: text => 'Change Colors'},
900: subroutine => \&colorschanger,
901: },
902: { action => 'verify_and_change_colors',
903: breadcrumb =>
904: { href => '/adm/preferences?action=changecolors',
905: text => 'Change Colors'},
906: printmenu => 'yes',
907: subroutine => \&verify_and_change_colors,
908: }));
909: push (@Options,({ action => 'changelanguages',
1.39 www 910: linktext => 'Change Language Preferences',
1.35 matthew 911: href => '/adm/preferences',
1.45 ! www 912: help => 'Prefs_Language',
1.35 matthew 913: breadcrumb=>
914: { href => '/adm/preferences?action=changelanguages',
915: text => 'Change Language'},
916: subroutine => \&languagechanger,
917: },
918: { action => 'verify_and_change_languages',
919: breadcrumb=>
920: {href => '/adm/preferences?action=changelanguages',
921: text => 'Change Language'},
922: printmenu => 'yes',
923: subroutine=>\&verify_and_change_languages, }
924: ));
1.44 www 925: push (@Options,({ action => 'changewysiwyg',
926: linktext => 'Change WYSIWYG Editor Preferences',
927: href => '/adm/preferences',
928: breadcrumb =>
929: { href => '/adm/preferences?action=changewysiwyg',
930: text => 'Change WYSIWYG Preferences'},
931: subroutine => \&wysiwygchanger,
932: },
933: { action => 'set_wysiwyg',
934: breadcrumb =>
935: { href => '/adm/preferences?action=changewysiwyg',
936: text => 'Change WYSIWYG Preferences'},
937: printmenu => 'yes',
938: subroutine => \&verify_and_change_wysiwyg, }
939: ));
1.42 raeburn 940: push (@Options,({ action => 'changediscussions',
941: linktext => 'Change Discussion Display Preferences',
942: href => '/adm/preferences',
943: breadcrumb =>
944: { href => '/adm/preferences?action=changediscussions',
1.43 raeburn 945: text => 'Change Discussion Preferences'},
1.42 raeburn 946: subroutine => \&discussionchanger,
947: },
948: { action => 'verify_and_change_discussion',
949: breadcrumb =>
950: { href => '/adm/preferences?action=changediscussions',
1.43 raeburn 951: text => 'Change Discussion Preferences'},
1.42 raeburn 952: printmenu => 'yes',
953: subroutine => \&verify_and_change_discussion, }
954: ));
955:
1.35 matthew 956: if ($ENV{'user.name'} =~ /^(albertel|koretemey|korte|hallmat3|turtle)$/) {
957: push (@Options,({ action => 'debugtoggle',
958: printmenu => 'yes',
959: subroutine => \&toggle_debug,
960: }));
961: }
962: $r->print(<<ENDHEADER);
1.1 www 963: <html>
964: <head>
1.4 matthew 965: <title>LON-CAPA Preferences</title>
1.1 www 966: </head>
1.3 matthew 967: ENDHEADER
1.35 matthew 968: my $call = undef;
969: my $printmenu = 'yes';
970: foreach my $option (@Options) {
971: if ($option->{'action'} eq $ENV{'form.action'}) {
972: $call = $option->{'subroutine'};
973: $printmenu = $option->{'printmenu'};
974: if (exists($option->{'breadcrumb'})) {
975: &Apache::lonhtmlcommon::add_breadcrumb
976: ($option->{'breadcrumb'});
977: }
978: }
979: }
980: $r->print(&Apache::loncommon::bodytag('Change Preferences'));
981: $r->print(&Apache::lonhtmlcommon::breadcrumbs
982: (undef,'Change Preferences'));
983: if (defined($call)) {
984: $call->($r);
985: }
1.44 www 986: if (($printmenu eq 'yes') && (!$ENV{'form.returnurl'})) {
1.35 matthew 987: my $optionlist = '<table cellpadding="5">';
988: if ($ENV{'user.name'} =~
1.37 www 989: /^(albertel|kortemey|korte|hallmat3|turtle)$/
1.35 matthew 990: ) {
991: push (@Options,({ action => 'debugtoggle',
992: linktext => 'Toggle Debug Messages',
993: text => 'Current Debug status is -'.
994: $ENV{'user.debug'}.'-.',
995: href => '/adm/preferences',
996: printmenu => 'yes',
997: subroutine => \&toggle_debug,
998: }));
999: }
1000: foreach my $option(@Options) {
1001: my $optiontext = '';
1002: if (exists($option->{'href'})) {
1003: $optiontext .=
1004: '<a href="'.$option->{'href'}.
1005: '?action='.$option->{'action'}.'">'.
1006: $option->{'linktext'}.'</a>';
1007: }
1008: if (exists($option->{'text'})) {
1009: $optiontext .= ' '.$option->{'text'};
1010: }
1011: if ($optiontext ne '') {
1012: $optiontext = '<font size="+1">'.$optiontext.'</font>';
1013: my $helplink = ' ';
1014: if (exists($option->{'help'})) {
1015: $helplink = &Apache::loncommon::help_open_topic
1016: ($option->{'help'});
1017: }
1018: $optionlist .= '<tr>'.
1019: '<td>'.$helplink.'</td>'.
1020: '<td>'.$optiontext.'</td>'.
1021: '</tr>';
1022: }
1.13 www 1023: }
1.35 matthew 1024: $optionlist .= '</table>';
1025: $r->print($optionlist);
1.44 www 1026: } elsif ($ENV{'form.returnurl'}) {
1027: $r->print('<br /><a href="'.$ENV{'form.returnurl'}.'"><font size="+1">'.
1028: &mt('Return').'</font></a>');
1.3 matthew 1029: }
1030: $r->print(<<ENDFOOTER);
1.1 www 1031: </body>
1032: </html>
1.3 matthew 1033: ENDFOOTER
1.1 www 1034: return OK;
1.35 matthew 1035: }
1036:
1037: sub toggle_debug {
1038: if ($ENV{'user.debug'}) {
1039: &Apache::lonnet::delenv('user\.debug');
1040: } else {
1041: &Apache::lonnet::appenv('user.debug' => 1);
1042: }
1.13 www 1043: }
1.1 www 1044:
1045: 1;
1046: __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