Annotation of loncom/build/weblayer_test/test_login.pl, revision 1.2
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.2 ! harris41 14: # $Id: test_login.pl,v 1.1 2002/03/04 06:46:17 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: # 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;
1.2 ! harris41 123: if ($content=~/input type=\"text\" name=\"udom\".*value\=(\S+)/) {
1.1 harris41 124: $udom=$1;
125: }
126: my $serverid;
127: if ($content=~/name\=serverid value\=\"([^\"]+)\"/) {
128: $serverid=$1;
129: }
130: my $lextkey;
1.2 ! harris41 131: if ($content=~/name\=\"lextkey\" value\=\"([^\"]+)\"/) {
1.1 harris41 132: $lextkey=$1;
133: }
134: my $uextkey;
1.2 ! harris41 135: if ($content=~/name\=\"uextkey\" value\=\"([^\"]+)\"/) {
1.1 harris41 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