File:  [LON-CAPA] / loncom / interface / lonpreferences.pm
Revision 1.32: download - view: text, annotated - select for diffs
Fri Nov 7 23:22:21 2003 UTC (20 years, 7 months ago) by www
Branches: MAIN
CVS tags: HEAD
Minoru had a better idea on how to show translators where material appears
on the screen.

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

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