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