File:  [LON-CAPA] / loncom / interface / lonpreferences.pm
Revision 1.29: download - view: text, annotated - select for diffs
Wed Sep 17 01:45:14 2003 UTC (20 years, 8 months ago) by www
Branches: MAIN
CVS tags: HEAD
Better German lexicon, work on translator interface.

    1: # The LearningOnline Network
    2: # Preferences
    3: #
    4: # $Id: lonpreferences.pm,v 1.29 2003/09/17 01:45:14 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: 
   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 {
   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.
   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))));
   95:     $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
   96:     return $plaintext;
   97: }
   98: 
   99: ################################################################
  100: #                       Handler subroutines                    #
  101: ################################################################
  102: 
  103: ################################################################
  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',['languages','translator']);
  112:     my $language=$userenv{'languages'};
  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',{'languages' => $newlanguage});
  145:         &Apache::lonnet::appenv('environment.languages' => $newlanguage);
  146:         $message='Set new preferred languages to '.$newlanguage;
  147:     } else {
  148:         &Apache::lonnet::del('environment',['languages']);
  149:         &Apache::lonnet::delenv('environment\.languages');
  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: ################################################################
  180: #         Anonymous Discussion Name Change Subroutines         #
  181: ################################################################
  182: sub screennamechanger {
  183:     my $r = shift;
  184:     my $user       = $ENV{'user.name'};
  185:     my $domain     = $ENV{'user.domain'};
  186:     my %userenv = &Apache::lonnet::get
  187:         ('environment',['screenname','nickname']);
  188:     my $screenname=$userenv{'screenname'};
  189:     my $nickname=$userenv{'nickname'};
  190:     my $bodytag=&Apache::loncommon::bodytag(
  191:               'Change Your Nickname and Anonymous Screen Name');
  192:     $r->print(<<ENDSCREEN);
  193: <html>
  194: $bodytag
  195: 
  196: <form name="server" action="/adm/preferences" method="post">
  197: <input type="hidden" name="action" value="verify_and_change_screenname" />
  198: <br />New screenname (shown if you post anonymously):
  199: <input type="text" size="20" value="$screenname" name="screenname" />
  200: <br />New nickname (shown if you post non-anonymously):
  201: <input type="text" size="20" value="$nickname" name="nickname" />
  202: <input type="submit" value="Change" />
  203: </form>
  204: </body>
  205: </html>
  206: ENDSCREEN
  207: }
  208: 
  209: sub verify_and_change_screenname {
  210:     my $r = shift;
  211:     my $user       = $ENV{'user.name'};
  212:     my $domain     = $ENV{'user.domain'};
  213: # Screenname
  214:     my $newscreen  = $ENV{'form.screenname'};
  215:     $newscreen=~s/[^ \w]//g;
  216:     my $message='';
  217:     if ($newscreen) {
  218:         &Apache::lonnet::put('environment',{'screenname' => $newscreen});
  219:         &Apache::lonnet::appenv('environment.screenname' => $newscreen);
  220:         $message='Set new screenname to '.$newscreen;
  221:     } else {
  222:         &Apache::lonnet::del('environment',['screenname']);
  223:         &Apache::lonnet::delenv('environment\.screenname');
  224:         $message='Reset screenname';
  225:     }
  226: # Nickname
  227:     $message.='<br />';
  228:     $newscreen  = $ENV{'form.nickname'};
  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: 
  240:     my $bodytag=&Apache::loncommon::bodytag(
  241:                     'Change Your Nickname and Anonymous Screen Name');
  242:     $r->print(<<ENDVCSCREEN);
  243: <html>
  244: $bodytag
  245: </p>
  246: $message
  247: </body></html>
  248: ENDVCSCREEN
  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'};
  259:     my %userenv = &Apache::lonnet::get('environment',['msgforward','notification','critnotification']);
  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');
  265:     my $forwardingHelp = Apache::loncommon::help_open_topic("Prefs_Forwarding",
  266: 							    "What are forwarding ".
  267: 							    "and notification ".
  268: 							    "addresses");
  269:     my $criticalMessageHelp = Apache::loncommon::help_open_topic("Course_Critical_Message",
  270: 								 "What are critical messages");
  271: 
  272:     $r->print(<<ENDMSG);
  273: <html>
  274: $bodytag
  275: $forwardingHelp <br />
  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>):
  283: <input type="text" size="40" value="$critnotification" name="critnotification" />$criticalMessageHelp<hr />
  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
  350: }
  351: 
  352: ################################################################
  353: #         Colors                                               #
  354: ################################################################
  355: 
  356: sub colorschanger {
  357:     my $r = shift;
  358:     my $bodytag=&Apache::loncommon::bodytag(
  359:                     'Change Color Scheme for Current Role Type','',
  360:                     'onUnload="pclose();"');
  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='';
  382:     foreach my $item (sort(keys(%colortypes))) {
  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.
  386:         '" size="10" value="'.$curcol.
  387: '" /></td><td><a href="javascript:pjump('."'color_custom','".$colortypes{$item}.
  388: "','".$curcol."','"
  389: 	    .$item."','parmform.pres','psub'".');">Select</a></td></tr>';
  390:     }
  391:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
  392:     $r->print(<<ENDCOL);
  393: <html>
  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: 
  402:     $pjump_def
  403: 
  404:     function psub() {
  405:         pclose();
  406:         if (document.parmform.pres_marker.value!='') {
  407:             if (document.parmform.pres_type.value!='') {
  408:                 eval('document.server.'+
  409:                      document.parmform.pres_marker.value+
  410: 		     '.value=document.parmform.pres_value.value;');
  411: 	    }
  412:         } else {
  413:             document.parmform.pres_value.value='';
  414:             document.parmform.pres_marker.value='';
  415:         }
  416:     }
  417: 
  418: 
  419: </script>
  420: $bodytag
  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>
  426: <form name="server" action="/adm/preferences" method="post">
  427: <input type="hidden" name="action" value="verify_and_change_colors" />
  428: <table border="2">
  429: $chtable
  430: </table>
  431: <input type="submit" value="Change Custom Colors" />
  432: <input type="submit" name="resetall" value="Reset All Colors to Default" />
  433: </form>
  434: </body>
  435: </html>
  436: ENDCOL
  437: }
  438: 
  439: sub verify_and_change_colors {
  440:     my $r = shift;
  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: 
  462:     my $message='';
  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:     }
  476:     my $bodytag=&Apache::loncommon::bodytag(
  477:                            'Change Color Scheme for Current Role Type');
  478:     $r->print(<<ENDVCCOL);
  479: <html>
  480: $bodytag
  481: </p>
  482: $message
  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>
  487: </body></html>
  488: ENDVCCOL
  489: }
  490: 
  491: ######################################################
  492: #            password handler subroutines            #
  493: ######################################################
  494: sub passwordchanger {
  495:     # This function is a bit of a mess....
  496:     # Passwords are encrypted using londes.js (DES encryption)
  497:     my $r = shift;
  498:     my $errormessage = shift;
  499:     $errormessage = ($errormessage || '');
  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();
  511:     # Store the keys in the log files
  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);
  518:     # Hexify the keys for output as javascript variables
  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
  526:     # Output DES javascript
  527:     $r->print("<html><head>");
  528:     {
  529: 	my $include = $r->dir_config('lonIncludes');
  530: 	my $jsh=Apache::File->new($include."/londes.js");
  531: 	$r->print(<$jsh>);
  532:     }
  533:     my $bodytag=&Apache::loncommon::bodytag('Change Password','',
  534:                                          'onLoad="init();"');
  535:     $r->print(<<ENDFORM);
  536: </head>
  537: $bodytag
  538: 
  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>
  565: $errormessage
  566: 
  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="" />
  576: <input type="hidden" name="newpass_1"   value="" />
  577: <input type="hidden" name="newpass_2"   value="" />
  578: </form>
  579: 
  580: <form name="client" >
  581: <table>
  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>
  588: <tr><td colspan="2" align="center">
  589:     <input type="button" value="Change Password" onClick="send();">
  590: </table>
  591: <input type="hidden" name="ukey_cpass"  value="$ukey_cpass" />
  592: <input type="hidden" name="lkey_cpass"  value="$lkey_cpass" />
  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);
  610:     # Check for authentication types that allow changing of the password.
  611:     return if ($currentauth !~ /^(unix|internal):/);
  612:     #
  613:     $r->print(<<ENDHEADER);
  614: <html>
  615: <head>
  616: <title>LON-CAPA Preferences:  Change password for $user</title>
  617: </head>
  618: ENDHEADER
  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 
  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>");
  630: 	return;
  631:     }
  632:     # Get the keys
  633:     my $lonhost = $r->dir_config('lonHostID');
  634:     my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
  635:     if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
  636:         # I do not a have a better idea about how to handle this
  637: 	$r->print(<<ENDERROR);
  638: <p>
  639: <font color="#ff0000">ERROR:</font> Unable to retrieve stored token for
  640: password decryption.  Please log out and try again.
  641: </p>
  642: ENDERROR
  643:         # Probably should log an error here
  644:         return;
  645:     }
  646:     my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
  647:     # 
  648:     $currentpass = &des_decrypt($ckey ,$currentpass);
  649:     $newpass1    = &des_decrypt($n1key,$newpass1);
  650:     $newpass2    = &des_decrypt($n2key,$newpass2);
  651:     # 
  652:     if ($newpass1 ne $newpass2) {
  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.');
  664: 	return;
  665:     }
  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");
  691: <h2>The password for $user was successfully changed</h2>
  692: ENDTEXT
  693:     } else {
  694: 	# error error: run in circles, scream and shout
  695:         $r->print(<<ENDERROR);
  696: <h2><font color="#ff0000">The password for $user was not changed</font></h2>
  697: Please make sure your old password was entered correctly.
  698: ENDERROR
  699:     }
  700:     return;
  701: }
  702: 
  703: ######################################################
  704: #            other handler subroutines               #
  705: ######################################################
  706: 
  707: ################################################################
  708: #                          Main handler                        #
  709: ################################################################
  710: sub handler {
  711:     my $r = shift;
  712:     my $user = $ENV{'user.name'};
  713:     my $domain = $ENV{'user.domain'};
  714:     $r->content_type('text/html');
  715:     # Some pages contain DES keys and should not be cached.
  716:     &Apache::loncommon::no_cache($r);
  717:     $r->send_http_header;
  718:     return OK if $r->header_only;
  719:     #
  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);
  724:     } elsif ($ENV{'form.action'} eq 'changescreenname') {
  725:         &screennamechanger($r);
  726:     } elsif ($ENV{'form.action'} eq 'verify_and_change_screenname') {
  727:         &verify_and_change_screenname($r);
  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);
  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);
  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);
  740:     } elsif ($ENV{'form.action'} eq 'debugtoggle') {
  741: 	if (($ENV{'user.name'} eq 'albertel' ) ||
  742:             ($ENV{'user.name'} eq 'kortemey' ) ||
  743:             ($ENV{'user.name'} eq 'korte')) {
  744: 	    if ($ENV{'user.debug'}) {
  745: 		&Apache::lonnet::delenv('user\.debug');
  746: 	    } else {
  747: 		&Apache::lonnet::appenv('user.debug' => 1);
  748: 	    }
  749: 	}
  750:     } else {
  751: 	$r->print(<<ENDHEADER);
  752: <html>
  753: <head>
  754: <title>LON-CAPA Preferences</title>
  755: </head>
  756: ENDHEADER
  757:         $r->print(&Apache::loncommon::bodytag('Change Your Preferences'));
  758: 	# Determine current authentication method
  759: 	my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
  760: 	if ($currentauth =~ /^(unix|internal):/) {
  761: 	    $r->print(<<ENDPASSWORDFORM);
  762: <form name="client" action="/adm/preferences" method="post">
  763: <input type="hidden" name="action" value="changepass" />
  764: <input type="submit" value="Change password" />
  765: </form>
  766: ENDPASSWORDFORM
  767:         }
  768: # Change screen name
  769: 	    $r->print(<<ENDSCREENNAMEFORM);
  770: <form name="client" action="/adm/preferences" method="post">
  771: <input type="hidden" name="action" value="changescreenname" />
  772: <input type="submit" 
  773: value="Change nickname and anonymous discussion screen name" />
  774: </form>
  775: ENDSCREENNAMEFORM
  776: 	    $r->print(<<ENDMSGFORWARDFORM);
  777: <form name="client" action="/adm/preferences" method="post">
  778: <input type="hidden" name="action" value="changemsgforward" />
  779: <input type="submit" value="Change message forwarding and notification addresses" />
  780: </form>
  781: ENDMSGFORWARDFORM
  782: # The "about me" page
  783: 	my $aboutmeaction=
  784: 	    '/adm/'.$ENV{'user.domain'}.'/'.$ENV{'user.name'}.'/aboutme';
  785: 	$r->print(<<ENDABOUTME);
  786: <form name="client" action="$aboutmeaction" method="post">
  787: <input type="hidden" name="action" value="changescreenname" />
  788: <input type="submit" value="Edit the 'About Me' personal information screen" />
  789: </form>
  790: ENDABOUTME
  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
  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
  804: 
  805: 	if (($ENV{'user.name'} eq 'albertel' ) ||
  806:             ($ENV{'user.name'} eq 'kortemey' ) ||
  807:             ($ENV{'user.name'} eq 'korte')) {
  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
  817:     }
  818:     $r->print(<<ENDFOOTER);
  819: </body>
  820: </html>
  821: ENDFOOTER
  822:     return OK;
  823: }
  824: 
  825: 1;
  826: __END__

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