File:  [LON-CAPA] / loncom / interface / lonpreferences.pm
Revision 1.22: download - view: text, annotated - select for diffs
Wed Apr 30 15:12:29 2003 UTC (21 years, 2 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Better to sort the color selection stuff so they appear in a consistent order.

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

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