Annotation of loncom/interface/lonpreferences.pm, revision 1.35
1.1 www 1: # The LearningOnline Network
2: # Preferences
3: #
1.35 ! matthew 4: # $Id: lonpreferences.pm,v 1.34 2004/01/14 15:51:07 www Exp $
1.2 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.1 www 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: #
1.3 matthew 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:
1.1 www 45: package Apache::lonpreferences;
46:
47: use strict;
48: use Apache::Constants qw(:common);
1.3 matthew 49: use Apache::File;
50: use Crypt::DES;
51: use DynaLoader; # for Crypt::DES version
1.4 matthew 52: use Apache::loncommon();
1.23 matthew 53: use Apache::lonhtmlcommon();
1.32 www 54: use Apache::lonlocal;
1.3 matthew 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 {
1.4 matthew 65: # Make a new key for DES encryption.
66: # Each key has two parts which are returned seperately.
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.
1.3 matthew 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))));
1.4 matthew 96: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
1.3 matthew 97: return $plaintext;
98: }
99:
1.4 matthew 100: ################################################################
101: # Handler subroutines #
102: ################################################################
1.9 matthew 103:
104: ################################################################
1.28 www 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
1.32 www 112: ('environment',['languages']);
1.29 www 113: my $language=$userenv{'languages'};
1.32 www 114:
1.33 www 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);
1.28 www 125: $r->print(<<ENDLSCREEN);
126: <form name="server" action="/adm/preferences" method="post">
127: <input type="hidden" name="action" value="verify_and_change_languages" />
1.33 www 128: <br />$pref: $selectionbox
1.28 www 129: ENDLSCREEN
1.35 ! matthew 130: $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
1.28 www 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) {
1.29 www 143: &Apache::lonnet::put('environment',{'languages' => $newlanguage});
144: &Apache::lonnet::appenv('environment.languages' => $newlanguage);
145: $message='Set new preferred languages to '.$newlanguage;
1.28 www 146: } else {
1.29 www 147: &Apache::lonnet::del('environment',['languages']);
148: &Apache::lonnet::delenv('environment\.languages');
1.28 www 149: $message='Reset preferred language';
150: }
151: $r->print(<<ENDVCSCREEN);
152: </p>
153: $message
154: ENDVCSCREEN
155: }
156:
157:
158: ################################################################
1.9 matthew 159: # Anonymous Discussion Name Change Subroutines #
160: ################################################################
1.5 www 161: sub screennamechanger {
162: my $r = shift;
163: my $user = $ENV{'user.name'};
164: my $domain = $ENV{'user.domain'};
1.14 www 165: my %userenv = &Apache::lonnet::get
166: ('environment',['screenname','nickname']);
1.6 www 167: my $screenname=$userenv{'screenname'};
1.14 www 168: my $nickname=$userenv{'nickname'};
1.5 www 169: $r->print(<<ENDSCREEN);
1.6 www 170: <form name="server" action="/adm/preferences" method="post">
171: <input type="hidden" name="action" value="verify_and_change_screenname" />
1.14 www 172: <br />New screenname (shown if you post anonymously):
1.6 www 173: <input type="text" size="20" value="$screenname" name="screenname" />
1.14 www 174: <br />New nickname (shown if you post non-anonymously):
175: <input type="text" size="20" value="$nickname" name="nickname" />
1.6 www 176: <input type="submit" value="Change" />
177: </form>
1.5 www 178: ENDSCREEN
179: }
1.6 www 180:
181: sub verify_and_change_screenname {
182: my $r = shift;
183: my $user = $ENV{'user.name'};
184: my $domain = $ENV{'user.domain'};
1.14 www 185: # Screenname
1.6 www 186: my $newscreen = $ENV{'form.screenname'};
1.14 www 187: $newscreen=~s/[^ \w]//g;
1.6 www 188: my $message='';
189: if ($newscreen) {
1.7 www 190: &Apache::lonnet::put('environment',{'screenname' => $newscreen});
191: &Apache::lonnet::appenv('environment.screenname' => $newscreen);
1.6 www 192: $message='Set new screenname to '.$newscreen;
193: } else {
194: &Apache::lonnet::del('environment',['screenname']);
1.7 www 195: &Apache::lonnet::delenv('environment\.screenname');
1.6 www 196: $message='Reset screenname';
197: }
1.14 www 198: # Nickname
199: $message.='<br />';
1.17 matthew 200: $newscreen = $ENV{'form.nickname'};
1.14 www 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:
1.6 www 212: $r->print(<<ENDVCSCREEN);
213: </p>
214: $message
215: ENDVCSCREEN
1.20 www 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'};
1.26 www 226: my %userenv = &Apache::lonnet::get('environment',['msgforward','notification','critnotification']);
1.20 www 227: my $msgforward=$userenv{'msgforward'};
228: my $notification=$userenv{'notification'};
229: my $critnotification=$userenv{'critnotification'};
1.25 bowersj2 230: my $forwardingHelp = Apache::loncommon::help_open_topic("Prefs_Forwarding",
231: "What are forwarding ".
232: "and notification ".
233: "addresses");
1.27 bowersj2 234: my $criticalMessageHelp = Apache::loncommon::help_open_topic("Course_Critical_Message",
235: "What are critical messages");
236:
1.20 www 237: $r->print(<<ENDMSG);
1.25 bowersj2 238: $forwardingHelp <br />
1.20 www 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>):
1.27 bowersj2 246: <input type="text" size="40" value="$critnotification" name="critnotification" />$criticalMessageHelp<hr />
1.20 www 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
1.6 www 306: }
307:
1.12 www 308: ################################################################
1.19 www 309: # Colors #
1.12 www 310: ################################################################
311:
1.19 www 312: sub colorschanger {
1.12 www 313: my $r = shift;
1.19 www 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='';
1.22 matthew 335: foreach my $item (sort(keys(%colortypes))) {
1.19 www 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.
1.21 www 339: '" size="10" value="'.$curcol.
340: '" /></td><td><a href="javascript:pjump('."'color_custom','".$colortypes{$item}.
1.19 www 341: "','".$curcol."','"
1.21 www 342: .$item."','parmform.pres','psub'".');">Select</a></td></tr>';
1.19 www 343: }
1.23 matthew 344: my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.19 www 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:
1.23 matthew 354: $pjump_def
1.19 www 355:
356: function psub() {
357: pclose();
358: if (document.parmform.pres_marker.value!='') {
1.21 www 359: if (document.parmform.pres_type.value!='') {
360: eval('document.server.'+
361: document.parmform.pres_marker.value+
1.19 www 362: '.value=document.parmform.pres_value.value;');
1.21 www 363: }
1.19 www 364: } else {
365: document.parmform.pres_value.value='';
366: document.parmform.pres_marker.value='';
367: }
368: }
369:
370:
371: </script>
1.21 www 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>
1.12 www 377: <form name="server" action="/adm/preferences" method="post">
1.19 www 378: <input type="hidden" name="action" value="verify_and_change_colors" />
379: <table border="2">
380: $chtable
381: </table>
1.21 www 382: <input type="submit" value="Change Custom Colors" />
383: <input type="submit" name="resetall" value="Reset All Colors to Default" />
1.12 www 384: </form>
1.19 www 385: ENDCOL
1.12 www 386: }
387:
1.19 www 388: sub verify_and_change_colors {
1.12 www 389: my $r = shift;
1.19 www 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:
1.12 www 411: my $message='';
1.21 www 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: }
1.19 www 425: $r->print(<<ENDVCCOL);
1.12 www 426: </p>
427: $message
1.21 www 428: <form name="client" action="/adm/preferences" method="post">
429: <input type="hidden" name="action" value="changecolors" />
430: </form>
1.19 www 431: ENDVCCOL
1.12 www 432: }
433:
1.4 matthew 434: ######################################################
435: # password handler subroutines #
436: ######################################################
1.3 matthew 437: sub passwordchanger {
1.4 matthew 438: # This function is a bit of a mess....
1.3 matthew 439: # Passwords are encrypted using londes.js (DES encryption)
440: my $r = shift;
1.4 matthew 441: my $errormessage = shift;
442: $errormessage = ($errormessage || '');
1.3 matthew 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();
1.4 matthew 454: # Store the keys in the log files
1.3 matthew 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);
1.4 matthew 461: # Hexify the keys for output as javascript variables
1.3 matthew 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
1.4 matthew 469: # Output DES javascript
1.9 matthew 470: $r->print("<html><head>");
1.3 matthew 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>
1.4 matthew 503: $errormessage
1.10 www 504:
1.3 matthew 505: <p>
506: <!-- We seperate 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="" />
1.4 matthew 514: <input type="hidden" name="newpass_1" value="" />
515: <input type="hidden" name="newpass_2" value="" />
1.3 matthew 516: </form>
517:
518: <form name="client" >
519: <table>
1.4 matthew 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>
1.3 matthew 526: <tr><td colspan="2" align="center">
527: <input type="button" value="Change Password" onClick="send();">
528: </table>
1.4 matthew 529: <input type="hidden" name="ukey_cpass" value="$ukey_cpass" />
530: <input type="hidden" name="lkey_cpass" value="$lkey_cpass" />
1.3 matthew 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);
1.4 matthew 548: # Check for authentication types that allow changing of the password.
549: return if ($currentauth !~ /^(unix|internal):/);
1.3 matthew 550: #
1.4 matthew 551: $r->print(<<ENDHEADER);
552: <html>
553: <head>
554: <title>LON-CAPA Preferences: Change password for $user</title>
555: </head>
556: ENDHEADER
1.3 matthew 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
1.4 matthew 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>");
1.3 matthew 568: return;
569: }
1.16 albertel 570: # Get the keys
571: my $lonhost = $r->dir_config('lonHostID');
1.3 matthew 572: my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
573: if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
1.4 matthew 574: # I do not a have a better idea about how to handle this
1.3 matthew 575: $r->print(<<ENDERROR);
576: <p>
577: <font color="#ff0000">ERROR:</font> Unable to retrieve stored token for
1.4 matthew 578: password decryption. Please log out and try again.
1.3 matthew 579: </p>
580: ENDERROR
1.4 matthew 581: # Probably should log an error here
1.3 matthew 582: return;
583: }
584: my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
1.4 matthew 585: #
1.17 matthew 586: $currentpass = &des_decrypt($ckey ,$currentpass);
587: $newpass1 = &des_decrypt($n1key,$newpass1);
588: $newpass2 = &des_decrypt($n2key,$newpass2);
1.4 matthew 589: #
1.3 matthew 590: if ($newpass1 ne $newpass2) {
1.4 matthew 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.');
1.3 matthew 602: return;
603: }
1.4 matthew 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");
1.9 matthew 629: <h2>The password for $user was successfully changed</h2>
1.4 matthew 630: ENDTEXT
631: } else {
632: # error error: run in circles, scream and shout
633: $r->print(<<ENDERROR);
1.9 matthew 634: <h2><font color="#ff0000">The password for $user was not changed</font></h2>
1.8 matthew 635: Please make sure your old password was entered correctly.
1.4 matthew 636: ENDERROR
637: }
638: return;
1.3 matthew 639: }
640:
1.4 matthew 641: ######################################################
642: # other handler subroutines #
643: ######################################################
644:
1.3 matthew 645: ################################################################
646: # Main handler #
647: ################################################################
1.1 www 648: sub handler {
649: my $r = shift;
1.3 matthew 650: my $user = $ENV{'user.name'};
651: my $domain = $ENV{'user.domain'};
1.31 www 652: &Apache::loncommon::content_type($r,'text/html');
1.4 matthew 653: # Some pages contain DES keys and should not be cached.
654: &Apache::loncommon::no_cache($r);
1.1 www 655: $r->send_http_header;
656: return OK if $r->header_only;
1.9 matthew 657: #
1.35 ! matthew 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);
1.1 www 764: <html>
765: <head>
1.4 matthew 766: <title>LON-CAPA Preferences</title>
1.1 www 767: </head>
1.3 matthew 768: ENDHEADER
1.35 ! matthew 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: }
1.13 www 825: }
1.35 ! matthew 826: $optionlist .= '</table>';
! 827: $r->print($optionlist);
1.3 matthew 828: }
829: $r->print(<<ENDFOOTER);
1.1 www 830: </body>
831: </html>
1.3 matthew 832: ENDFOOTER
1.1 www 833: return OK;
1.35 ! matthew 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: }
1.13 www 842: }
1.1 www 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