Return to test_login.pl CVS log

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

- fixing login test so it works again

#!/usr/bin/perl

=pod

=head1 NAME

B<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.4 2003/06/30 17:35:13 albertel 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
#
###

# 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=~/input type=\"text\" name=\"udom\".*value\=\"(\S+)\"/) {
    $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


=cut

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.