1: # The LearningOnline Network
2: # Preferences
3: #
4: # $Id: lonpreferences.pm,v 1.39 2004/03/26 17:11:37 www Exp $
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: #
28: # 2/13/02 2/14 2/15 Matthew Hall
29: #
30: # This package uses the "londes.js" javascript code.
31: #
32: # TODOs that have to be completed:
33: # interface with lonnet to change the password
34:
35: package Apache::lonpreferences;
36:
37: use strict;
38: use Apache::Constants qw(:common);
39: use Apache::File;
40: use Crypt::DES;
41: use DynaLoader; # for Crypt::DES version
42: use Apache::loncommon();
43: use Apache::lonhtmlcommon();
44: use Apache::lonlocal;
45:
46: #
47: # Write lonnet::passwd to do the call below.
48: # Use:
49: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
50: #
51: ##################################################
52: # password associated functions #
53: ##################################################
54: sub des_keys {
55: # Make a new key for DES encryption.
56: # Each key has two parts which are returned separately.
57: # Please note: Each key must be passed through the &hex function
58: # before it is output to the web browser. The hex versions cannot
59: # be used to decrypt.
60: my @hexstr=('0','1','2','3','4','5','6','7',
61: '8','9','a','b','c','d','e','f');
62: my $lkey='';
63: for (0..7) {
64: $lkey.=$hexstr[rand(15)];
65: }
66: my $ukey='';
67: for (0..7) {
68: $ukey.=$hexstr[rand(15)];
69: }
70: return ($lkey,$ukey);
71: }
72:
73: sub des_decrypt {
74: my ($key,$cyphertext) = @_;
75: my $keybin=pack("H16",$key);
76: my $cypher;
77: if ($Crypt::DES::VERSION>=2.03) {
78: $cypher=new Crypt::DES $keybin;
79: } else {
80: $cypher=new DES $keybin;
81: }
82: my $plaintext=
83: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
84: $plaintext.=
85: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
86: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
87: return $plaintext;
88: }
89:
90: ################################################################
91: # Handler subroutines #
92: ################################################################
93:
94: ################################################################
95: # Language Change Subroutines #
96: ################################################################
97: sub languagechanger {
98: my $r = shift;
99: my $user = $ENV{'user.name'};
100: my $domain = $ENV{'user.domain'};
101: my %userenv = &Apache::lonnet::get
102: ('environment',['languages']);
103: my $language=$userenv{'languages'};
104:
105: my $pref=&mt('Preferred language');
106: my %langchoices=('' => 'No language preference');
107: foreach (&Apache::loncommon::languageids()) {
108: if (&Apache::loncommon::supportedlanguagecode($_)) {
109: $langchoices{&Apache::loncommon::supportedlanguagecode($_)}
110: = &Apache::loncommon::plainlanguagedescription($_);
111: }
112: }
113: my $selectionbox=&Apache::loncommon::select_form($language,'language',
114: %langchoices);
115: $r->print(<<ENDLSCREEN);
116: <form name="server" action="/adm/preferences" method="post">
117: <input type="hidden" name="action" value="verify_and_change_languages" />
118: <br />$pref: $selectionbox
119: ENDLSCREEN
120: $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
121: }
122:
123:
124: sub verify_and_change_languages {
125: my $r = shift;
126: my $user = $ENV{'user.name'};
127: my $domain = $ENV{'user.domain'};
128: # Screenname
129: my $newlanguage = $ENV{'form.language'};
130: $newlanguage=~s/[^\-\w]//g;
131: my $message='';
132: if ($newlanguage) {
133: &Apache::lonnet::put('environment',{'languages' => $newlanguage});
134: &Apache::lonnet::appenv('environment.languages' => $newlanguage);
135: $message='Set new preferred languages to '.$newlanguage;
136: } else {
137: &Apache::lonnet::del('environment',['languages']);
138: &Apache::lonnet::delenv('environment\.languages');
139: $message='Reset preferred language';
140: }
141: $r->print(<<ENDVCSCREEN);
142: </p>
143: $message
144: ENDVCSCREEN
145: }
146:
147:
148: ################################################################
149: # Anonymous Discussion Name Change Subroutines #
150: ################################################################
151: sub screennamechanger {
152: my $r = shift;
153: my $user = $ENV{'user.name'};
154: my $domain = $ENV{'user.domain'};
155: my %userenv = &Apache::lonnet::get
156: ('environment',['screenname','nickname']);
157: my $screenname=$userenv{'screenname'};
158: my $nickname=$userenv{'nickname'};
159: $r->print(<<ENDSCREEN);
160: <form name="server" action="/adm/preferences" method="post">
161: <input type="hidden" name="action" value="verify_and_change_screenname" />
162: <br />New screenname (shown if you post anonymously):
163: <input type="text" size="20" value="$screenname" name="screenname" />
164: <br />New nickname (shown if you post non-anonymously):
165: <input type="text" size="20" value="$nickname" name="nickname" />
166: <input type="submit" value="Change" />
167: </form>
168: ENDSCREEN
169: }
170:
171: sub verify_and_change_screenname {
172: my $r = shift;
173: my $user = $ENV{'user.name'};
174: my $domain = $ENV{'user.domain'};
175: # Screenname
176: my $newscreen = $ENV{'form.screenname'};
177: $newscreen=~s/[^ \w]//g;
178: my $message='';
179: if ($newscreen) {
180: &Apache::lonnet::put('environment',{'screenname' => $newscreen});
181: &Apache::lonnet::appenv('environment.screenname' => $newscreen);
182: $message='Set new screenname to '.$newscreen;
183: } else {
184: &Apache::lonnet::del('environment',['screenname']);
185: &Apache::lonnet::delenv('environment\.screenname');
186: $message='Reset screenname';
187: }
188: # Nickname
189: $message.='<br />';
190: $newscreen = $ENV{'form.nickname'};
191: $newscreen=~s/[^ \w]//g;
192: if ($newscreen) {
193: &Apache::lonnet::put('environment',{'nickname' => $newscreen});
194: &Apache::lonnet::appenv('environment.nickname' => $newscreen);
195: $message.='Set new nickname to '.$newscreen;
196: } else {
197: &Apache::lonnet::del('environment',['nickname']);
198: &Apache::lonnet::delenv('environment\.nickname');
199: $message.='Reset nickname';
200: }
201:
202: $r->print(<<ENDVCSCREEN);
203: </p>
204: $message
205: ENDVCSCREEN
206: }
207:
208: ################################################################
209: # Message Forward #
210: ################################################################
211:
212: sub msgforwardchanger {
213: my $r = shift;
214: my $user = $ENV{'user.name'};
215: my $domain = $ENV{'user.domain'};
216: my %userenv = &Apache::lonnet::get('environment',['msgforward','notification','critnotification']);
217: my $msgforward=$userenv{'msgforward'};
218: my $notification=$userenv{'notification'};
219: my $critnotification=$userenv{'critnotification'};
220: my $forwardingHelp = Apache::loncommon::help_open_topic("Prefs_Forwarding",
221: "What are forwarding ".
222: "and notification ".
223: "addresses");
224: my $criticalMessageHelp = Apache::loncommon::help_open_topic("Course_Critical_Message",
225: "What are critical messages");
226:
227: $r->print(<<ENDMSG);
228: $forwardingHelp <br />
229: <form name="server" action="/adm/preferences" method="post">
230: <input type="hidden" name="action" value="verify_and_change_msgforward" />
231: New Forwarding Address(es) (<tt>user:domain,user:domain,...</tt>):
232: <input type="text" size="40" value="$msgforward" name="msgforward" /><hr />
233: New Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
234: <input type="text" size="40" value="$notification" name="notification" /><hr />
235: New Critical Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
236: <input type="text" size="40" value="$critnotification" name="critnotification" />$criticalMessageHelp<hr />
237: <input type="submit" value="Change" />
238: </form>
239: ENDMSG
240: }
241:
242: sub verify_and_change_msgforward {
243: my $r = shift;
244: my $user = $ENV{'user.name'};
245: my $domain = $ENV{'user.domain'};
246: my $newscreen = '';
247: my $message='';
248: foreach (split(/\,/,$ENV{'form.msgforward'})) {
249: my ($msuser,$msdomain)=split(/[\@\:]/,$_);
250: $msuser=~s/\W//g;
251: $msdomain=~s/\W//g;
252: if (($msuser) && ($msdomain)) {
253: if (&Apache::lonnet::homeserver($msuser,$msdomain) ne 'no_host') {
254: $newscreen.=$msuser.':'.$msdomain.',';
255: } else {
256: $message.='No such user: '.$msuser.':'.$msdomain.'<br>';
257: }
258: }
259: }
260: $newscreen=~s/\,$//;
261: if ($newscreen) {
262: &Apache::lonnet::put('environment',{'msgforward' => $newscreen});
263: &Apache::lonnet::appenv('environment.msgforward' => $newscreen);
264: $message.='Set new message forwarding to '.$newscreen.'<br />';
265: } else {
266: &Apache::lonnet::del('environment',['msgforward']);
267: &Apache::lonnet::delenv('environment\.msgforward');
268: $message.='Reset message forwarding<br />';
269: }
270: my $notification=$ENV{'form.notification'};
271: $notification=~s/\s//gs;
272: if ($notification) {
273: &Apache::lonnet::put('environment',{'notification' => $notification});
274: &Apache::lonnet::appenv('environment.notification' => $notification);
275: $message.='Set message notification address to '.$notification.'<br />';
276: } else {
277: &Apache::lonnet::del('environment',['notification']);
278: &Apache::lonnet::delenv('environment\.notification');
279: $message.='Reset message notification<br />';
280: }
281: my $critnotification=$ENV{'form.critnotification'};
282: $critnotification=~s/\s//gs;
283: if ($critnotification) {
284: &Apache::lonnet::put('environment',{'critnotification' => $critnotification});
285: &Apache::lonnet::appenv('environment.critnotification' => $critnotification);
286: $message.='Set critical message notification address to '.$critnotification;
287: } else {
288: &Apache::lonnet::del('environment',['critnotification']);
289: &Apache::lonnet::delenv('environment\.critnotification');
290: $message.='Reset critical message notification<br />';
291: }
292: $r->print(<<ENDVCMSG);
293: </p>
294: $message
295: ENDVCMSG
296: }
297:
298: ################################################################
299: # Colors #
300: ################################################################
301:
302: sub colorschanger {
303: my $r = shift;
304: # figure out colors
305: my $function='student';
306: if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
307: $function='coordinator';
308: }
309: if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
310: $function='admin';
311: }
312: if (($ENV{'request.role'}=~/^(au|ca)/) ||
313: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
314: $function='author';
315: }
316: my $domain=&Apache::loncommon::determinedomain();
317: my %colortypes=('pgbg' => 'Page Background',
318: 'tabbg' => 'Header Background',
319: 'sidebg'=> 'Header Border',
320: 'font' => 'Font',
321: 'link' => 'Un-Visited Link',
322: 'vlink' => 'Visited Link',
323: 'alink' => 'Active Link');
324: my $chtable='';
325: foreach my $item (sort(keys(%colortypes))) {
326: my $curcol=&Apache::loncommon::designparm($function.'.'.$item,$domain);
327: $chtable.='<tr><td>'.$colortypes{$item}.'</td><td bgcolor="'.$curcol.
328: '"> </td><td><input name="'.$item.
329: '" size="10" value="'.$curcol.
330: '" /></td><td><a href="javascript:pjump('."'color_custom','".$colortypes{$item}.
331: "','".$curcol."','"
332: .$item."','parmform.pres','psub'".');">Select</a></td></tr>';
333: }
334: my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
335: $r->print(<<ENDCOL);
336: <script>
337:
338: function pclose() {
339: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
340: "height=350,width=350,scrollbars=no,menubar=no");
341: parmwin.close();
342: }
343:
344: $pjump_def
345:
346: function psub() {
347: pclose();
348: if (document.parmform.pres_marker.value!='') {
349: if (document.parmform.pres_type.value!='') {
350: eval('document.server.'+
351: document.parmform.pres_marker.value+
352: '.value=document.parmform.pres_value.value;');
353: }
354: } else {
355: document.parmform.pres_value.value='';
356: document.parmform.pres_marker.value='';
357: }
358: }
359:
360:
361: </script>
362: <form name="parmform">
363: <input type="hidden" name="pres_marker" />
364: <input type="hidden" name="pres_type" />
365: <input type="hidden" name="pres_value" />
366: </form>
367: <form name="server" action="/adm/preferences" method="post">
368: <input type="hidden" name="action" value="verify_and_change_colors" />
369: <table border="2">
370: $chtable
371: </table>
372: <input type="submit" value="Change Custom Colors" />
373: <input type="submit" name="resetall" value="Reset All Colors to Default" />
374: </form>
375: ENDCOL
376: }
377:
378: sub verify_and_change_colors {
379: my $r = shift;
380: # figure out colors
381: my $function='student';
382: if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
383: $function='coordinator';
384: }
385: if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
386: $function='admin';
387: }
388: if (($ENV{'request.role'}=~/^(au|ca)/) ||
389: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
390: $function='author';
391: }
392: my $domain=&Apache::loncommon::determinedomain();
393: my %colortypes=('pgbg' => 'Page Background',
394: 'tabbg' => 'Header Background',
395: 'sidebg'=> 'Header Border',
396: 'font' => 'Font',
397: 'link' => 'Un-Visited Link',
398: 'vlink' => 'Visited Link',
399: 'alink' => 'Active Link');
400:
401: my $message='';
402: foreach my $item (keys %colortypes) {
403: my $color=$ENV{'form.'.$item};
404: my $entry='color.'.$function.'.'.$item;
405: if (($color=~/^\#[0-9A-Fa-f]{6}$/) && (!$ENV{'form.resetall'})) {
406: &Apache::lonnet::put('environment',{$entry => $color});
407: &Apache::lonnet::appenv('environment.'.$entry => $color);
408: $message.='Set '.$colortypes{$item}.' to '.$color.'<br />';
409: } else {
410: &Apache::lonnet::del('environment',[$entry]);
411: &Apache::lonnet::delenv('environment\.'.$entry);
412: $message.='Reset '.$colortypes{$item}.'<br />';
413: }
414: }
415: $r->print(<<ENDVCCOL);
416: </p>
417: $message
418: <form name="client" action="/adm/preferences" method="post">
419: <input type="hidden" name="action" value="changecolors" />
420: </form>
421: ENDVCCOL
422: }
423:
424: ######################################################
425: # password handler subroutines #
426: ######################################################
427: sub passwordchanger {
428: # This function is a bit of a mess....
429: # Passwords are encrypted using londes.js (DES encryption)
430: my $r = shift;
431: my $errormessage = shift;
432: $errormessage = ($errormessage || '');
433: my $user = $ENV{'user.name'};
434: my $domain = $ENV{'user.domain'};
435: my $homeserver = $ENV{'user.home'};
436: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
437: # Check for authentication types that allow changing of the password.
438: return if ($currentauth !~ /^(unix|internal):/);
439: #
440: # Generate keys
441: my ($lkey_cpass ,$ukey_cpass ) = &des_keys();
442: my ($lkey_npass1,$ukey_npass1) = &des_keys();
443: my ($lkey_npass2,$ukey_npass2) = &des_keys();
444: # Store the keys in the log files
445: my $lonhost = $r->dir_config('lonHostID');
446: my $logtoken=Apache::lonnet::reply('tmpput:'
447: .$ukey_cpass . $lkey_cpass .'&'
448: .$ukey_npass1 . $lkey_npass1.'&'
449: .$ukey_npass2 . $lkey_npass2,
450: $lonhost);
451: # Hexify the keys for output as javascript variables
452: $ukey_cpass = hex($ukey_cpass);
453: $lkey_cpass = hex($lkey_cpass);
454: $ukey_npass1= hex($ukey_npass1);
455: $lkey_npass1= hex($lkey_npass1);
456: $ukey_npass2= hex($ukey_npass2);
457: $lkey_npass2= hex($lkey_npass2);
458: # Output javascript to deal with passwords
459: # Output DES javascript
460: $r->print("<html><head>");
461: {
462: my $include = $r->dir_config('lonIncludes');
463: my $jsh=Apache::File->new($include."/londes.js");
464: $r->print(<$jsh>);
465: }
466: $r->print(<<ENDFORM);
467: <script language="JavaScript">
468:
469: function send() {
470: uextkey=this.document.client.elements.ukey_cpass.value;
471: lextkey=this.document.client.elements.lkey_cpass.value;
472: initkeys();
473:
474: this.document.server.elements.currentpass.value
475: =crypted(this.document.client.elements.currentpass.value);
476:
477: uextkey=this.document.client.elements.ukey_npass1.value;
478: lextkey=this.document.client.elements.lkey_npass1.value;
479: initkeys();
480: this.document.server.elements.newpass_1.value
481: =crypted(this.document.client.elements.newpass_1.value);
482:
483: uextkey=this.document.client.elements.ukey_npass2.value;
484: lextkey=this.document.client.elements.lkey_npass2.value;
485: initkeys();
486: this.document.server.elements.newpass_2.value
487: =crypted(this.document.client.elements.newpass_2.value);
488:
489: this.document.server.submit();
490: }
491:
492: </script>
493: $errormessage
494:
495: <p>
496: <!-- We separate the forms into 'server' and 'client' in order to
497: ensure that unencrypted passwords will not be sent out by a
498: crappy browser -->
499:
500: <form name="server" action="/adm/preferences" method="post">
501: <input type="hidden" name="logtoken" value="$logtoken" />
502: <input type="hidden" name="action" value="verify_and_change_pass" />
503: <input type="hidden" name="currentpass" value="" />
504: <input type="hidden" name="newpass_1" value="" />
505: <input type="hidden" name="newpass_2" value="" />
506: </form>
507:
508: <form name="client" >
509: <table>
510: <tr><td align="right"> Current password: </td>
511: <td><input type="password" name="currentpass" size="10"/> </td></tr>
512: <tr><td align="right"> New password: </td>
513: <td><input type="password" name="newpass_1" size="10" /> </td></tr>
514: <tr><td align="right"> Confirm password: </td>
515: <td><input type="password" name="newpass_2" size="10" /> </td></tr>
516: <tr><td colspan="2" align="center">
517: <input type="button" value="Change Password" onClick="send();">
518: </table>
519: <input type="hidden" name="ukey_cpass" value="$ukey_cpass" />
520: <input type="hidden" name="lkey_cpass" value="$lkey_cpass" />
521: <input type="hidden" name="ukey_npass1" value="$ukey_npass1" />
522: <input type="hidden" name="lkey_npass1" value="$lkey_npass1" />
523: <input type="hidden" name="ukey_npass2" value="$ukey_npass2" />
524: <input type="hidden" name="lkey_npass2" value="$lkey_npass2" />
525: </form>
526: </p>
527: ENDFORM
528: #
529: return;
530: }
531:
532: sub verify_and_change_password {
533: my $r = shift;
534: my $user = $ENV{'user.name'};
535: my $domain = $ENV{'user.domain'};
536: my $homeserver = $ENV{'user.home'};
537: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
538: # Check for authentication types that allow changing of the password.
539: return if ($currentauth !~ /^(unix|internal):/);
540: #
541: $r->print(<<ENDHEADER);
542: <html>
543: <head>
544: <title>LON-CAPA Preferences: Change password for $user</title>
545: </head>
546: ENDHEADER
547: #
548: my $currentpass = $ENV{'form.currentpass'};
549: my $newpass1 = $ENV{'form.newpass_1'};
550: my $newpass2 = $ENV{'form.newpass_2'};
551: my $logtoken = $ENV{'form.logtoken'};
552: # Check for empty data
553: unless (defined($currentpass) &&
554: defined($newpass1) &&
555: defined($newpass2) ){
556: &passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
557: "Password data was blank.\n</p>");
558: return;
559: }
560: # Get the keys
561: my $lonhost = $r->dir_config('lonHostID');
562: my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
563: if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
564: # I do not a have a better idea about how to handle this
565: $r->print(<<ENDERROR);
566: <p>
567: <font color="#ff0000">ERROR:</font> Unable to retrieve stored token for
568: password decryption. Please log out and try again.
569: </p>
570: ENDERROR
571: # Probably should log an error here
572: return;
573: }
574: my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
575: #
576: $currentpass = &des_decrypt($ckey ,$currentpass);
577: $newpass1 = &des_decrypt($n1key,$newpass1);
578: $newpass2 = &des_decrypt($n2key,$newpass2);
579: #
580: if ($newpass1 ne $newpass2) {
581: &passwordchanger($r,
582: '<font color="#ff0000">ERROR:</font>'.
583: 'The new passwords you entered do not match. '.
584: 'Please try again.');
585: return;
586: }
587: if (length($newpass1) < 7) {
588: &passwordchanger($r,
589: '<font color="#ff0000">ERROR:</font>'.
590: 'Passwords must be a minimum of 7 characters long. '.
591: 'Please try again.');
592: return;
593: }
594: #
595: # Check for bad characters
596: my $badpassword = 0;
597: foreach (split(//,$newpass1)) {
598: $badpassword = 1 if ((ord($_)<32)||(ord($_)>126));
599: }
600: if ($badpassword) {
601: # I can't figure out how to enter bad characters on my browser.
602: &passwordchanger($r,<<ENDERROR);
603: <font color="#ff0000">ERROR:</font>
604: The password you entered contained illegal characters.<br />
605: Valid characters are: space and <br />
606: <pre>
607: !"\#$%&\'()*+,-./0123456789:;<=>?\@
608: ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_\`abcdefghijklmnopqrstuvwxyz{|}~
609: </pre>
610: ENDERROR
611: }
612: #
613: # Change the password (finally)
614: my $result = &Apache::lonnet::changepass
615: ($user,$domain,$currentpass,$newpass1,$homeserver);
616: # Inform the user the password has (not?) been changed
617: if ($result =~ /^ok$/) {
618: $r->print(<<"ENDTEXT");
619: <h2>The password for $user was successfully changed</h2>
620: ENDTEXT
621: } else {
622: # error error: run in circles, scream and shout
623: $r->print(<<ENDERROR);
624: <h2><font color="#ff0000">The password for $user was not changed</font></h2>
625: Please make sure your old password was entered correctly.
626: ENDERROR
627: }
628: return;
629: }
630:
631: ######################################################
632: # other handler subroutines #
633: ######################################################
634:
635: ################################################################
636: # Main handler #
637: ################################################################
638: sub handler {
639: my $r = shift;
640: my $user = $ENV{'user.name'};
641: my $domain = $ENV{'user.domain'};
642: &Apache::loncommon::content_type($r,'text/html');
643: # Some pages contain DES keys and should not be cached.
644: &Apache::loncommon::no_cache($r);
645: $r->send_http_header;
646: return OK if $r->header_only;
647: #
648: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
649: ['action']);
650: #
651: &Apache::lonhtmlcommon::clear_breadcrumbs();
652: &Apache::lonhtmlcommon::add_breadcrumb
653: ({href => '/adm/preferences',
654: text => 'Set User Preferences'});
655:
656: my @Options;
657: # Determine current authentication method
658: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
659: if ($currentauth =~ /^(unix|internal):/) {
660: push (@Options,({ action => 'changepass',
661: linktext => 'Change password',
662: href => '/adm/preferences',
663: help => 'Change_Password',
664: subroutine => \&passwordchanger,
665: breadcrumb =>
666: { href => '/adm/preferences?action=changepass',
667: text => 'Change Password'},
668: },
669: { action => 'verify_and_change_pass',
670: subroutine => \&verify_and_change_password,
671: breadcrumb =>
672: { href =>'/adm/preferences?action=changepass',
673: text => 'Change Password'},
674: printmenu => 'yes',
675: }));
676: }
677: push (@Options,({ action => 'changescreenname',
678: linktext => 'Change Screen Name',
679: href => '/adm/preferences',
680: help => 'Prefs_Screen_Name_Nickname',
681: subroutine => \&screennamechanger,
682: breadcrumb =>
683: { href => '/adm/preferences?action=changescreenname',
684: text => 'Change Screen Name'},
685: },
686: { action => 'verify_and_change_screenname',
687: subroutine => \&verify_and_change_screenname,
688: breadcrumb =>
689: { href => '/adm/preferences?action=changescreenname',
690: text => 'Change Screen Name'},
691: printmenu => 'yes',
692: }));
693:
694: push (@Options,({ action => 'changemsgforward',
695: linktext => 'Change Message Forwarding',
696: text => 'and Notification Addresses',
697: href => '/adm/preferences',
698: help => 'Prefs_Forwarding',
699: breadcrumb =>
700: { href => '/adm/preferences?action=changemsgforward',
701: text => 'Change Message Forwarding'},
702: subroutine => \&msgforwardchanger,
703: },
704: { action => 'verify_and_change_msgforward',
705: breadcrumb =>
706: { href => '/adm/preferences?action=changemsgforward',
707: text => 'Change Message Forwarding'},
708: printmenu => 'yes',
709: subroutine => \&verify_and_change_msgforward }));
710: my $aboutmeaction=
711: '/adm/'.$ENV{'user.domain'}.'/'.$ENV{'user.name'}.'/aboutme';
712: push (@Options,{ action => 'none',
713: linktext =>
714: q{Edit the 'About Me' personal information screen},
715: href => $aboutmeaction});
716: push (@Options,({ action => 'changecolors',
717: linktext => 'Change Color Scheme',
718: href => '/adm/preferences',
719: help => 'Change_Colors',
720: breadcrumb =>
721: { href => '/adm/preferences?action=changecolors',
722: text => 'Change Colors'},
723: subroutine => \&colorschanger,
724: },
725: { action => 'verify_and_change_colors',
726: breadcrumb =>
727: { href => '/adm/preferences?action=changecolors',
728: text => 'Change Colors'},
729: printmenu => 'yes',
730: subroutine => \&verify_and_change_colors,
731: }));
732: push (@Options,({ action => 'changelanguages',
733: linktext => 'Change Language Preferences',
734: href => '/adm/preferences',
735: breadcrumb=>
736: { href => '/adm/preferences?action=changelanguages',
737: text => 'Change Language'},
738: subroutine => \&languagechanger,
739: },
740: { action => 'verify_and_change_languages',
741: breadcrumb=>
742: {href => '/adm/preferences?action=changelanguages',
743: text => 'Change Language'},
744: printmenu => 'yes',
745: subroutine=>\&verify_and_change_languages, }
746: ));
747: if ($ENV{'user.name'} =~ /^(albertel|koretemey|korte|hallmat3|turtle)$/) {
748: push (@Options,({ action => 'debugtoggle',
749: printmenu => 'yes',
750: subroutine => \&toggle_debug,
751: }));
752: }
753: $r->print(<<ENDHEADER);
754: <html>
755: <head>
756: <title>LON-CAPA Preferences</title>
757: </head>
758: ENDHEADER
759: my $call = undef;
760: my $printmenu = 'yes';
761: foreach my $option (@Options) {
762: if ($option->{'action'} eq $ENV{'form.action'}) {
763: $call = $option->{'subroutine'};
764: $printmenu = $option->{'printmenu'};
765: if (exists($option->{'breadcrumb'})) {
766: &Apache::lonhtmlcommon::add_breadcrumb
767: ($option->{'breadcrumb'});
768: }
769: }
770: }
771: $r->print(&Apache::loncommon::bodytag('Change Preferences'));
772: $r->print(&Apache::lonhtmlcommon::breadcrumbs
773: (undef,'Change Preferences'));
774: if (defined($call)) {
775: $call->($r);
776: }
777: if ($printmenu eq 'yes') {
778: my $optionlist = '<table cellpadding="5">';
779: if ($ENV{'user.name'} =~
780: /^(albertel|kortemey|korte|hallmat3|turtle)$/
781: ) {
782: push (@Options,({ action => 'debugtoggle',
783: linktext => 'Toggle Debug Messages',
784: text => 'Current Debug status is -'.
785: $ENV{'user.debug'}.'-.',
786: href => '/adm/preferences',
787: printmenu => 'yes',
788: subroutine => \&toggle_debug,
789: }));
790: }
791: foreach my $option(@Options) {
792: my $optiontext = '';
793: if (exists($option->{'href'})) {
794: $optiontext .=
795: '<a href="'.$option->{'href'}.
796: '?action='.$option->{'action'}.'">'.
797: $option->{'linktext'}.'</a>';
798: }
799: if (exists($option->{'text'})) {
800: $optiontext .= ' '.$option->{'text'};
801: }
802: if ($optiontext ne '') {
803: $optiontext = '<font size="+1">'.$optiontext.'</font>';
804: my $helplink = ' ';
805: if (exists($option->{'help'})) {
806: $helplink = &Apache::loncommon::help_open_topic
807: ($option->{'help'});
808: }
809: $optionlist .= '<tr>'.
810: '<td>'.$helplink.'</td>'.
811: '<td>'.$optiontext.'</td>'.
812: '</tr>';
813: }
814: }
815: $optionlist .= '</table>';
816: $r->print($optionlist);
817: }
818: $r->print(<<ENDFOOTER);
819: </body>
820: </html>
821: ENDFOOTER
822: return OK;
823: }
824:
825: sub toggle_debug {
826: if ($ENV{'user.debug'}) {
827: &Apache::lonnet::delenv('user\.debug');
828: } else {
829: &Apache::lonnet::appenv('user.debug' => 1);
830: }
831: }
832:
833: 1;
834: __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