File:  [LON-CAPA] / loncom / interface / lonpreferences.pm
Revision 1.12: download - view: text, annotated - select for diffs
Sat Sep 7 03:44:14 2002 UTC (21 years, 9 months ago) by www
Branches: MAIN
CVS tags: HEAD
Towards bug 707 - can set mail forwarding address now

    1: # The LearningOnline Network
    2: # Preferences
    3: #
    4: # $Id: lonpreferences.pm,v 1.12 2002/09/07 03:44: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: 
   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('environment',['screenname']);
  110:     my $screenname=$userenv{'screenname'};
  111:     my $bodytag=&Apache::loncommon::bodytag(
  112:                                          'Change Your Anonymous Screen Name');
  113:     $r->print(<<ENDSCREEN);
  114: <html>
  115: $bodytag
  116: 
  117: <form name="server" action="/adm/preferences" method="post">
  118: <input type="hidden" name="action" value="verify_and_change_screenname" />
  119: New screenname:
  120: <input type="text" size="20" value="$screenname" name="screenname" />
  121: <input type="submit" value="Change" />
  122: </form>
  123: </body>
  124: </html>
  125: ENDSCREEN
  126: }
  127: 
  128: sub verify_and_change_screenname {
  129:     my $r = shift;
  130:     my $user       = $ENV{'user.name'};
  131:     my $domain     = $ENV{'user.domain'};
  132:     my $newscreen  = $ENV{'form.screenname'};
  133:     $newscreen=~s/\W//g;
  134:     my $message='';
  135:     if ($newscreen) {
  136:         &Apache::lonnet::put('environment',{'screenname' => $newscreen});
  137:         &Apache::lonnet::appenv('environment.screenname' => $newscreen);
  138:         $message='Set new screenname to '.$newscreen;
  139:     } else {
  140:         &Apache::lonnet::del('environment',['screenname']);
  141:         &Apache::lonnet::delenv('environment\.screenname');
  142:         $message='Reset screenname';
  143:     }
  144:     my $bodytag=&Apache::loncommon::bodytag(
  145:                                          'Change Your Anonymous Screen Name');
  146:     $r->print(<<ENDVCSCREEN);
  147: <html>
  148: $bodytag
  149: </p>
  150: $message
  151: </body></html>
  152: ENDVCSCREEN
  153: }
  154: 
  155: ################################################################
  156: #         Message Forward                                      #
  157: ################################################################
  158: 
  159: sub msgforwardchanger {
  160:     my $r = shift;
  161:     my $user       = $ENV{'user.name'};
  162:     my $domain     = $ENV{'user.domain'};
  163:     my %userenv = &Apache::lonnet::get('environment',['msgforward']);
  164:     my $msgforward=$userenv{'msgforward'};
  165:     my $bodytag=&Apache::loncommon::bodytag(
  166:                                          'Change Your Message Forwarding');
  167:     $r->print(<<ENDMSG);
  168: <html>
  169: $bodytag
  170: 
  171: <form name="server" action="/adm/preferences" method="post">
  172: <input type="hidden" name="action" value="verify_and_change_msgforward" />
  173: New Forwarding Address(es) (<tt>user:domain,user:domain,...</tt>):
  174: <input type="text" size="40" value="$msgforward" name="msgforward" />
  175: <input type="submit" value="Change" />
  176: </form>
  177: </body>
  178: </html>
  179: ENDMSG
  180: }
  181: 
  182: sub verify_and_change_msgforward {
  183:     my $r = shift;
  184:     my $user       = $ENV{'user.name'};
  185:     my $domain     = $ENV{'user.domain'};
  186:     my $newscreen  = '';
  187:     my $message='';
  188:     foreach (split(/\,/,$ENV{'form.msgforward'})) {
  189: 	my ($msuser,$msdomain)=split(/[\@\:]/,$_);
  190:         $msuser=~s/\W//g;
  191:         $msdomain=~s/\W//g;
  192:         if (($msuser) && ($msdomain)) {
  193: 	    if (&Apache::lonnet::homeserver($msuser,$msdomain) ne 'no_host') {
  194:                $newscreen.=$msuser.':'.$msdomain.',';
  195: 	   } else {
  196:                $message.='No such user: '.$msuser.':'.$msdomain.'<br>';
  197:            }
  198:         }
  199:     }
  200:     $newscreen=~s/\,$//;
  201:     if ($newscreen) {
  202:         &Apache::lonnet::put('environment',{'msgforward' => $newscreen});
  203:         &Apache::lonnet::appenv('environment.msgforward' => $newscreen);
  204:         $message.='Set new message forwarding to '.$newscreen;
  205:     } else {
  206:         &Apache::lonnet::del('environment',['msgforward']);
  207:         &Apache::lonnet::delenv('environment\.msgforward');
  208:         $message.='Reset message forwarding';
  209:     }
  210:     my $bodytag=&Apache::loncommon::bodytag(
  211:                                          'Change Your Message Forwarding');
  212:     $r->print(<<ENDVCMSG);
  213: <html>
  214: $bodytag
  215: </p>
  216: $message
  217: </body></html>
  218: ENDVCMSG
  219: }
  220: 
  221: ######################################################
  222: #            password handler subroutines            #
  223: ######################################################
  224: sub passwordchanger {
  225:     # This function is a bit of a mess....
  226:     # Passwords are encrypted using londes.js (DES encryption)
  227:     my $r = shift;
  228:     my $errormessage = shift;
  229:     $errormessage = ($errormessage || '');
  230:     my $user       = $ENV{'user.name'};
  231:     my $domain     = $ENV{'user.domain'};
  232:     my $homeserver = $ENV{'user.home'};
  233:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
  234:     # Check for authentication types that allow changing of the password.
  235:     return if ($currentauth !~ /^(unix|internal):/);
  236:     #
  237:     # Generate keys
  238:     my ($lkey_cpass ,$ukey_cpass ) = &des_keys();
  239:     my ($lkey_npass1,$ukey_npass1) = &des_keys();
  240:     my ($lkey_npass2,$ukey_npass2) = &des_keys();
  241:     # Store the keys in the log files
  242:     my $lonhost = $r->dir_config('lonHostID');
  243:     my $logtoken=Apache::lonnet::reply('tmpput:'
  244: 				       .$ukey_cpass  . $lkey_cpass .'&'
  245: 				       .$ukey_npass1 . $lkey_npass1.'&'
  246: 				       .$ukey_npass2 . $lkey_npass2,
  247: 				       $lonhost);
  248:     # Hexify the keys for output as javascript variables
  249:     $ukey_cpass = hex($ukey_cpass);
  250:     $lkey_cpass = hex($lkey_cpass);
  251:     $ukey_npass1= hex($ukey_npass1);
  252:     $lkey_npass1= hex($lkey_npass1);
  253:     $ukey_npass2= hex($ukey_npass2);
  254:     $lkey_npass2= hex($lkey_npass2);
  255:     # Output javascript to deal with passwords
  256:     # Output DES javascript
  257:     $r->print("<html><head>");
  258:     {
  259: 	my $include = $r->dir_config('lonIncludes');
  260: 	my $jsh=Apache::File->new($include."/londes.js");
  261: 	$r->print(<$jsh>);
  262:     }
  263:     my $bodytag=&Apache::loncommon::bodytag('Change Password','',
  264:                                          'onLoad="init();"');
  265:     $r->print(<<ENDFORM);
  266: </head>
  267: $bodytag
  268: 
  269: <script language="JavaScript">
  270: 
  271:     function send() {
  272:         uextkey=this.document.client.elements.ukey_cpass.value;
  273:         lextkey=this.document.client.elements.lkey_cpass.value;
  274:         initkeys();
  275: 
  276:         this.document.server.elements.currentpass.value
  277:             =crypted(this.document.client.elements.currentpass.value);
  278: 
  279:         uextkey=this.document.client.elements.ukey_npass1.value;
  280:         lextkey=this.document.client.elements.lkey_npass1.value;
  281:         initkeys();
  282:         this.document.server.elements.newpass_1.value
  283:             =crypted(this.document.client.elements.newpass_1.value);
  284: 
  285:         uextkey=this.document.client.elements.ukey_npass2.value;
  286:         lextkey=this.document.client.elements.lkey_npass2.value;
  287:         initkeys();
  288:         this.document.server.elements.newpass_2.value
  289:             =crypted(this.document.client.elements.newpass_2.value);
  290: 
  291:         this.document.server.submit();
  292:     }
  293: 
  294: </script>
  295: $errormessage
  296: 
  297: <p>
  298: <!-- We seperate the forms into 'server' and 'client' in order to
  299:      ensure that unencrypted passwords will not be sent out by a
  300:      crappy browser -->
  301: 
  302: <form name="server" action="/adm/preferences" method="post">
  303: <input type="hidden" name="logtoken"    value="$logtoken" />
  304: <input type="hidden" name="action"      value="verify_and_change_pass" />
  305: <input type="hidden" name="currentpass" value="" />
  306: <input type="hidden" name="newpass_1"   value="" />
  307: <input type="hidden" name="newpass_2"   value="" />
  308: </form>
  309: 
  310: <form name="client" >
  311: <table>
  312: <tr><td align="right"> Current password:                      </td>
  313:     <td><input type="password" name="currentpass" size="10"/> </td></tr>
  314: <tr><td align="right"> New password:                          </td>
  315:     <td><input type="password" name="newpass_1" size="10"  /> </td></tr>
  316: <tr><td align="right"> Confirm password:                      </td>
  317:     <td><input type="password" name="newpass_2" size="10"  /> </td></tr>
  318: <tr><td colspan="2" align="center">
  319:     <input type="button" value="Change Password" onClick="send();">
  320: </table>
  321: <input type="hidden" name="ukey_cpass"  value="$ukey_cpass" />
  322: <input type="hidden" name="lkey_cpass"  value="$lkey_cpass" />
  323: <input type="hidden" name="ukey_npass1" value="$ukey_npass1" />
  324: <input type="hidden" name="lkey_npass1" value="$lkey_npass1" />
  325: <input type="hidden" name="ukey_npass2" value="$ukey_npass2" />
  326: <input type="hidden" name="lkey_npass2" value="$lkey_npass2" />
  327: </form>
  328: </p>
  329: ENDFORM
  330:     #
  331:     return;
  332: }
  333: 
  334: sub verify_and_change_password {
  335:     my $r = shift;
  336:     my $user       = $ENV{'user.name'};
  337:     my $domain     = $ENV{'user.domain'};
  338:     my $homeserver = $ENV{'user.home'};
  339:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
  340:     # Check for authentication types that allow changing of the password.
  341:     return if ($currentauth !~ /^(unix|internal):/);
  342:     #
  343:     $r->print(<<ENDHEADER);
  344: <html>
  345: <head>
  346: <title>LON-CAPA Preferences:  Change password for $user</title>
  347: </head>
  348: ENDHEADER
  349:     #
  350:     my $currentpass = $ENV{'form.currentpass'}; 
  351:     my $newpass1    = $ENV{'form.newpass_1'}; 
  352:     my $newpass2    = $ENV{'form.newpass_2'};
  353:     my $logtoken    = $ENV{'form.logtoken'};
  354:     # Check for empty data 
  355:     unless (defined($currentpass) && 
  356: 	    defined($newpass1)    && 
  357: 	    defined($newpass2)    ){
  358: 	&passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
  359: 			 "Password data was blank.\n</p>");
  360: 	return;
  361:     }
  362:     # Get the keys
  363:     my $lonhost = $r->dir_config('lonHostID');
  364:     my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
  365:     if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
  366:         # I do not a have a better idea about how to handle this
  367: 	$r->print(<<ENDERROR);
  368: <p>
  369: <font color="#ff0000">ERROR:</font> Unable to retrieve stored token for
  370: password decryption.  Please log out and try again.
  371: </p>
  372: ENDERROR
  373:         # Probably should log an error here
  374:         return;
  375:     }
  376:     my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
  377:     # 
  378:     my $currentpass = &des_decrypt($ckey ,$currentpass);
  379:     my $newpass1    = &des_decrypt($n1key,$newpass1);
  380:     my $newpass2    = &des_decrypt($n2key,$newpass2);
  381:     # 
  382:     if ($newpass1 ne $newpass2) {
  383: 	&passwordchanger($r,
  384: 			 '<font color="#ff0000">ERROR:</font>'.
  385: 			 'The new passwords you entered do not match.  '.
  386: 			 'Please try again.');
  387: 	return;
  388:     }
  389:     if (length($newpass1) < 7) {
  390: 	&passwordchanger($r,
  391: 			 '<font color="#ff0000">ERROR:</font>'.
  392: 			 'Passwords must be a minimum of 7 characters long.  '.
  393: 			 'Please try again.');
  394: 	return;
  395:     }
  396:     #
  397:     # Check for bad characters
  398:     my $badpassword = 0;
  399:     foreach (split(//,$newpass1)) {
  400: 	$badpassword = 1 if ((ord($_)<32)||(ord($_)>126));
  401:     }
  402:     if ($badpassword) {
  403: 	# I can't figure out how to enter bad characters on my browser.
  404: 	&passwordchanger($r,<<ENDERROR);
  405: <font color="#ff0000">ERROR:</font>
  406: The password you entered contained illegal characters.<br />
  407: Valid characters are: space and <br />
  408: <pre>
  409: !&quot;\#$%&amp;\'()*+,-./0123456789:;&lt;=&gt;?\@
  410: ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_\`abcdefghijklmnopqrstuvwxyz{|}~
  411: </pre>
  412: ENDERROR
  413:     }
  414:     # 
  415:     # Change the password (finally)
  416:     my $result = &Apache::lonnet::changepass
  417: 	($user,$domain,$currentpass,$newpass1,$homeserver);
  418:     # Inform the user the password has (not?) been changed
  419:     if ($result =~ /^ok$/) {
  420: 	$r->print(<<"ENDTEXT");
  421: <h2>The password for $user was successfully changed</h2>
  422: ENDTEXT
  423:     } else {
  424: 	# error error: run in circles, scream and shout
  425:         $r->print(<<ENDERROR);
  426: <h2><font color="#ff0000">The password for $user was not changed</font></h2>
  427: Please make sure your old password was entered correctly.
  428: ENDERROR
  429:     }
  430:     return;
  431: }
  432: 
  433: ######################################################
  434: #            other handler subroutines               #
  435: ######################################################
  436: 
  437: ################################################################
  438: #                          Main handler                        #
  439: ################################################################
  440: sub handler {
  441:     my $r = shift;
  442:     my $user = $ENV{'user.name'};
  443:     my $domain = $ENV{'user.domain'};
  444:     $r->content_type('text/html');
  445:     # Some pages contain DES keys and should not be cached.
  446:     &Apache::loncommon::no_cache($r);
  447:     $r->send_http_header;
  448:     return OK if $r->header_only;
  449:     #
  450:     if ($ENV{'form.action'} eq 'changepass') {
  451: 	&passwordchanger($r);
  452:     } elsif ($ENV{'form.action'} eq 'verify_and_change_pass') {
  453: 	&verify_and_change_password($r);
  454:     } elsif ($ENV{'form.action'} eq 'changescreenname') {
  455:         &screennamechanger($r);
  456:     } elsif ($ENV{'form.action'} eq 'verify_and_change_screenname') {
  457:         &verify_and_change_screenname($r);
  458:     } elsif ($ENV{'form.action'} eq 'changemsgforward') {
  459:         &msgforwardchanger($r);
  460:     } elsif ($ENV{'form.action'} eq 'verify_and_change_msgforward') {
  461:         &verify_and_change_msgforward($r);
  462:     } else {
  463: 	$r->print(<<ENDHEADER);
  464: <html>
  465: <head>
  466: <title>LON-CAPA Preferences</title>
  467: </head>
  468: ENDHEADER
  469:         $r->print(&Apache::loncommon::bodytag('Change Your Preferences'));
  470: 	# Determine current authentication method
  471: 	my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
  472: 	if ($currentauth =~ /^(unix|internal):/) {
  473: 	    $r->print(<<ENDPASSWORDFORM);
  474: <form name="client" action="/adm/preferences" method="post">
  475: <input type="hidden" name="action" value="changepass">
  476: <input type="submit" value="Change password">
  477: </form>
  478: ENDPASSWORDFORM
  479: # Change screen name
  480: 	    $r->print(<<ENDSCREENNAMEFORM);
  481: <form name="client" action="/adm/preferences" method="post">
  482: <input type="hidden" name="action" value="changescreenname">
  483: <input type="submit" value="Change anonymous discussion screen name">
  484: </form>
  485: ENDSCREENNAMEFORM
  486: 	    $r->print(<<ENDMSGFORWARDFORM);
  487: <form name="client" action="/adm/preferences" method="post">
  488: <input type="hidden" name="action" value="changemsgforward">
  489: <input type="submit" value="Change message forwarding address">
  490: </form>
  491: ENDMSGFORWARDFORM
  492: # The "about me" page
  493:             my $aboutmeaction=
  494:         '/adm/'.$ENV{'user.domain'}.'/'.$ENV{'user.name'}.'/aboutme';
  495: 	    $r->print(<<ENDABOUTME);
  496: <form name="client" action="$aboutmeaction" method="post">
  497: <input type="hidden" name="action" value="changescreenname">
  498: <input type="submit" value="Edit the 'About Me' Personal Information Screen">
  499: </form>
  500: ENDABOUTME
  501:             # Other preference setting code should be added here
  502: 	}
  503:     }
  504:     $r->print(<<ENDFOOTER);
  505: </body>
  506: </html>
  507: ENDFOOTER
  508:     return OK;
  509: } 
  510: 
  511: 1;
  512: __END__

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