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>
![[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