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