[LON-CAPA-cvs] cvs: loncom /build/weblayer_test test_login.pl

[harris41]

harris41		Mon Mar  4 01:46:17 2002 EDT

  Added files:                 
    /loncom/build/weblayer_test	test_login.pl 
  Log:
  works (tested).  Using LWP::UserAgent, this runs a test login
  against the LON-CAPA web layer
  
  

Index: loncom/build/weblayer_test/test_login.pl
+++ loncom/build/weblayer_test/test_login.pl
#!/usr/bin/perl

=pod

=head1 NAME

test_login.pl - Attempt to login given a user name and password and assuming that /bin/hostname is the appropriate url.

=cut

# The LearningOnline Network
# test_login.pl - LON TCP-MySQL-Server Daemon for handling database requests.
#
# $Id: test_login.pl,v 1.1 2002/03/04 06:46:17 harris41 Exp $
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# YEAR=2002
# 3/3 Scott Harrison
#
###

# This is a standalone script from other parts of the LON-CAPA code.
# (It is important that test scripts be reasonably independent from
# the rest of the system so that we KNOW what dependencies they are
# testing.)

=pod

=head1 SYNOPSIS

B<perl test_login.pl>

The first value in standard input is the user name to login with.
The second value in standard input is the password.

=head1 DESCRIPTION

A number of things are tested for.

=over 4

=item *

Is there an opening web page?

=item *

Is there a login page?  If so, grab relevant data to calculate
DES crypted password.  Then, simulate a form submit to authentication
handler.

=item *

Is there an authentication handler?
Is the form submission successful to the authentication handler?

=back

The answer to all the above questions on a working system
(assuming that the user name and password are correct)
should be "yes".

=cut

require LWP;

use URI;
use HTTP::Request::Common;
use Crypt::DES;

my $uname=<>; chomp $uname;
my $passwd=<>; chomp $passwd;
my $hostname=`hostname`; chomp $hostname;

my $ua = LWP::UserAgent->new();
my $method='GET';
my $request = HTTP::Request->new($method);
my $url = URI->new('http://'.$hostname);

$request->url($url);
my $response=$ua->request($request);

unless ($response->is_success) {
    print "**** ERROR **** Cannot reach opening web page http://$hostname\n";
    exit 1;
}

$method='GET';
$url = URI->new('http://'.$hostname.'/adm/login');
$request->url($url);
$response=$ua->request($request);
unless ($response->is_success) {
    print "**** ERROR **** Cannot reach login web page http://$hostname".
	"/adm/login\n";
    exit 1;
}

my $content=$response->content;
my $logtoken;
if ($content=~/logtoken value=\"([^\"]*)\"/) {
    $logtoken=$1;
}
my $udom;
if ($content=~/value\=(\S+)\s+name\=udom/) {
    $udom=$1;
}
my $serverid;
if ($content=~/name\=serverid value\=\"([^\"]+)\"/) {
    $serverid=$1;
}
my $lextkey;
if ($content=~/name\=lextkey value\=\"([^\"]+)\"/) {
    $lextkey=$1;
}
my $uextkey;
if ($content=~/name\=uextkey value\=\"([^\"]+)\"/) {
    $uextkey=$1;
}

print "Trying to log in with test user...\n";
print "Logtoken: $logtoken\n";
print "Udom: $udom\n";
print "Serverid: $serverid\n";
my $upass;
my $cipher;
#print "Lextkey: $lextkey\n";
#print "Uextkey: $uextkey\n";
my $ukey=sprintf("%lx",$uextkey);
my $lkey=sprintf("%lx",$lextkey);
my $key=$ukey.$lkey;
print "KEY: $key\n";
my $keybin=pack("H16",$key,0,16);
if ($Crypt::DES::VERSION>=2.03) {
    $cipher=new Crypt::DES $keybin;
}
else {
    $cipher=new DES $keybin;
}
my $len=length($passwd);
$passwd.=' 'x(16-$len);
my $p1=substr($passwd,0,7);
my $p2=substr($passwd,7,8);
my $ciphertext=$cipher->encrypt(chr($len).$p1);
my $ciphertext2=$cipher->encrypt($p2);
my $upciphertext=unpack("H16",$ciphertext);
$upciphertext.=unpack("H16",$ciphertext2);
$upass=$upciphertext;
print "Upass: $upass\n";
# TEST CODE FOR DECRYPTION
#my $upass2=$cipher->decrypt(unpack("a8",pack("H16",$upciphertext,0,16)));
#$upass2.=$cipher->decrypt(unpack("a8",pack("H16",substr($upciphertext,16,16))));
#my $Ord=ord(substr($upass2,0,1));
#print "Ord: $Ord\n";
#$upass2=substr($upass2,1,ord(substr($upass2,0,1)));
#print "Upass2: [$upass2]\n";

$response=$ua->request(POST 'http://'.$hostname.'/adm/authenticate',
	     [
	      logtoken => $logtoken,
	      serverid => $serverid,
	      uname => $uname,
	      upass => $upass,
	      udom => $udom,
	      ]
	     );
unless ($response->is_success) {
    print "**** ERROR **** Cannot reach authenticating page http://$hostname".
	"/adm/authenticate\n";
    exit 1;
}
my $rstring=$response->content;
unless ($rstring=~/Successful Login/) {
    print "**** ERROR **** Logging in is not working (SOMETHING IS WRONG!)\n";
    print "* HINT * Are your perl modules up to date?\n";
    print "* HINT * Are lonc and lond running on the system?\n";
    print "* HINT * Did you look at /home/httpd/perl/logs/lonc.log?\n";
    print "* HINT * Did you look at /home/httpd/perl/logs/lond.log?\n";
    exit 1;
}
else {
    print "Success! Can login with test user.\n";
}

=pod

=head1 PREREQUISITES

LWP
URI
HTTP::Request::Common
Crypt::DES

=head1 AUTHOR

Scott Harrison, harris41@msu.edu

=cut