Annotation of loncom/build/weblayer_test/test_login.pl, revision 1.1
1.1 ! harris41 1: #!/usr/bin/perl
! 2:
! 3: =pod
! 4:
! 5: =head1 NAME
! 6:
! 7: 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$
! 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=~/value\=(\S+)\s+name\=udom/) {
! 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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to test_login.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / build / weblayer_test