Annotation of loncom/interface/lonpreferences.pm, revision 1.28

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>