Return to test_login.pl CVS log

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

udom, lextkey, and uextkey are now read correctly with
the latest login page
BUG 322
FIXED

    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.2 2002/05/04 03:57:06 harris41 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: # 3/3 Scott Harrison
   38: #
   39: ###
   40: 
   41: # This is a standalone script from other parts of the LON-CAPA code.
   42: # (It is important that test scripts be reasonably independent from
   43: # the rest of the system so that we KNOW what dependencies they are
   44: # testing.)
   45: 
   46: =pod
   47: 
   48: =head1 SYNOPSIS
   49: 
   50: B<perl test_login.pl>
   51: 
   52: The first value in standard input is the user name to login with.
   53: The second value in standard input is the password.
   54: 
   55: =head1 DESCRIPTION
   56: 
   57: A number of things are tested for.
   58: 
   59: =over 4
   60: 
   61: =item *
   62: 
   63: Is there an opening web page?
   64: 
   65: =item *
   66: 
   67: Is there a login page?  If so, grab relevant data to calculate
   68: DES crypted password.  Then, simulate a form submit to authentication
   69: handler.
   70: 
   71: =item *
   72: 
   73: Is there an authentication handler?
   74: Is the form submission successful to the authentication handler?
   75: 
   76: =back
   77: 
   78: The answer to all the above questions on a working system
   79: (assuming that the user name and password are correct)
   80: should be "yes".
   81: 
   82: =cut
   83: 
   84: require LWP;
   85: 
   86: use URI;
   87: use HTTP::Request::Common;
   88: use Crypt::DES;
   89: 
   90: my $uname=<>; chomp $uname;
   91: my $passwd=<>; chomp $passwd;
   92: my $hostname=`hostname`; chomp $hostname;
   93: 
   94: my $ua = LWP::UserAgent->new();
   95: my $method='GET';
   96: my $request = HTTP::Request->new($method);
   97: my $url = URI->new('http://'.$hostname);
   98: 
   99: $request->url($url);
  100: my $response=$ua->request($request);
  101: 
  102: unless ($response->is_success) {
  103:     print "**** ERROR **** Cannot reach opening web page http://$hostname\n";
  104:     exit 1;
  105: }
  106: 
  107: $method='GET';
  108: $url = URI->new('http://'.$hostname.'/adm/login');
  109: $request->url($url);
  110: $response=$ua->request($request);
  111: unless ($response->is_success) {
  112:     print "**** ERROR **** Cannot reach login web page http://$hostname".
  113: 	"/adm/login\n";
  114:     exit 1;
  115: }
  116: 
  117: my $content=$response->content;
  118: my $logtoken;
  119: if ($content=~/logtoken value=\"([^\"]*)\"/) {
  120:     $logtoken=$1;
  121: }
  122: my $udom;
  123: if ($content=~/input type=\"text\" name=\"udom\".*value\=(\S+)/) {
  124:     $udom=$1;
  125: }
  126: my $serverid;
  127: if ($content=~/name\=serverid value\=\"([^\"]+)\"/) {
  128:     $serverid=$1;
  129: }
  130: my $lextkey;
  131: if ($content=~/name\=\"lextkey\" value\=\"([^\"]+)\"/) {
  132:     $lextkey=$1;
  133: }
  134: my $uextkey;
  135: if ($content=~/name\=\"uextkey\" value\=\"([^\"]+)\"/) {
  136:     $uextkey=$1;
  137: }
  138: 
  139: print "Trying to log in with test user...\n";
  140: print "Logtoken: $logtoken\n";
  141: print "Udom: $udom\n";
  142: print "Serverid: $serverid\n";
  143: my $upass;
  144: my $cipher;
  145: #print "Lextkey: $lextkey\n";
  146: #print "Uextkey: $uextkey\n";
  147: my $ukey=sprintf("%lx",$uextkey);
  148: my $lkey=sprintf("%lx",$lextkey);
  149: my $key=$ukey.$lkey;
  150: print "KEY: $key\n";
  151: my $keybin=pack("H16",$key,0,16);
  152: if ($Crypt::DES::VERSION>=2.03) {
  153:     $cipher=new Crypt::DES $keybin;
  154: }
  155: else {
  156:     $cipher=new DES $keybin;
  157: }
  158: my $len=length($passwd);
  159: $passwd.=' 'x(16-$len);
  160: my $p1=substr($passwd,0,7);
  161: my $p2=substr($passwd,7,8);
  162: my $ciphertext=$cipher->encrypt(chr($len).$p1);
  163: my $ciphertext2=$cipher->encrypt($p2);
  164: my $upciphertext=unpack("H16",$ciphertext);
  165: $upciphertext.=unpack("H16",$ciphertext2);
  166: $upass=$upciphertext;
  167: print "Upass: $upass\n";
  168: # TEST CODE FOR DECRYPTION
  169: #my $upass2=$cipher->decrypt(unpack("a8",pack("H16",$upciphertext,0,16)));
  170: #$upass2.=$cipher->decrypt(unpack("a8",pack("H16",substr($upciphertext,16,16))));
  171: #my $Ord=ord(substr($upass2,0,1));
  172: #print "Ord: $Ord\n";
  173: #$upass2=substr($upass2,1,ord(substr($upass2,0,1)));
  174: #print "Upass2: [$upass2]\n";
  175: 
  176: $response=$ua->request(POST 'http://'.$hostname.'/adm/authenticate',
  177: 	     [
  178: 	      logtoken => $logtoken,
  179: 	      serverid => $serverid,
  180: 	      uname => $uname,
  181: 	      upass => $upass,
  182: 	      udom => $udom,
  183: 	      ]
  184: 	     );
  185: unless ($response->is_success) {
  186:     print "**** ERROR **** Cannot reach authenticating page http://$hostname".
  187: 	"/adm/authenticate\n";
  188:     exit 1;
  189: }
  190: my $rstring=$response->content;
  191: unless ($rstring=~/Successful Login/) {
  192:     print "**** ERROR **** Logging in is not working (SOMETHING IS WRONG!)\n";
  193:     print "* HINT * Are your perl modules up to date?\n";
  194:     print "* HINT * Are lonc and lond running on the system?\n";
  195:     print "* HINT * Did you look at /home/httpd/perl/logs/lonc.log?\n";
  196:     print "* HINT * Did you look at /home/httpd/perl/logs/lond.log?\n";
  197:     exit 1;
  198: }
  199: else {
  200:     print "Success! Can login with test user.\n";
  201: }
  202: 
  203: =pod
  204: 
  205: =head1 PREREQUISITES
  206: 
  207: LWP
  208: URI
  209: HTTP::Request::Common
  210: Crypt::DES
  211: 
  212: =head1 AUTHOR
  213: 
  214: Scott Harrison, harris41@msu.edu
  215: 
  216: =cut