Return to test_login.pl CVS log

Up to [LON-CAPA] / loncom / build / weblayer_test

- fixing login test so it works again

    1: #!/usr/bin/perl
    2: 
    3: =pod
    4: 
    5: =head1 NAME
    6: 
    7: B<test_login.pl> - Attempt to login given a user name and password and assuming that /bin/hostname is the appropriate url.
    8: 
    9: =cut
   10: 
   11: # The LearningOnline Network
   12: # test_login.pl - LON TCP-MySQL-Server Daemon for handling database requests.
   13: #
   14: # $Id: test_login.pl,v 1.4 2003/06/30 17:35:13 albertel Exp $
   15: #
   16: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   17: #
   18: # LON-CAPA is free software; you can redistribute it and/or modify
   19: # it under the terms of the GNU General Public License as published by
   20: # the Free Software Foundation; either version 2 of the License, or
   21: # (at your option) any later version.
   22: #
   23: # LON-CAPA is distributed in the hope that it will be useful,
   24: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   25: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   26: # GNU General Public License for more details.
   27: #
   28: # You should have received a copy of the GNU General Public License
   29: # along with LON-CAPA; if not, write to the Free Software
   30: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   31: #
   32: # /home/httpd/html/adm/gpl.txt
   33: #
   34: # http://www.lon-capa.org/
   35: #
   36: # YEAR=2002
   37: #
   38: ###
   39: 
   40: # This is a standalone script from other parts of the LON-CAPA code.
   41: # (It is important that test scripts be reasonably independent from
   42: # the rest of the system so that we KNOW what dependencies they are
   43: # testing.)
   44: 
   45: =pod
   46: 
   47: =head1 SYNOPSIS
   48: 
   49: B<perl test_login.pl>
   50: 
   51: The first value in standard input is the user name to login with.
   52: The second value in standard input is the password.
   53: 
   54: =head1 DESCRIPTION
   55: 
   56: A number of things are tested for.
   57: 
   58: =over 4
   59: 
   60: =item *
   61: 
   62: Is there an opening web page?
   63: 
   64: =item *
   65: 
   66: Is there a login page?  If so, grab relevant data to calculate
   67: DES crypted password.  Then, simulate a form submit to authentication
   68: handler.
   69: 
   70: =item *
   71: 
   72: Is there an authentication handler?
   73: Is the form submission successful to the authentication handler?
   74: 
   75: =back
   76: 
   77: The answer to all the above questions on a working system
   78: (assuming that the user name and password are correct)
   79: should be "yes".
   80: 
   81: =cut
   82: 
   83: require LWP;
   84: 
   85: use URI;
   86: use HTTP::Request::Common;
   87: use Crypt::DES;
   88: 
   89: my $uname=<>; chomp $uname;
   90: my $passwd=<>; chomp $passwd;
   91: my $hostname=`hostname`; chomp $hostname;
   92: 
   93: my $ua = LWP::UserAgent->new();
   94: my $method='GET';
   95: my $request = HTTP::Request->new($method);
   96: my $url = URI->new('http://'.$hostname);
   97: 
   98: $request->url($url);
   99: my $response=$ua->request($request);
  100: 
  101: unless ($response->is_success) {
  102:     print "**** ERROR **** Cannot reach opening web page http://$hostname\n";
  103:     exit 1;
  104: }
  105: 
  106: $method='GET';
  107: $url = URI->new('http://'.$hostname.'/adm/login');
  108: $request->url($url);
  109: $response=$ua->request($request);
  110: unless ($response->is_success) {
  111:     print "**** ERROR **** Cannot reach login web page http://$hostname".
  112: 	"/adm/login\n";
  113:     exit 1;
  114: }
  115: 
  116: my $content=$response->content;
  117: my $logtoken;
  118: if ($content=~/logtoken\" value=\"([^\"]*)\"/) {
  119:     $logtoken=$1;
  120: }
  121: my $udom;
  122: if ($content=~/input type=\"text\" name=\"udom\".*value\=\"(\S+)\"/) {
  123:     $udom=$1;
  124: }
  125: my $serverid;
  126: if ($content=~/name\=\"serverid\" value\=\"([^\"]+)\"/) {
  127:     $serverid=$1;
  128: }
  129: my $lextkey;
  130: if ($content=~/name\=\"lextkey\" value\=\"([^\"]+)\"/) {
  131:     $lextkey=$1;
  132: }
  133: my $uextkey;
  134: if ($content=~/name\=\"uextkey\" value\=\"([^\"]+)\"/) {
  135:     $uextkey=$1;
  136: }
  137: 
  138: print "Trying to log in with test user...\n";
  139: print "Logtoken: $logtoken\n";
  140: print "Udom: $udom\n";
  141: print "Serverid: $serverid\n";
  142: my $upass;
  143: my $cipher;
  144: #print "Lextkey: $lextkey\n";
  145: #print "Uextkey: $uextkey\n";
  146: my $ukey=sprintf("%lx",$uextkey);
  147: my $lkey=sprintf("%lx",$lextkey);
  148: my $key=$ukey.$lkey;
  149: print "KEY: $key\n";
  150: my $keybin=pack("H16",$key,0,16);
  151: if ($Crypt::DES::VERSION>=2.03) {
  152:     $cipher=new Crypt::DES $keybin;
  153: }
  154: else {
  155:     $cipher=new DES $keybin;
  156: }
  157: my $len=length($passwd);
  158: $passwd.=' 'x(16-$len);
  159: my $p1=substr($passwd,0,7);
  160: my $p2=substr($passwd,7,8);
  161: my $ciphertext=$cipher->encrypt(chr($len).$p1);
  162: my $ciphertext2=$cipher->encrypt($p2);
  163: my $upciphertext=unpack("H16",$ciphertext);
  164: $upciphertext.=unpack("H16",$ciphertext2);
  165: $upass=$upciphertext;
  166: print "Upass: $upass\n";
  167: # TEST CODE FOR DECRYPTION
  168: #my $upass2=$cipher->decrypt(unpack("a8",pack("H16",$upciphertext,0,16)));
  169: #$upass2.=$cipher->decrypt(unpack("a8",pack("H16",substr($upciphertext,16,16))));
  170: #my $Ord=ord(substr($upass2,0,1));
  171: #print "Ord: $Ord\n";
  172: #$upass2=substr($upass2,1,ord(substr($upass2,0,1)));
  173: #print "Upass2: [$upass2]\n";
  174: 
  175: $response=$ua->request(POST 'http://'.$hostname.'/adm/authenticate',
  176: 	     [
  177: 	      logtoken => $logtoken,
  178: 	      serverid => $serverid,
  179: 	      uname => $uname,
  180: 	      upass => $upass,
  181: 	      udom => $udom,
  182: 	      ]
  183: 	     );
  184: unless ($response->is_success) {
  185:     print "**** ERROR **** Cannot reach authenticating page http://$hostname".
  186: 	"/adm/authenticate\n";
  187:     exit 1;
  188: }
  189: my $rstring=$response->content;
  190: unless ($rstring=~/Successful Login/) {
  191:     print "**** ERROR **** Logging in is not working (SOMETHING IS WRONG!)\n";
  192:     print "* HINT * Are your perl modules up to date?\n";
  193:     print "* HINT * Are lonc and lond running on the system?\n";
  194:     print "* HINT * Did you look at /home/httpd/perl/logs/lonc.log?\n";
  195:     print "* HINT * Did you look at /home/httpd/perl/logs/lond.log?\n";
  196:     exit 1;
  197: }
  198: else {
  199:     print "Success! Can login with test user.\n";
  200: }
  201: 
  202: =pod
  203: 
  204: =head1 PREREQUISITES
  205: 
  206: LWP
  207: URI
  208: HTTP::Request::Common
  209: Crypt::DES
  210: 
  211: =head1 AUTHOR
  212: 
  213: 
  214: =cut