Annotation of loncom/build/weblayer_test/test_login.pl, revision 1.4

1.1       harris41    1: #!/usr/bin/perl
                      2: 
                      3: =pod
                      4: 
                      5: =head1 NAME
                      6: 
1.2       harris41    7: B<test_login.pl> - Attempt to login given a user name and password and assuming that /bin/hostname is the appropriate url.
1.1       harris41    8: 
                      9: =cut
                     10: 
                     11: # The LearningOnline Network
                     12: # test_login.pl - LON TCP-MySQL-Server Daemon for handling database requests.
                     13: #
1.4     ! albertel   14: # $Id: test_login.pl,v 1.3 2003/02/03 18:03:52 harris41 Exp $
1.1       harris41   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;
1.4     ! albertel  118: if ($content=~/logtoken\" value=\"([^\"]*)\"/) {
1.1       harris41  119:     $logtoken=$1;
                    120: }
                    121: my $udom;
1.4     ! albertel  122: if ($content=~/input type=\"text\" name=\"udom\".*value\=\"(\S+)\"/) {
1.1       harris41  123:     $udom=$1;
                    124: }
                    125: my $serverid;
1.4     ! albertel  126: if ($content=~/name\=\"serverid\" value\=\"([^\"]+)\"/) {
1.1       harris41  127:     $serverid=$1;
                    128: }
                    129: my $lextkey;
1.2       harris41  130: if ($content=~/name\=\"lextkey\" value\=\"([^\"]+)\"/) {
1.1       harris41  131:     $lextkey=$1;
                    132: }
                    133: my $uextkey;
1.2       harris41  134: if ($content=~/name\=\"uextkey\" value\=\"([^\"]+)\"/) {
1.1       harris41  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

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