Annotation of loncom/interface/lonpreferences.pm, revision 1.43
1.1 www 1: # The LearningOnline Network
2: # Preferences
3: #
1.43 ! raeburn 4: # $Id: lonpreferences.pm,v 1.42 2004/05/11 10:42:41 raeburn 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: ################################################################
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
1.32 www 100: ('environment',['languages']);
1.29 www 101: my $language=$userenv{'languages'};
1.32 www 102:
1.33 www 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);
1.28 www 113: $r->print(<<ENDLSCREEN);
114: <form name="server" action="/adm/preferences" method="post">
115: <input type="hidden" name="action" value="verify_and_change_languages" />
1.33 www 116: <br />$pref: $selectionbox
1.28 www 117: ENDLSCREEN
1.35 matthew 118: $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
1.28 www 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) {
1.29 www 131: &Apache::lonnet::put('environment',{'languages' => $newlanguage});
132: &Apache::lonnet::appenv('environment.languages' => $newlanguage);
133: $message='Set new preferred languages to '.$newlanguage;
1.28 www 134: } else {
1.29 www 135: &Apache::lonnet::del('environment',['languages']);
136: &Apache::lonnet::delenv('environment\.languages');
1.28 www 137: $message='Reset preferred language';
138: }
139: $r->print(<<ENDVCSCREEN);
140: </p>
141: $message
142: ENDVCSCREEN
143: }
144:
145:
146: ################################################################
1.9 matthew 147: # Anonymous Discussion Name Change Subroutines #
148: ################################################################
1.5 www 149: sub screennamechanger {
150: my $r = shift;
151: my $user = $ENV{'user.name'};
152: my $domain = $ENV{'user.domain'};
1.14 www 153: my %userenv = &Apache::lonnet::get
154: ('environment',['screenname','nickname']);
1.6 www 155: my $screenname=$userenv{'screenname'};
1.14 www 156: my $nickname=$userenv{'nickname'};
1.5 www 157: $r->print(<<ENDSCREEN);
1.6 www 158: <form name="server" action="/adm/preferences" method="post">
159: <input type="hidden" name="action" value="verify_and_change_screenname" />
1.14 www 160: <br />New screenname (shown if you post anonymously):
1.6 www 161: <input type="text" size="20" value="$screenname" name="screenname" />
1.14 www 162: <br />New nickname (shown if you post non-anonymously):
163: <input type="text" size="20" value="$nickname" name="nickname" />
1.6 www 164: <input type="submit" value="Change" />
165: </form>
1.5 www 166: ENDSCREEN
167: }
1.6 www 168:
169: sub verify_and_change_screenname {
170: my $r = shift;
171: my $user = $ENV{'user.name'};
172: my $domain = $ENV{'user.domain'};
1.14 www 173: # Screenname
1.6 www 174: my $newscreen = $ENV{'form.screenname'};
1.14 www 175: $newscreen=~s/[^ \w]//g;
1.6 www 176: my $message='';
177: if ($newscreen) {
1.7 www 178: &Apache::lonnet::put('environment',{'screenname' => $newscreen});
179: &Apache::lonnet::appenv('environment.screenname' => $newscreen);
1.6 www 180: $message='Set new screenname to '.$newscreen;
181: } else {
182: &Apache::lonnet::del('environment',['screenname']);
1.7 www 183: &Apache::lonnet::delenv('environment\.screenname');
1.6 www 184: $message='Reset screenname';
185: }
1.14 www 186: # Nickname
187: $message.='<br />';
1.17 matthew 188: $newscreen = $ENV{'form.nickname'};
1.14 www 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:
1.6 www 200: $r->print(<<ENDVCSCREEN);
201: </p>
202: $message
203: ENDVCSCREEN
1.20 www 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'};
1.26 www 214: my %userenv = &Apache::lonnet::get('environment',['msgforward','notification','critnotification']);
1.20 www 215: my $msgforward=$userenv{'msgforward'};
216: my $notification=$userenv{'notification'};
217: my $critnotification=$userenv{'critnotification'};
1.25 bowersj2 218: my $forwardingHelp = Apache::loncommon::help_open_topic("Prefs_Forwarding",
219: "What are forwarding ".
220: "and notification ".
221: "addresses");
1.27 bowersj2 222: my $criticalMessageHelp = Apache::loncommon::help_open_topic("Course_Critical_Message",
223: "What are critical messages");
224:
1.20 www 225: $r->print(<<ENDMSG);
1.25 bowersj2 226: $forwardingHelp <br />
1.20 www 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>):
1.27 bowersj2 234: <input type="text" size="40" value="$critnotification" name="critnotification" />$criticalMessageHelp<hr />
1.20 www 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
1.6 www 294: }
295:
1.12 www 296: ################################################################
1.19 www 297: # Colors #
1.12 www 298: ################################################################
299:
1.19 www 300: sub colorschanger {
1.12 www 301: my $r = shift;
1.19 www 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='';
1.22 matthew 323: foreach my $item (sort(keys(%colortypes))) {
1.19 www 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.
1.21 www 327: '" size="10" value="'.$curcol.
328: '" /></td><td><a href="javascript:pjump('."'color_custom','".$colortypes{$item}.
1.19 www 329: "','".$curcol."','"
1.21 www 330: .$item."','parmform.pres','psub'".');">Select</a></td></tr>';
1.19 www 331: }
1.23 matthew 332: my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.19 www 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:
1.23 matthew 342: $pjump_def
1.19 www 343:
344: function psub() {
345: pclose();
346: if (document.parmform.pres_marker.value!='') {
1.21 www 347: if (document.parmform.pres_type.value!='') {
348: eval('document.server.'+
349: document.parmform.pres_marker.value+
1.19 www 350: '.value=document.parmform.pres_value.value;');
1.21 www 351: }
1.19 www 352: } else {
353: document.parmform.pres_value.value='';
354: document.parmform.pres_marker.value='';
355: }
356: }
357:
358:
359: </script>
1.21 www 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>
1.12 www 365: <form name="server" action="/adm/preferences" method="post">
1.19 www 366: <input type="hidden" name="action" value="verify_and_change_colors" />
367: <table border="2">
368: $chtable
369: </table>
1.21 www 370: <input type="submit" value="Change Custom Colors" />
371: <input type="submit" name="resetall" value="Reset All Colors to Default" />
1.12 www 372: </form>
1.19 www 373: ENDCOL
1.12 www 374: }
375:
1.19 www 376: sub verify_and_change_colors {
1.12 www 377: my $r = shift;
1.19 www 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:
1.12 www 399: my $message='';
1.21 www 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: }
1.19 www 413: $r->print(<<ENDVCCOL);
1.12 www 414: </p>
415: $message
1.21 www 416: <form name="client" action="/adm/preferences" method="post">
417: <input type="hidden" name="action" value="changecolors" />
418: </form>
1.19 www 419: ENDVCCOL
1.12 www 420: }
421:
1.4 matthew 422: ######################################################
423: # password handler subroutines #
424: ######################################################
1.3 matthew 425: sub passwordchanger {
1.4 matthew 426: # This function is a bit of a mess....
1.3 matthew 427: # Passwords are encrypted using londes.js (DES encryption)
428: my $r = shift;
1.4 matthew 429: my $errormessage = shift;
430: $errormessage = ($errormessage || '');
1.3 matthew 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();
1.4 matthew 442: # Store the keys in the log files
1.3 matthew 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);
1.4 matthew 449: # Hexify the keys for output as javascript variables
1.3 matthew 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
1.4 matthew 457: # Output DES javascript
1.9 matthew 458: $r->print("<html><head>");
1.3 matthew 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>
1.4 matthew 491: $errormessage
1.10 www 492:
1.3 matthew 493: <p>
1.36 www 494: <!-- We separate the forms into 'server' and 'client' in order to
1.3 matthew 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="" />
1.4 matthew 502: <input type="hidden" name="newpass_1" value="" />
503: <input type="hidden" name="newpass_2" value="" />
1.3 matthew 504: </form>
505:
506: <form name="client" >
507: <table>
1.4 matthew 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>
1.3 matthew 514: <tr><td colspan="2" align="center">
515: <input type="button" value="Change Password" onClick="send();">
516: </table>
1.4 matthew 517: <input type="hidden" name="ukey_cpass" value="$ukey_cpass" />
518: <input type="hidden" name="lkey_cpass" value="$lkey_cpass" />
1.3 matthew 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);
1.4 matthew 536: # Check for authentication types that allow changing of the password.
537: return if ($currentauth !~ /^(unix|internal):/);
1.3 matthew 538: #
1.4 matthew 539: $r->print(<<ENDHEADER);
540: <html>
541: <head>
542: <title>LON-CAPA Preferences: Change password for $user</title>
543: </head>
544: ENDHEADER
1.3 matthew 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
1.4 matthew 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>");
1.3 matthew 556: return;
557: }
1.16 albertel 558: # Get the keys
559: my $lonhost = $r->dir_config('lonHostID');
1.3 matthew 560: my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
561: if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
1.4 matthew 562: # I do not a have a better idea about how to handle this
1.3 matthew 563: $r->print(<<ENDERROR);
564: <p>
565: <font color="#ff0000">ERROR:</font> Unable to retrieve stored token for
1.4 matthew 566: password decryption. Please log out and try again.
1.3 matthew 567: </p>
568: ENDERROR
1.4 matthew 569: # Probably should log an error here
1.3 matthew 570: return;
571: }
572: my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
1.4 matthew 573: #
1.17 matthew 574: $currentpass = &des_decrypt($ckey ,$currentpass);
575: $newpass1 = &des_decrypt($n1key,$newpass1);
576: $newpass2 = &des_decrypt($n2key,$newpass2);
1.4 matthew 577: #
1.3 matthew 578: if ($newpass1 ne $newpass2) {
1.4 matthew 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.');
1.3 matthew 590: return;
591: }
1.4 matthew 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");
1.9 matthew 617: <h2>The password for $user was successfully changed</h2>
1.4 matthew 618: ENDTEXT
619: } else {
620: # error error: run in circles, scream and shout
621: $r->print(<<ENDERROR);
1.9 matthew 622: <h2><font color="#ff0000">The password for $user was not changed</font></h2>
1.8 matthew 623: Please make sure your old password was entered correctly.
1.4 matthew 624: ENDERROR
625: }
626: return;
1.3 matthew 627: }
628:
1.42 raeburn 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
1.43 ! raeburn 637: ('environment',['discdisplay','discmarkread']);
! 638: my $discdisp = 'allposts';
! 639: my $discmark = 'onmark';
! 640:
! 641: if (defined($userenv{'discdisplay'})) {
! 642: unless ($userenv{'discdisplay'} eq '') {
! 643: $discdisp = $userenv{'discdisplay'};
! 644: }
! 645: }
! 646: if (defined($userenv{'discmarkread'})) {
! 647: unless ($userenv{'discdisplay'} eq '') {
! 648: $discmark = $userenv{'discmarkread'};
! 649: }
! 650: }
! 651:
! 652: my $newdisp = 'unread';
! 653: my $newmark = 'ondisp';
! 654:
! 655: my $function = &Apache::loncommon::get_users_function();
! 656: my $color = &Apache::loncommon::designparm($function.'.tabbg',
! 657: $ENV{'user.domain'});
! 658: my %lt = &Apache::lonlocal::texthash(
! 659: 'pref' => 'Display Preference',
! 660: 'curr' => 'Current setting ',
! 661: 'actn' => 'Action',
! 662: 'sdpf' => 'Set display preferences for discussion posts for both bulletin boards and individual resources in all your courses.',
! 663: 'prca' => 'Preferences can be set that determine',
! 664: 'whpo' => 'Which posts are displayed when you display a bulletin board or resource, and',
! 665: 'unwh' => 'Under what circumstances posts are identfied as "New"',
! 666: 'allposts' => 'All posts',
! 667: 'unread' => 'New posts only',
! 668: 'ondisp' => 'Once displayed',
! 669: 'onmark' => 'Once marked as read',
! 670: 'disa' => 'Posts displayed?',
! 671: 'npmr' => 'New posts cease to be identified as "New"?',
! 672: 'thde' => 'The preferences you set here can be overridden within each individual discussion.',
! 673: 'chgt' => 'Change to '
! 674: );
! 675: my $dispchange = $lt{'unread'};
! 676: my $markchange = $lt{'ondisp'};
! 677: my $currdisp = $lt{'allposts'};
! 678: my $currmark = $lt{'onmark'};
! 679:
! 680: if ($discdisp eq 'unread') {
! 681: $dispchange = $lt{'allposts'};
! 682: $currdisp = $lt{'unread'};
! 683: $newdisp = 'allposts';
! 684: }
! 685:
! 686: if ($discmark eq 'ondisp') {
! 687: $markchange = $lt{'onmark'};
! 688: $currmark = $lt{'ondisp'};
! 689: $newmark = 'onmark';
1.42 raeburn 690: }
1.43 ! raeburn 691:
! 692: $r->print(<<"END");
1.42 raeburn 693: <form name="server" action="/adm/preferences" method="post">
694: <input type="hidden" name="action" value="verify_and_change_discussion" />
695: <br />
1.43 ! raeburn 696: $lt{'sdpf'}<br/> $lt{'prca'} <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol>
! 697: <br />
! 698: <br />
! 699: <table border="0" cellpadding="0" cellspacing="0">
! 700: <tr>
! 701: <td width="100%" bgcolor="#000000">
! 702: <table width="100%" border="0" cellpadding="1" cellspacing="0">
! 703: <tr>
! 704: <td width="100%" bgcolor="#000000">
! 705: <table border="0" cellpadding="3" cellspacing="3" bgcolor="#FFFFFF">
! 706: <tr bgcolor="$color">
! 707: <td><b>$lt{'pref'}</b></td>
! 708: <td><b>$lt{'curr'}</b></td>
! 709: <td><b>$lt{'actn'}?</b></td>
! 710: </tr>
! 711: <tr bgcolor="#dddddd">
! 712: <td>$lt{'disa'}</td>
! 713: <td>$lt{$discdisp}</td>
! 714: <td><input type="checkbox" name="discdisp" /><input type="hidden" name="newdisp" value="$newdisp" /> $lt{'chgt'} "$dispchange"</td>
! 715: </tr><tr bgcolor="#eeeeee">
! 716: <td>$lt{'npmr'}</td>
! 717: <td>$lt{$discmark}</td>
! 718: <td><input type="checkbox" name="discmark" /><input type="hidden" name="newmark" value="$newmark" /> $lt{'chgt'} "$markchange"</td>
! 719: </tr>
! 720: </table>
! 721: </td>
! 722: </tr>
! 723: </table>
! 724: </td>
! 725: </tr>
! 726: </table>
! 727: <br />
! 728: <br />
! 729: <input type="submit" name="sub" value="Store Changes" />
! 730: <br />
! 731: <br />
! 732: Note: $lt{'thde'}
! 733: </form>
! 734: END
1.42 raeburn 735: }
736:
737: sub verify_and_change_discussion {
738: my $r = shift;
1.43 ! raeburn 739: my $user = $ENV{'user.name'};
! 740: my $domain = $ENV{'user.domain'};
1.42 raeburn 741: my $message='';
1.43 ! raeburn 742: if (defined($ENV{'form.discdisp'}) ) {
! 743: my $newdisp = $ENV{'form.newdisp'};
! 744: if ($newdisp eq 'unread') {
! 745: $message .='In discussions: only new posts will be displayed.<br/>';
! 746: &Apache::lonnet::put('environment',{'discdisplay' => $newdisp});
! 747: &Apache::lonnet::appenv('environment.discdisplay' => $newdisp);
! 748: } else {
! 749: $message .= 'In discussions: all posts will be displayed.<br/>';
! 750: &Apache::lonnet::del('environment',['discdisplay']);
! 751: &Apache::lonnet::delenv('environment\.discdisplay');
! 752: }
! 753: }
! 754: if (defined($ENV{'form.discmark'}) ) {
! 755: my $newmark = $ENV{'form.newmark'};
! 756: if ($newmark eq 'ondisp') {
! 757: $message.='In discussions: new posts will be cease to be identified as "new" after display.<br/>';
! 758: &Apache::lonnet::put('environment',{'discmarkread' => $newmark});
! 759: &Apache::lonnet::appenv('environment.discmarkread' => $newmark);
! 760: } else {
! 761: $message.='In discussions: posts will be identified as "new" until marked as read by the reader.<br/>';
! 762: &Apache::lonnet::del('environment',['discmarkread']);
! 763: &Apache::lonnet::delenv('environment\.discmarkread');
! 764: }
1.42 raeburn 765: }
766: $r->print(<<ENDVCSCREEN);
767: </p>
768: $message
769: ENDVCSCREEN
770: }
771:
1.4 matthew 772: ######################################################
773: # other handler subroutines #
774: ######################################################
775:
1.3 matthew 776: ################################################################
777: # Main handler #
778: ################################################################
1.1 www 779: sub handler {
780: my $r = shift;
1.3 matthew 781: my $user = $ENV{'user.name'};
782: my $domain = $ENV{'user.domain'};
1.31 www 783: &Apache::loncommon::content_type($r,'text/html');
1.4 matthew 784: # Some pages contain DES keys and should not be cached.
785: &Apache::loncommon::no_cache($r);
1.1 www 786: $r->send_http_header;
787: return OK if $r->header_only;
1.9 matthew 788: #
1.35 matthew 789: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
790: ['action']);
791: #
792: &Apache::lonhtmlcommon::clear_breadcrumbs();
793: &Apache::lonhtmlcommon::add_breadcrumb
794: ({href => '/adm/preferences',
795: text => 'Set User Preferences'});
796:
797: my @Options;
798: # Determine current authentication method
799: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
800: if ($currentauth =~ /^(unix|internal):/) {
801: push (@Options,({ action => 'changepass',
1.40 www 802: linktext => 'Change Password',
1.35 matthew 803: href => '/adm/preferences',
804: help => 'Change_Password',
805: subroutine => \&passwordchanger,
806: breadcrumb =>
807: { href => '/adm/preferences?action=changepass',
808: text => 'Change Password'},
809: },
810: { action => 'verify_and_change_pass',
811: subroutine => \&verify_and_change_password,
812: breadcrumb =>
813: { href =>'/adm/preferences?action=changepass',
814: text => 'Change Password'},
815: printmenu => 'yes',
816: }));
817: }
818: push (@Options,({ action => 'changescreenname',
819: linktext => 'Change Screen Name',
820: href => '/adm/preferences',
821: help => 'Prefs_Screen_Name_Nickname',
822: subroutine => \&screennamechanger,
823: breadcrumb =>
824: { href => '/adm/preferences?action=changescreenname',
825: text => 'Change Screen Name'},
826: },
827: { action => 'verify_and_change_screenname',
828: subroutine => \&verify_and_change_screenname,
829: breadcrumb =>
830: { href => '/adm/preferences?action=changescreenname',
831: text => 'Change Screen Name'},
832: printmenu => 'yes',
833: }));
834:
835: push (@Options,({ action => 'changemsgforward',
836: linktext => 'Change Message Forwarding',
837: text => 'and Notification Addresses',
838: href => '/adm/preferences',
839: help => 'Prefs_Forwarding',
840: breadcrumb =>
841: { href => '/adm/preferences?action=changemsgforward',
842: text => 'Change Message Forwarding'},
843: subroutine => \&msgforwardchanger,
844: },
845: { action => 'verify_and_change_msgforward',
846: breadcrumb =>
847: { href => '/adm/preferences?action=changemsgforward',
848: text => 'Change Message Forwarding'},
849: printmenu => 'yes',
850: subroutine => \&verify_and_change_msgforward }));
851: my $aboutmeaction=
852: '/adm/'.$ENV{'user.domain'}.'/'.$ENV{'user.name'}.'/aboutme';
853: push (@Options,{ action => 'none',
854: linktext =>
1.41 www 855: q{Edit the 'About Me' Personal Information Screen},
1.35 matthew 856: href => $aboutmeaction});
857: push (@Options,({ action => 'changecolors',
858: linktext => 'Change Color Scheme',
859: href => '/adm/preferences',
860: help => 'Change_Colors',
861: breadcrumb =>
862: { href => '/adm/preferences?action=changecolors',
863: text => 'Change Colors'},
864: subroutine => \&colorschanger,
865: },
866: { action => 'verify_and_change_colors',
867: breadcrumb =>
868: { href => '/adm/preferences?action=changecolors',
869: text => 'Change Colors'},
870: printmenu => 'yes',
871: subroutine => \&verify_and_change_colors,
872: }));
873: push (@Options,({ action => 'changelanguages',
1.39 www 874: linktext => 'Change Language Preferences',
1.35 matthew 875: href => '/adm/preferences',
876: breadcrumb=>
877: { href => '/adm/preferences?action=changelanguages',
878: text => 'Change Language'},
879: subroutine => \&languagechanger,
880: },
881: { action => 'verify_and_change_languages',
882: breadcrumb=>
883: {href => '/adm/preferences?action=changelanguages',
884: text => 'Change Language'},
885: printmenu => 'yes',
886: subroutine=>\&verify_and_change_languages, }
887: ));
1.42 raeburn 888: push (@Options,({ action => 'changediscussions',
889: linktext => 'Change Discussion Display Preferences',
890: href => '/adm/preferences',
891: breadcrumb =>
892: { href => '/adm/preferences?action=changediscussions',
1.43 ! raeburn 893: text => 'Change Discussion Preferences'},
1.42 raeburn 894: subroutine => \&discussionchanger,
895: },
896: { action => 'verify_and_change_discussion',
897: breadcrumb =>
898: { href => '/adm/preferences?action=changediscussions',
1.43 ! raeburn 899: text => 'Change Discussion Preferences'},
1.42 raeburn 900: printmenu => 'yes',
901: subroutine => \&verify_and_change_discussion, }
902: ));
903:
1.35 matthew 904: if ($ENV{'user.name'} =~ /^(albertel|koretemey|korte|hallmat3|turtle)$/) {
905: push (@Options,({ action => 'debugtoggle',
906: printmenu => 'yes',
907: subroutine => \&toggle_debug,
908: }));
909: }
910: $r->print(<<ENDHEADER);
1.1 www 911: <html>
912: <head>
1.4 matthew 913: <title>LON-CAPA Preferences</title>
1.1 www 914: </head>
1.3 matthew 915: ENDHEADER
1.35 matthew 916: my $call = undef;
917: my $printmenu = 'yes';
918: foreach my $option (@Options) {
919: if ($option->{'action'} eq $ENV{'form.action'}) {
920: $call = $option->{'subroutine'};
921: $printmenu = $option->{'printmenu'};
922: if (exists($option->{'breadcrumb'})) {
923: &Apache::lonhtmlcommon::add_breadcrumb
924: ($option->{'breadcrumb'});
925: }
926: }
927: }
928: $r->print(&Apache::loncommon::bodytag('Change Preferences'));
929: $r->print(&Apache::lonhtmlcommon::breadcrumbs
930: (undef,'Change Preferences'));
931: if (defined($call)) {
932: $call->($r);
933: }
934: if ($printmenu eq 'yes') {
935: my $optionlist = '<table cellpadding="5">';
936: if ($ENV{'user.name'} =~
1.37 www 937: /^(albertel|kortemey|korte|hallmat3|turtle)$/
1.35 matthew 938: ) {
939: push (@Options,({ action => 'debugtoggle',
940: linktext => 'Toggle Debug Messages',
941: text => 'Current Debug status is -'.
942: $ENV{'user.debug'}.'-.',
943: href => '/adm/preferences',
944: printmenu => 'yes',
945: subroutine => \&toggle_debug,
946: }));
947: }
948: foreach my $option(@Options) {
949: my $optiontext = '';
950: if (exists($option->{'href'})) {
951: $optiontext .=
952: '<a href="'.$option->{'href'}.
953: '?action='.$option->{'action'}.'">'.
954: $option->{'linktext'}.'</a>';
955: }
956: if (exists($option->{'text'})) {
957: $optiontext .= ' '.$option->{'text'};
958: }
959: if ($optiontext ne '') {
960: $optiontext = '<font size="+1">'.$optiontext.'</font>';
961: my $helplink = ' ';
962: if (exists($option->{'help'})) {
963: $helplink = &Apache::loncommon::help_open_topic
964: ($option->{'help'});
965: }
966: $optionlist .= '<tr>'.
967: '<td>'.$helplink.'</td>'.
968: '<td>'.$optiontext.'</td>'.
969: '</tr>';
970: }
1.13 www 971: }
1.35 matthew 972: $optionlist .= '</table>';
973: $r->print($optionlist);
1.3 matthew 974: }
975: $r->print(<<ENDFOOTER);
1.1 www 976: </body>
977: </html>
1.3 matthew 978: ENDFOOTER
1.1 www 979: return OK;
1.35 matthew 980: }
981:
982: sub toggle_debug {
983: if ($ENV{'user.debug'}) {
984: &Apache::lonnet::delenv('user\.debug');
985: } else {
986: &Apache::lonnet::appenv('user.debug' => 1);
987: }
1.13 www 988: }
1.1 www 989:
990: 1;
991: __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