/[vdw]/trunk/oracle_obj_srvr.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/oracle_obj_srvr.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide annotations)
Sun Feb 6 05:28:38 2005 UTC (19 years, 3 months ago) by dpavlin
File MIME type: text/plain
File size: 44995 byte(s)
initial import into svn

1 dpavlin 1 #!/usr/local/bin/perl -w
2     # jdh, 5/29/2003 - pretend to be Oracle DB server to tnslsnr
3     # (mostly stolen from James W. Abendschan jwa@jammed.com)
4     #
5     # Added packet type recognition and response logic, client-"database" connect
6     # conversation, and sql query hand-off to obj_srvr running on DB server.
7     # jdh, 6/10/2003
8     #
9     # Modified to do "database" connect conversation with real DB to validate
10     # password, instead of spoofing. jdh, 7/8/2004)
11    
12     # need below so it can find HTML/HeadParser.pm
13     BEGIN {push @INC, '/usr/local/lib/perl5/site_perl/5.6.0/sun4-solaris/'; }
14    
15     use strict;
16     use Socket;
17     use Carp;
18     use FileHandle;
19    
20     use LWP::UserAgent;
21    
22     my $REP_LOOKUP_FILE = "/full_path/tns_replies.txt";
23     my $CMD_LOOKUP_FILE = "/full_path/tns_cmds.txt";
24     my $PKT_HDR_SIZE = 10;
25     my $MAX_LINESIZE = 2048;
26     my $MAX_PACKETSIZE = 2048;
27     select(STDOUT); $| = 1;
28    
29     my $HOSTADDR = 'wilbur.wou.edu';
30     my $DB_OBJ_SRVR_LSNR_URL = 'https://banweb.ous.edu/wouprd/owa/wou_obj_srvr_lsnr.p_connect';
31     my $DB_OBJ_SRVR_LSNR_SERVER = 'banweb.ous.edu';
32     my $DB_OBJ_SRVR_LSNR_PROC = '/wouprd/owa/wou_obj_srvr_lsnr.p_connect';
33    
34     my $DB_OBJ_SRVR_LSNR_PASSWD = `cat secret_passwd_file`; # not the real name!
35     chomp $DB_OBJ_SRVR_LSNR_PASSWD;
36     my $REAL_DB_HOST = 'spruce.ous.edu';
37     my $REAL_DB_PORT = 1541;
38    
39     # bytes 11 and 12 identifiy the command: 03 09 is DISCONNECT
40     my $LOGOUT_BYTES = '00 0D 00 00 06 00 00 00 00 00 03 09 24';
41    
42     my $GOOD_LOGIN_ACK = '00 38 00 00 06 00 00 00 00 00 04 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 03 00 00 00 00 00 00';
43    
44     my $GOOD_LOGIN_ACK70 = '00 4a 00 00 06 00 00 00 00 00 04 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00';
45    
46     my $OBJ_SRVR_USER_QRY = "select chk_obj_srvr_user(user) from dual";
47    
48     # Actually this must represent the version of Net8 on the client, because some
49     # BI Query V. 7.0 return the '70' acks and some don't.
50     my $BI_QUERY_VERSION = '60'; # will reset if indicated by ACK
51    
52     my $DEBUG = 1;
53    
54     my ($reply, $acc_port, $checksum, $remote, $sock, $iaddr, $paddr, $line,
55     $cmdlen, $cmdlenH, $cmdlenL, $packetlen, $packetlenH, $packetlenL,
56     $command, $cmd_str, $cmd, @bytes, $bytes, $i, $name, @n, $n, $count,
57     $db_port, %tns_cmds, %tns_replies, $fld1, $fld2, $CURR_CMD, $CONTEXT,
58     $QUERY, @QUERY_RESULT, $NUM_COLS, $ROW_CNT, $RECORD_CNT, $SEQ, $envkey,
59     @fh_out, @fh_in, $fd_out, $fd_in, $size, @beq_bytes, $redir_length,
60     $redir_msg, $req, $BAD_LOGIN, $TNS_TYPE, $ua, $request, $response,
61     $http_sock);
62    
63     sub logmsg { return unless $DEBUG;
64     my $fh_out = shift;
65     print $fh_out "$0 $$: @_ at ", scalar localtime, "\n" }
66    
67     # read in tns command and reply lookup files
68     read_config_files();
69    
70    
71     # thanks to Ian Redfern (ian.Redfern@logicaCMG.com) for NET8 Documentation
72     # jhjh - finish updating below to reflect this documentation
73     my %ora_pckt_types =
74     # byte 11 byte 12
75     ( 0x01 => { 0x05 => "CLIENT_TYPE",
76     0x06 => "HANDSHAKE2",
77     0x2C => "IDENT" },
78    
79     0x02 => { 0x00 => "RESET",
80     0x01 => "CHAR_MAP" },
81    
82     0x03 => { 0x02 => "SQL_OPEN",
83     0x03 => "QUERY",
84     0x04 => "QUERY_SECOND",
85     0x05 => "FETCH_MORE",
86     0x08 => "HANDSHAKE7",
87     0x09 => "DISCONNECT",
88     0x0E => "HANDSHAKE7", # on purpose
89     0x27 => "SET_LANG",
90     0x2B => "DESC_COLS",
91     0x3B => "HANDSHAKE5",
92     0x47 => "FETCH",
93     0x51 => "USER_PASSWD",
94     0x52 => "CLIENT_ID",
95     0x54 => "HANDSHAKE4",
96     0x5E => "SQL",
97     0x73 => "AUTH2",
98     0x76 => "AUTH1" },
99    
100     0x04 => { 0x00 => "ACK",
101     0x01 => "ACK70" },
102    
103     0xDE => { 0xAD => "HANDSHAKE1" } );
104    
105    
106     # ============================================================================
107     # Program
108     # ============================================================================
109     # =============================
110     # Get Port for DB Connections
111     # =============================
112     my $LSNR_PORT = 1521; # WOU listener, need to register w/ listener if
113     # pre-spawn mode
114     my $DB_BASE_PORT = 33500; # jhjh
115     my $DB_MAX_PORT = 33600;
116     my $proto = getprotobyname('tcp');
117    
118     socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
119     setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
120     || die "setsockopt: $!";
121    
122     $db_port = $DB_BASE_PORT;
123     until ( bind(Server, sockaddr_in($db_port, INADDR_ANY) ) ||
124     $db_port++ > $DB_MAX_PORT ) { }
125    
126     # open logfile
127     my $LOGFILE = "/tmp/oracle_$db_port.log";
128     if ($DEBUG) {
129     open(LOG, ">$LOGFILE") or die "$!: can't open $LOGFILE for output";
130     select(LOG); $| = 1; select(STDOUT);
131    
132     `chmod 644 $LOGFILE`;
133     }
134    
135     listen(Server,SOMAXCONN) || die "listen: $!";
136    
137     logmsg \*LOG, "DB server started on port $db_port";
138    
139     my $LOGIN = 0;
140    
141     # ====================================
142     # Handshake with Listener (BEQ mode)
143     # ====================================
144     # get reader pipe, writer pipe already opened by parent process (tnslsnr)
145     # (thanks, merlyn!)
146     @fh_in = grep { defined($_) } map FileHandle->new_from_fd($_, "r"), 0..100;
147     @fh_out = grep { defined($_) } map FileHandle->new_from_fd($_, "w"), 0..100;
148     # assume listener won't
149     # more than 100 fd's open;
150     # this won't be true if
151     # we get very many users
152     # even on a dedicated lsnr
153    
154     $size = @fh_in;
155     $fd_in = fileno( $fh_in[ $size - 2 ] ); # 2nd highest fd_in is reader pipe
156     # (at least on this lsnr/platform)
157    
158     $size = @fh_out;
159     $fd_out = fileno( $fh_out[ $size - 1 ] ); # highest fd_out is writer pipe
160    
161     logmsg \*LOG, "fd_in = $fd_in, fd_out = $fd_out";
162    
163     open(IN, "<&=$fd_in");
164     open(OUT, ">&=$fd_out");
165    
166     logmsg \*LOG, "after opening fd_in, fd_out";
167    
168     select OUT; $| = 1;
169    
170     print OUT "NTP0 $$\n";
171    
172     select STDOUT;
173    
174     # pull in 3 messages from tnslsnr; only takes 2 reads
175     sysread(\*IN, $bytes, $MAX_LINESIZE);
176     logmsg \*LOG, "reply from tnslsnr: ", strings($bytes);
177    
178     # sometimes it pulls in all 3 messages in first read
179     if ( strings($bytes) !~ /ADDRESS/ ) {
180     sysread(\*IN, $bytes, $MAX_LINESIZE);
181     logmsg \*LOG, "reply from tnslsnr: ", strings($bytes);
182     }
183    
184     $cmd_str = "(ADDRESS=(PROTOCOL=tcp)(HOST=$HOSTADDR)(PORT=$db_port))";
185    
186     # Below is my deduction, have tested through the "10's" column, and
187     # contined into the 100's and 1000's but didn't provide a long enough
188     # following message to totally confirm. Behaviour was consistent w/
189     # this idea through all 4 columns (jhjh).
190     #
191     # Since each byte can represent 255 symbols, the following length (for
192     # the message AFTER this message) is represented in the 4 bytes as given
193     # below (bigEndian format?):
194     # base 256 1's 10's 100's 1000's
195     # base 10 0-255 256 - 65535, etc.
196     # !!(above is true for linux)
197     # !!print OUT chr(length($cmd_str) ), chr(0), chr(0), chr(0);
198    
199     # for Solaris, it is littleEndian
200     print OUT chr(0), chr(0), chr(0), chr(length($cmd_str) );
201    
202     print OUT $cmd_str;
203    
204    
205     # ============================================================================
206     # accept connection from obj_srvr (may be remote)
207     # ============================================================================
208     socket(Obj_Srvr_Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
209     setsockopt(Obj_Srvr_Server, SOL_SOCKET, SO_REUSEADDR,
210     pack("l", 1)) || die "setsockopt: $!";
211    
212     until ( bind(Obj_Srvr_Server, sockaddr_in($db_port, INADDR_ANY) ) ||
213     $db_port++ > $DB_MAX_PORT ) { }
214    
215     ($db_port > $DB_MAX_PORT) && die "bind: $!";
216    
217     logmsg \*LOG, "sending POST to $DB_OBJ_SRVR_LSNR_URL, host = $HOSTADDR, port = $db_port\n";
218    
219     # this will start (possibly) remote obj_srvr and then it will connect to us on $db_port
220     $ua = LWP::UserAgent->new;
221    
222     # password-protected public OAS procedure that sends dbms_pipe message to
223     # (possibly) remote OS listener (for SCT Banner this is GURJOBS, the job
224     # submission listener), which starts dedicated obj_srvr
225     $ua->post( $DB_OBJ_SRVR_LSNR_URL, { pp_uid => "obj_srvr",
226     pp_passwd => $DB_OBJ_SRVR_LSNR_PASSWD,
227     pp_host => $HOSTADDR,
228     pp_port => $db_port } );
229    
230     # jhjh - use this option if $ua->post is broken on your server
231     # jhjh $request = HTTP::Request->new(POST => $DB_OBJ_SRVR_LSNR_URL);
232    
233     # jhjh $request->content("pp_uid=obj_srvr&pp_passwd=$DB_OBJ_SRVR_LSNR_PASSWD&pp_host=$HOSTADDR&pp_port=$db_port");
234    
235     # jhjh $response = $ua->request($request);
236    
237     # if that is also broken, below will work but passes the lsnr password over
238     # unencrypted socket in plain text.
239    
240     #!! not secure: need to use https
241     # jhjh $http_sock = socket_connect($DB_OBJ_SRVR_LSNR_SERVER, 80);
242     # jhjh select($http_sock); $| = 1; select(STDOUT);
243     # jhjh print $http_sock "POST $DB_OBJ_SRVR_LSNR_PROC?pp_uid=obj_srvr&pp_passwd=$DB_OBJ_SRVR_LSNR_PASSWD&pp_host=$HOSTADDR&pp_port=$db_port\n";
244     # jhjh logmsg \*LOG, sysread($http_sock, $bytes, $MAX_LINESIZE); # don't care about this
245     # jhjh close($http_sock);
246    
247     # to make sure that obj_srvr doesn't try to connect before we're listening,
248     # the obj_srvr will try to connect 10 times w/ 2 second pauses in between.
249    
250     logmsg \*LOG, "sent POST\n";
251     listen(Obj_Srvr_Server,SOMAXCONN) || die "listen: $!";
252    
253     $paddr = accept(Obj_Srvr, Obj_Srvr_Server);
254     ($acc_port,$iaddr) = sockaddr_in($paddr);
255     $name = gethostbyaddr($iaddr,AF_INET);
256    
257     logmsg \*LOG, "connection from $name [", inet_ntoa($iaddr), "] at port $acc_port";
258    
259     select(Obj_Srvr); $| = 1; select(STDOUT);
260    
261     # ===========================================
262     # Listen for Client Connection to "Database"
263     # ===========================================
264     db_accept(\*Server);
265     logmsg \*LOG, "end of oracle\n";
266     close(LOG);
267    
268    
269     # ===========================================================================
270     # Subroutines
271     # ===========================================================================
272     sub db_accept {
273    
274     my $server_socket = shift;
275    
276     my ($bytes, $valid_login, $redir_host, $redir_port, $handshake_done,
277     $req_type, $state);
278    
279     logmsg \*LOG, "calling db_accept()";
280    
281     $paddr = accept(Client, $server_socket);
282     ($acc_port,$iaddr) = sockaddr_in($paddr);
283     $name = gethostbyaddr($iaddr,AF_INET);
284    
285     logmsg \*LOG, "connection from $name [", inet_ntoa($iaddr), "] at port $acc_port";
286    
287     $CONTEXT = "HANDSHAKE";
288     $SEQ = 0;
289    
290    
291     # jhjh - make connection to real production db here (at the sqlnet
292     # packet level), then pass along the client packets to this
293     # db, to let it do the password validation. If it logs the
294     # user in, they are validated. We log them out from that DB
295     # and continue. Otherwise we disconnect them. We will
296     # pass back the DB's replies to the client to keep the
297     # conversation going, all the way through login. This means
298     # we don't need to spoof nearly as much (like we were doing
299     # with %ora_pckt_types). We let the DB do that for us, to
300     # satisfy the client that it is connected to a real DB. We
301     # accomplish this and the password validation in one step.
302     # all we have to do then is the more-or-less ascii text
303     # sql communication. Whoa!
304    
305    
306     # jhjh - at this point we start talking to the real DB, and pass through
307     # all listener and client traffic. The listener handshakes with
308     # the real DB (while we read and pass along the traffic), the
309     # client does the same, then when the client successfully logs in
310     # we close the real DB connection and take over. Obj_srvr will
311     # make a new DB connection as user obj_srvr. Will need to build
312     # in some object security to obj_srvr, so that different users can
313     # have different access. For our purposes, it may be enough to
314     # control this through the client data model. There is a valid
315     # obj_srvr user list in addition to the wouprd password, only
316     # those in the list can log in.
317    
318     # NOTE: we want the client and Real DB to talk to each other, but not
319     # directly. I.e. when the real DB sends us the redirect port,
320     # we change our real DB socket to that port, but the client still
321     # keeps talking on $db_port. So we don't pass this redirect
322     # message on to the client.
323    
324    
325     logmsg \*LOG, "connecting to real DB...\n"; # jhjh
326     $sock = socket_connect($REAL_DB_HOST, $REAL_DB_PORT);
327     $bytes = prepare_command( lookup_command($CMD_LOOKUP_FILE,
328     "ESTABLISH_REAL_DB") );
329    
330     select($sock); $| = 1; select(Client); $| = 1; select(STDOUT);
331    
332     send_command($sock, $bytes);
333    
334     $valid_login = 0; $BAD_LOGIN = 0; $handshake_done = 0; $state = "";
335    
336     # handle REDIRECT from Real DB
337     if ( sysread($sock, $bytes, $MAX_LINESIZE) ) {
338     logmsg \*LOG, "DB: $bytes\n";
339     get_request_type($bytes); # use to populate $TNS_TYPE
340    
341     if ( $TNS_TYPE == 0x5 and
342     strings($bytes) =~ /\(HOST=(.+)\)\(PORT=(\d+)\)/ and
343     $redir_host = $1 and $redir_port = $2 ) {
344    
345     logmsg \*LOG, "reconnecting to DB at $redir_host on $redir_port\n";
346    
347     close($sock);
348     $sock = socket_connect($redir_host, $redir_port);
349     select($sock); $| = 1; select(STDOUT);
350    
351     # again, send connection request for real DB, not obj_srvr
352     $bytes = prepare_command( lookup_command($CMD_LOOKUP_FILE,
353     "ESTABLISH_REAL_DB") );
354     send_command($sock, $bytes);
355    
356     logmsg \*LOG, "Did REAL_DB REDIRECT\n";
357    
358     # throw away Client's Redirect connect msg to $db_port,
359     # let it get the ACK from REAL_DB
360     if ( sysread(\*Client, $bytes, $MAX_LINESIZE) ) {
361     logmsg \*LOG, "Client: $bytes\n";
362     }
363     }
364     else {
365     die "Big problems";
366     }
367     }
368     else {
369     die "Big problems";
370     }
371    
372    
373     REAL_DB_LOOP:
374     while ( sysread($sock, $bytes, $MAX_LINESIZE) ) {
375    
376     $req_type = get_request_type($bytes); # track state
377     logmsg \*LOG, "\$req_type is $req_type\n";
378     logmsg \*LOG, "DB: $bytes\n";
379     print Client $bytes;
380    
381     if ($req_type eq "RESET") {
382     # Do another read from real DB - this is the real message;
383     # the message from "while ( sysread(... " was just the ACK
384     # to the BREAK.
385     if ( sysread($sock, $bytes, $MAX_LINESIZE) ) {
386     logmsg \*LOG, "DB: $bytes\n";
387     print Client $bytes;
388     }
389     }
390    
391     if ($BAD_LOGIN) {
392     close($sock);
393     last REAL_DB_LOOP;
394     }
395    
396     if ( logged_in($state, $bytes) ) {
397     $valid_login = 1;
398     $state = "";
399     }
400    
401     if ( $handshake_done ) {
402     logmsg \*LOG, "checking if valid obj_srvr user\n";
403    
404     # must be in the list of obj_srvr users, not just have a DB login
405     if ( !obj_srvr_user($sock) ) {
406     $valid_login = 0;
407     send_command(\*Client, lookup_command($REP_LOOKUP_FILE,
408     "INVALID_USER_PASS") );
409     }
410    
411     logmsg \*LOG, "disconnecting from Real DB\n";
412     send_command($sock, $LOGOUT_BYTES);
413     last REAL_DB_LOOP;
414     }
415    
416     if ( sysread(\*Client, $bytes, $MAX_LINESIZE) ) {
417     if ( handshake_done($bytes) ) { $handshake_done = 1 }
418    
419     $req_type = get_request_type($bytes); # track state
420    
421     if ($req_type eq "USER_PASSWD" ) {
422     $state = $req_type;
423     }
424     print $sock $bytes;
425     logmsg \*LOG, "Client: $bytes\n";
426     }
427     }
428     logmsg \*LOG, "outside REAL_DB_LOOP\n";
429     if (sysread($sock, $bytes, $MAX_LINESIZE) ) {
430     logmsg \*LOG, "Last DB Read: $bytes\n";
431     }
432     close($sock);
433    
434     # send client an INVALID_USER_PASS if we're returning
435     if (!$valid_login) {
436     send_command(\*Client, lookup_command($REP_LOOKUP_FILE,
437     "INVALID_USER_PASS") );
438     close(Client);
439     return;
440     }
441    
442     # fall-through (we have a valid user/password)
443    
444     # Now we're speaking SQL (after a couple of handshake messages;
445     # send_reply() will handle these.)
446     while ( sysread(\*Client, $bytes, $MAX_LINESIZE) ) {
447     logmsg \*LOG, "$bytes\n";
448     send_reply(\*Client, $bytes);
449     }
450     }
451    
452     sub hexify {
453     my $input = shift;
454     my ($output, $i);
455     for ($i=0; $i<length($input); $i++) {
456     $output .= sprintf "%.2x ", ord(substr($input, $i, 1));
457     }
458     return $output;
459     }
460    
461     sub hexdump {
462     my $input = shift;
463     my ($byte, $count, $output);
464    
465     ($byte) = unpack("C", $input);
466     $count++;
467     $output .= sprintf "%.2x ", $byte;
468    
469     while ( ($byte) = unpack("x$count C", $input) ) {
470     $count++;
471     $output .= sprintf "%.2x ", $byte;
472     }
473    
474     $output =~ s/\s$//;
475    
476     return $output;
477     }
478    
479     sub lookup_command { # jdh
480     my ($cmd_file, $cmd_keyword) = @_;
481    
482    
483     if ( $BI_QUERY_VERSION eq '70' and
484     $cmd_file =~ /replies/i and
485     exists($tns_replies{ $cmd_keyword . '70' } ) ) {
486     $cmd_keyword .= '70';
487     }
488    
489     logmsg \*LOG, "\nCOMMAND: $cmd_keyword\n"; # jhjh
490    
491     if ($cmd_file =~ /cmds/i ) { return $tns_cmds{$cmd_keyword} }
492     if ($cmd_file =~ /replies/i ) { return $tns_replies{$cmd_keyword} }
493    
494     }
495    
496    
497     sub socket_connect {
498     my ($remote, $port) = @_;
499     if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
500     die "No port" unless $port;
501     $iaddr = inet_aton($remote) || die "no host: $remote";
502     $paddr = sockaddr_in($port, $iaddr);
503     $proto = getprotobyname('tcp');
504     socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
505     connect(SOCK, $paddr) || die "connect: $!";
506     select(SOCK); $| = 1; select(STDOUT);
507     logmsg \*LOG, "Connected\n";
508    
509     return \*SOCK;
510     }
511    
512     sub prepare_command {
513     my $cmd_str = shift;
514    
515     my ($mode);
516    
517     $mode = shift or ($mode = "TCP"); # TCP is default, BEQ is for talking
518     # to lsnr when lsnr running in bequeath
519     # mode
520    
521     my $hdr_size = $mode eq "TCP" ? 58 :
522     ($mode eq "BEQ" ? 4 : 0); # TCP header is 58 bytes,
523     # BEQ header is 4 bytes
524    
525     $cmd_str =~ s/\$COLON/:/;
526     $cmd_str =~ s/\$pid/$$/;
527     $cmd_str =~ s/\$port/$db_port/;
528    
529     # calculate command length
530     $cmdlen = length($cmd_str);
531     $cmdlenH = $cmdlen >> 8;
532     $cmdlenL = $cmdlen & 0xff;
533     $cmdlenH = sprintf "%.2x", $cmdlenH;
534     $cmdlenL = sprintf "%.2x", $cmdlenL;
535    
536     # calculate packet length
537     $packetlen = length($cmd_str) + $hdr_size;
538     $packetlenH = $packetlen >> 8;
539     $packetlenL = $packetlen & 0xff;
540     $packetlenH = sprintf "%.2x", $packetlenH;
541     $packetlenL = sprintf "%.2x", $packetlenL;
542     $cmd = hexify($cmd_str);
543    
544     # first 20 bytes is for tcp/ip I guess, next 38 bytes for tnslsnr and
545     # it's attached server programs.
546     # decimal offset
547     # 0: packetlen_high packetlen_low
548     # 25: cmdlen_high cmdlen_low
549     # 59: command
550     # the packet:
551     if ($mode eq "TCP") {
552     $bytes="\
553     $packetlenH $packetlenL 00 00 01 00 00 00 01 36 01 2c 00 00 08 00 \
554     7f ff 7f 08 00 00 00 01 $cmdlenH $cmdlenL 00 3a 00 00 00 00 \
555     00 00 00 00 00 00 00 00 00 00 00 00 34 e6 00 00 \
556     00 01 00 00 00 00 00 00 00 00 $cmd";
557     }
558     elsif ($mode eq "BEQ") {
559     $bytes="\
560     $cmdlenH $cmdlenL 00 00 $cmd";
561    
562     }
563     else { die "prepare_command: UNKNOWN MODE\n" }
564    
565     return $bytes;
566     }
567    
568     sub send_command {
569     my ($sock, $bytes) = @_;
570     my ($msg, $seqH, $seqL, $seq);
571    
572     $seqH = $SEQ >> 8;
573     $seqL = $SEQ & 0xff;
574     $seqH = sprintf "%.2x", $seqH;
575     $seqL = sprintf "%.2x", $seqL;
576     $seq = "$seqH $seqL";
577    
578     $bytes =~ s/\$seq/$seq/g; # jhjh - 5/24/2004
579    
580     @n = split(" ", $bytes);
581     $packetlen = @n;
582     $count = 0;
583    
584     logmsg \*LOG, "\nwriting $packetlen bytes\n";
585    
586     while (@n) {
587     $count++;
588     $n = shift @n;
589     if (length($n) == 2) {
590     chomp $n;
591     print $sock chr(hex($n));
592     $msg .= chr(hex($n));
593     }
594     else { print "lost [$bytes]\n" }
595     }
596    
597     print "\n|", strings($msg) ? strings($msg) : "", "|\n";
598    
599     logmsg \*LOG, "\nMessage checksum is %x\n", checksum($msg);
600    
601     $count != $packetlen && print "Error: bytes sent != packet length\n";
602     }
603    
604     sub checksum {
605     my $msg = shift;
606     my $checksum = unpack("%C*", $msg);
607     $checksum %= 65535;
608     return $checksum;
609     }
610    
611     sub send_reply {
612    
613     logmsg \*LOG, "\nCONTEXT = $CONTEXT\n"; # jhjh
614    
615     my ($socket, $msg) = @_;
616     my ($text_msg, $bytes);
617    
618     $text_msg = strings($msg);
619    
620     if ($text_msg) { print "\ngot $text_msg from Client" }
621    
622     $reply = lookup_command($REP_LOOKUP_FILE, get_request_type($msg) );
623    
624     # Disconnect
625     if ( $CURR_CMD eq "DISCONNECT") {
626     close($socket);
627     exit(0);
628     }
629    
630     # Handshakes
631     if ( $CONTEXT eq "HANDSHAKE" ) {
632     if ( $CURR_CMD eq "DESC_COLS" ) {
633     $CURR_CMD = "ORA_BANNER";
634     $reply = lookup_command($REP_LOOKUP_FILE, $CURR_CMD );
635     }
636     elsif ( $CURR_CMD eq "FETCH" ) {
637     $CURR_CMD = "USER_HS1";
638     $reply = lookup_command($REP_LOOKUP_FILE, $CURR_CMD );
639     }
640     elsif ( $CURR_CMD eq "FETCH_MORE" ) {
641     $CURR_CMD = "USER_HS2";
642     $reply = lookup_command($REP_LOOKUP_FILE, $CURR_CMD );
643     }
644     else { }
645     }
646    
647     # Query
648     if ( $CURR_CMD eq "QUERY") { # $CURR_CMD populated in get_request_type()
649     if ( $text_msg =~ /SQLCQR_LOGINCHECK/i ||
650     $text_msg =~ /BANNER/i ||
651     $text_msg =~ /ACCESSIBLE_TABLES/i ) {
652     $CURR_CMD = "SESSION";
653     $reply = lookup_command($REP_LOOKUP_FILE, $CURR_CMD );
654     }
655     else {
656     $CONTEXT = "QUERY";
657     $ROW_CNT = 0;
658    
659     logmsg \*LOG, "calling get_query\n"; # jhjh
660     $QUERY = get_query($msg);
661     logmsg \*LOG, "Query is: $QUERY\n"; # jhjh
662    
663     }
664     }
665    
666     # Query Follow-up
667     if ($CONTEXT eq "QUERY") {
668     if ( $CURR_CMD eq "DESC_COLS" ||
669     $CURR_CMD eq "FETCH" ||
670     $CURR_CMD eq "FETCH_MORE" ) {
671    
672     if ( $CURR_CMD eq "DESC_COLS" ) {
673     # pass query to obj_srvr
674     do_query($QUERY, $socket); # populates @QUERY_RESULT
675     }
676    
677     $reply = prepare_ora_reply(\@QUERY_RESULT, $CURR_CMD);
678     # note: prepare_ora_reply removes data from @QUERY_RESULT as it
679     # prepares it. (It may take many fetch/reply's to return all
680     # the data in @QUERY_RESULT. Some or all of an array element
681     # (a record) may be returned and removed.)
682     }
683     }
684    
685     # Send Reply
686     if ($reply) {
687     $reply =~ s/\s+/ /sg; # clean up for display (and for send)
688     $reply = uc($reply);
689    
690     print "Sending the following to Client: $reply";
691     $SEQ++;
692     send_command($socket, $reply);
693     logmsg \*LOG, "$reply\n";
694    
695     # send ora_err packet after user_hs1 packet
696     if ($CURR_CMD eq "USER_HS1") {
697     $reply = lookup_command($REP_LOOKUP_FILE, "SESSION_ORAERR" );
698     $reply =~ s/\s+/ /sg; # clean up for display
699     $reply = uc($reply);
700     print "Sending the following to Client: $reply";
701     $SEQ++;
702     send_command($socket, $reply);
703     logmsg \*LOG, "$reply\n";
704     }
705     }
706     }
707    
708     sub get_request_type {
709     my $msg = shift;
710    
711     my ($id_byte1, $id_byte2, $body, $pckt_type, $logmsg, $lenH, $lenL);
712    
713     ($lenH, $lenL, $TNS_TYPE, $id_byte1, $id_byte2) =
714     unpack("C C x2 C x5 C C", $msg);
715    
716     if ( defined($id_byte1) && defined($id_byte2) &&
717     # jhjh !! make sure we want this
718     $lenL != 0x00 && $lenH != 0x0b ) { # in case short messages
719     # concatenated by read
720    
721     $logmsg = sprintf("\nPACKET RECEIVED: TNS_TYPE = $TNS_TYPE, byte 11 = %x, byte 12 = %x\n",
722     $id_byte1, $id_byte2);
723     logmsg \*LOG, $logmsg;
724    
725     $pckt_type = $ora_pckt_types{$id_byte1}->{$id_byte2};
726    
727     $CURR_CMD = $pckt_type;
728    
729     return $pckt_type;
730     }
731     else {
732     logmsg \*LOG, "\nSHORT PACKET RECEIVED\n"; # jhjh
733     $CURR_CMD = "SHORT_PACKET";
734     if ( $id_byte1 == 0x01 ) { return "BREAK" }
735     if ( $id_byte1 == 0x02 ) { return "RESET" }
736     }
737    
738     # fall-through
739     return "UNKNOWN";
740     }
741    
742     sub read_config_files {
743    
744     $/ = ";";
745    
746     open(IN, "<$CMD_LOOKUP_FILE") || die "$!: cannot open $CMD_LOOKUP_FILE for reading";
747    
748     while ( <IN> ) {
749     chomp;
750    
751     /:/ || next;
752    
753     ($fld1, $fld2) = split(/:/, $_);
754    
755     $fld1 =~ s/^\s*//g;
756     $fld1 =~ s/\s*$//g;
757     $fld2 =~ s/^\s*//g;
758     $fld2 =~ s/\s*$//g;
759    
760     $tns_cmds{$fld1} = $fld2;
761     }
762    
763     close(IN);
764    
765     open(IN, "<$REP_LOOKUP_FILE") || die "$!: cannot open $REP_LOOKUP_FILE for reading";
766    
767     while ( <IN> ) {
768     chomp;
769    
770     /:/ || next;
771    
772     ($fld1, $fld2) = split(/:/, $_);
773    
774     $fld1 =~ s/^\s*//g;
775     $fld1 =~ s/\s*$//g;
776     $fld2 =~ s/^\s*//g;
777     $fld2 =~ s/\s*$//g;
778    
779     $tns_replies{$fld1} = $fld2;
780     }
781    
782     close(IN);
783    
784     $/ = "\n";
785     }
786    
787     sub unix_line255 {
788    
789     my $str = shift;
790    
791     my ($pos, $space_pos, $str_254, $new_str);
792    
793     for ( $pos = 0; !defined($str_254) || $pos <= length($str); $pos += 254 ) {
794    
795     $str_254 = substr($str, $pos, 254);
796    
797     $space_pos = rindex($str_254, " ");
798    
799     if ($space_pos != -1) {
800    
801     substr($str_254, $space_pos, 1) = "\n";
802     }
803    
804     $new_str .= $str_254;
805     }
806    
807     return $new_str;
808     }
809    
810    
811     sub strings {
812     my $msg = shift;
813    
814     my ($count, $byte, $string);
815    
816     $count = 0;
817    
818     while ( ($byte) = unpack("x$count C", $msg) ) {
819    
820     $count++;
821    
822     if ( $byte >= 32 && $byte <= 126 ) {
823     $string .= chr($byte);
824     }
825     }
826    
827     return $string;
828     }
829    
830     sub get_query {
831    
832     my $msg = shift;
833    
834     my ($len, $query, $skip);
835    
836     # the real DB's version of oracle sends sql in 64-byte blocks preceded
837     # by a length-byte.
838     $skip = 23;
839     $len = unpack("x$skip C", $msg); $skip++;
840     logmsg \*LOG, "first \$len is $len\n"; # jhjh
841    
842     while ( $len == 64 ) {
843     $query .= unpack("x$skip Z$len", $msg);
844     $skip += $len;
845     $len = unpack("x$skip C", $msg); $skip++;
846     logmsg \*LOG, "\$len is $len, \$query is $query\n"; # jhjh
847     }
848     $query .= unpack("x$skip Z$len", $msg); # get partial block at end
849    
850     logmsg \*LOG, "\$query is $query\n"; # jhjh
851    
852     return unix_line255($query . ";");
853    
854     }
855    
856     sub do_query {
857    
858     my ($query, $socket) = @_;
859    
860     my ($buf, $c, $i, $record, $last_part_of_rec);
861    
862     print Obj_Srvr "sql\n";
863    
864     print "\nsent sql mode request to Obj_Srvr\n"; # jhjh
865    
866     $last_part_of_rec = "";
867    
868     REPLY_LOOP:
869     while ( sysread(\*Obj_Srvr, $buf, $MAX_LINESIZE) ) {
870    
871     # sysread will pull in whatever's there, doesn't care where \n is;
872     # so we need to break $buf into records delimited by \n.
873    
874     $record = $last_part_of_rec;
875    
876     for ($i = 0; $i < length($buf); $i++) {
877    
878     $c = substr($buf, $i, 1);
879    
880     if ( $c eq "\n" ) {
881    
882     logmsg \*LOG, "$record\n";
883     print "\nReading from Obj_Srvr: got $record\n"; # jhjh
884    
885     if ( $record =~ /^QUIT$/ ) {
886     logmsg \*LOG, "sending disconnect to client\n";
887     send_command($socket, $LOGOUT_BYTES);
888     close($socket);
889     exit(0);
890     }
891    
892     if ( $record =~ /^SQL> $/ ) {
893     print "\nGot SQL > Prompt from Obj_Srvr\n"; # jhjh
894     print Obj_Srvr "$query\n";
895     }
896    
897     $record =~ s/^\s+//g;
898     $record =~ s/\s+$//g;
899     if ($record &&
900     $record !~ /rows returned/ &&
901     $record !~ /^SQL>$/ ) {
902     push @QUERY_RESULT, $record;
903     }
904    
905     last REPLY_LOOP
906     if ($record && $record =~ /^\d+\s+rows returned$/ );
907    
908     # fall-through
909     $last_part_of_rec = "";
910     $record = "";
911     }
912     else { $record .= $c }
913    
914     } # for loop
915    
916     $last_part_of_rec = $record; # maybe didn't get a '\n', or
917     # didn't end on a '\n'
918     }
919     }
920    
921     sub prepare_ora_reply {
922    
923     my ($ra_query_result, $cmd) = @_;
924    
925     my ($bytes, @bytes, $pckt_len, $replenH, $replenL);
926    
927     $bytes = get_reply_data($ra_query_result, $cmd);
928    
929     @bytes = split(" ", $bytes);
930    
931     $pckt_len = @bytes;
932     $pckt_len += 2;
933     $replenH = $pckt_len >> 8;
934     $replenL = $pckt_len & 0xff;
935     $replenH = sprintf "%.2x", $replenH;
936     $replenL = sprintf "%.2x", $replenL;
937    
938     $bytes = "$replenH $replenL" . $bytes;
939    
940     return $bytes;
941     }
942    
943     sub get_reply_data {
944     my ($ra_query_result, $cmd) = @_;
945    
946     my ($bytes, @bytes, $len, $lenH, $lenL, $footer, $col_desc, $row_cntH,
947     $row_cnt_bytes, $row_cnt_bytes_str, $low_bytes, $row_cnt_str,
948     $col_size, $rec_cnt, @columns, $col_name, $col_names, $packet_size,
949     $record, $col_data, $save_len, $seqH, $seqL);
950    
951     if ( $cmd eq "DESC_COLS" ) {
952    
953     # obj_srvr returns column data delimited by '|'
954     @columns = split /\|/, shift @QUERY_RESULT;
955     $NUM_COLS = @columns;
956     $NUM_COLS = sprintf("%.2x", $NUM_COLS);
957    
958     $bytes = " 00 00 06 00 00 00 00 00 08 $NUM_COLS 00 $NUM_COLS";
959    
960     $col_names = "";
961    
962     COL_DESC_LOOP:
963     while ( $col_desc = shift @columns ) {
964     print "\ncol_desc = $col_desc\n"; # jhjh
965     $save_len = length($bytes); # so we can roll back to this
966     # if we exceed packet length
967    
968     ($col_name, $col_size) = split /:/, $col_desc;
969    
970     $lenH = $col_size >> 8;
971     $lenL = $col_size & 0xff;
972     $lenH = sprintf "%.2x", $lenH;
973     $lenL = sprintf "%.2x", $lenL;
974    
975     # jhjh 02 at byte 3 might mean number; 80 must mean varchar2.
976    
977     # size of column in DB is held in $lenH $lenL
978     if ( $BI_QUERY_VERSION eq '60' ) {
979     $bytes .= "
980     00 01 80 00 $lenH $lenL 00 00 00 00 00 00 00 00 00 00
981     00 00 00 00 00 00 00 01 00 01 00 0C 00 00 00 00
982     00 00 00 00 00 00 00";
983     }
984     elsif ( $BI_QUERY_VERSION eq '70' ) {
985     $bytes .= "
986     00 01 80 00 $lenH $lenL 00 00 00 00 00 00 00 00 00 00
987     00 00 00 00 00 00 00 01 00 01 $lenL 00 00 00 00 0C
988     00 00 00 00 00 00 00 00 00 00 00";
989     }
990    
991    
992     # ($bytes keeps growing due to ".=" above - check size)
993     @bytes = split(" ", $bytes);
994     $packet_size = @bytes; $packet_size += length($col_names) +
995     length($col_name) + 1 + 4;
996     # add in missing first two
997     # bytes + extra two at end
998    
999     if ( $packet_size > $MAX_PACKETSIZE ) {
1000     $bytes = substr($bytes, 0, $save_len - 1);
1001     last COL_DESC_LOOP;
1002     # jhjh - Need to see what the drill is if you can't send
1003     # the whole col desc in a single packet. Does the client
1004     # send another request, or do you send another packet
1005     # unprompted?
1006     }
1007    
1008     $col_names .= $col_name . "\"";
1009     }
1010    
1011     $col_names = hexify($col_names);
1012    
1013     @bytes = split(" ", $col_names);
1014     $len = @bytes;
1015     $lenH = $len >> 8;
1016     $lenL = $len & 0xff;
1017     $lenH = sprintf "%.2x", $lenH;
1018     $lenL = sprintf "%.2x", $lenL;
1019    
1020     # length of column names string is held in $lenH $lenL
1021     $bytes .= " $lenH $lenL $lenH $lenL $col_names 09";
1022     if ( $BI_QUERY_VERSION eq '70' ) { $bytes .= " 05 00 00 00" }
1023    
1024     # in case we couldn't send whole record
1025     $record = "";
1026     foreach $col_desc (@columns) {
1027     $record .= $col_desc . "|";
1028     }
1029    
1030     if (@columns) {
1031     $record =~ s/\|$//;
1032     unshift @QUERY_RESULT, $record; # save cols-to-send
1033     # on @QUERY_RESULT
1034     }
1035    
1036     else {
1037     shift @QUERY_RESULT; # throw away column header line
1038     $RECORD_CNT = @QUERY_RESULT;
1039     }
1040     } # if ( $cmd eq "DESC_COLS" )
1041    
1042     else {
1043    
1044     $ROW_CNT++;
1045    
1046     $seqH = $SEQ >> 8;
1047     $seqL = $SEQ & 0xff;
1048     $seqH = sprintf "%.2x", $seqH;
1049     $seqL = sprintf "%.2x", $seqL;
1050    
1051    
1052     if ( $ROW_CNT == 1 ) {
1053    
1054     if ( $BI_QUERY_VERSION eq '60' ) {
1055     $row_cnt_bytes = 13; # just to make packet size calculation
1056     # below come out right
1057     # jhjh - does not handle more than FF FF FF FF rows since
1058     # byte 13 = 04
1059     $footer = " 00 08 02 00 00 00 00 00 00 00 00 40 04 01 00 00
1060     00 00 00 00 00 00 00 01 00 00 00 03 00 20 00 00
1061     00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
1062     00 00 $seqH $seqL 00 00 01 00 00 00 00 00 00 00 00 00
1063     00";
1064     }
1065     elsif ( $BI_QUERY_VERSION eq '70' ) {
1066     $row_cnt_bytes = 12; # just to make packet size calculation
1067     # below come out right
1068     # jhjh - does not handle more than FF FF FF FF rows since
1069     # byte 12 = 04
1070    
1071     $footer = " 00 08 02 00 00 00 00 00 00 00 00 40 04 05 00 00
1072     00 01 00 00 00 00 00 00 00 00 00 01 00 00 00 03
1073     00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
1074     00 00 00 00 00 00 $seqH $seqL 00 00 01 00 00 00 00 00
1075     00 00 00 00 00 00 00 00 00 00 00 00";
1076     }
1077     }
1078     else {
1079    
1080     $row_cnt_bytes = (sprintf "%d", log($ROW_CNT) / log(256) ) + 1;
1081     $low_bytes = $row_cnt_bytes - 1;
1082    
1083     $row_cntH = $ROW_CNT; $row_cnt_str = "";
1084     # get high byte
1085     while ( $low_bytes >= 0 ) {
1086    
1087     $row_cntH >>= (8 * $low_bytes);
1088    
1089     # prefix it (followed by a space) to $row_cnt_str
1090     $row_cnt_str = (sprintf " %.2x", $row_cntH) . $row_cnt_str;
1091    
1092     # get rid of high byte that we just prefixed to $row_cnt_str
1093     $row_cntH = $ROW_CNT & ( (256 ** $low_bytes) - 1);
1094    
1095     $low_bytes--;
1096     }
1097    
1098     $row_cnt_bytes_str .= sprintf "%.2x", $row_cnt_bytes;
1099    
1100     # $row_cnt_str may be 1 or more space-delimited bytes
1101     for ( $row_cnt_bytes_str .. 04 ) { $row_cnt_str .= " 00" }
1102     $row_cnt_bytes_str = "04"; # this limits us to FF FF FF FF
1103     # (4,294,967,295) rows
1104    
1105     if ( $BI_QUERY_VERSION eq '60' ) {
1106     #$footer = " 00 $row_cnt_bytes_str $row_cnt_str
1107     # 00 00 00 00 00 00 01 00 00 00 03 00 20 00 00 00
1108     # 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
1109     # 00 $seqH $seqL 00 00 01 00 00 00 00 00 00 00";
1110    
1111     # jhjh - don't send row count until we figure out why the
1112     # client displays the last row twice.
1113     $footer = " 00 $row_cnt_bytes_str 00 00 00 00
1114     00 00 00 00 00 00 01 00 00 00 03 00 20 00 00 00
1115     00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
1116     00 $seqH $seqL 00 00 01 00 00 00 00 00 00 00";
1117     }
1118     elsif ( $BI_QUERY_VERSION eq '70' ) {
1119     # jhjh - don't send row count until we figure out why the
1120     # client displays the last row twice.
1121     $footer = "
1122     00 $row_cnt_bytes_str 05 00 00 00 02 00 00 00 00 00 00 00 00 00
1123     01 00 00 00 03 00 00 00 00 00 00 00 00 00 00 00
1124     00 00 00 00 00 00 00 00 00 00 00 $seqH $seqL 00 00 01
1125     00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
1126     00";
1127     }
1128     }
1129    
1130     if ($ROW_CNT > $RECORD_CNT ) { # all data returned
1131    
1132     # NO DATA FOUND
1133     if ( $BI_QUERY_VERSION eq '60' ) {
1134     # 05 7B = 01403 (Oracle error code for no data found):
1135     # this is in bytes 14 and 15 (low byte first)
1136     return " 00 00 06 00 00 00 00 00 04 00 00 00 00 7B 05 00
1137     00 00 00 01 00 00 00 03 00 40 00 00 00 00 00 00
1138     00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 32
1139     00 00 01 00 00 00 19 4F 52 41 2D 30 31 34 30 33
1140     3A 20 6E 6F 20 64 61 74 61 20 66 6F 75 6E 64 0A";
1141     }
1142    
1143     elsif ( $BI_QUERY_VERSION eq '70' ) {
1144     # 05 7B = 01403 (Oracle error code for no data found):
1145     # this is in bytes 18 and 19 (low byte first)
1146     return " 00 00 06 00 00 00 00 00 04 05 00 00 00 01 00 00
1147     00 7B 05 00 00 00 00 01 00 00 00 03 00 00 00 00
1148     00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
1149     00 00 00 29 00 00 01 00 00 00 00 00 00 00 00 00
1150     00 00 00 00 00 00 00 00 19 4F 52 41 2D 30 31 34
1151     30 33 3A 20 6E 6F 20 64 61 74 61 20 66 6F 75 6E
1152     64 0A";
1153     }
1154     }
1155    
1156     # fall-through
1157    
1158     if ( $BI_QUERY_VERSION eq '60' ) {
1159     $bytes = " 00 00 06 00 00 00 00 00 06 02 00 00 00 00 01 00
1160     00 00 07";
1161     # " 00 00 06 00 00 00 00 00 06 02 02 00 00 00 01 00
1162     # 00 00 07";
1163     }
1164    
1165     elsif ( $BI_QUERY_VERSION eq '70' ) {
1166     $bytes = " 00 00 06 00 00 00 00 00 06 02 04 00 00 00 01 00
1167     00 00 00 00 00 00 00 00 00 00 07";
1168     }
1169    
1170     @columns = split /\|/, shift @QUERY_RESULT, -1;
1171     # keep trailing nulls
1172    
1173     COL_DATA_LOOP:
1174     while (defined($col_data = shift @columns) ) {
1175    
1176     # handle null values
1177     if (!$col_data and
1178     $col_data ne 0) {
1179    
1180     $lenL = sprintf "%.2x", 2;
1181    
1182     # hex 05 7D = 1405: Oracle error code for "fetched column
1183     # value is NULL"
1184     $col_data = hexify( chr(0x05) . chr(0x7D) );
1185     }
1186     else {
1187     $len = length($col_data);
1188     $lenH = $len >> 8;
1189     $lenL = $len & 0xff;
1190     $lenH = sprintf "%.2x", $lenH;
1191     $lenL = sprintf "%.2x", $lenL;
1192    
1193     $save_len = length($bytes);
1194    
1195     $col_data = hexify($col_data);
1196     }
1197    
1198     # length of column data is held in $lenL (where is lenH?)
1199     # (I guess lenH could be the second "00" below, but the very
1200     # first field doesn't have a place for this in the packets
1201     # I've seen in the log file.)
1202     $bytes .= " $lenL $col_data 00 00";
1203    
1204     @bytes = split(" ", $bytes);
1205     $packet_size = @bytes; $packet_size += (50 + $row_cnt_bytes);
1206     # add in footer size plus
1207     # missing first two bytes
1208    
1209     if ( $packet_size > $MAX_PACKETSIZE ) {
1210     $bytes = substr($bytes, 0, $save_len - 1);
1211     last COL_DATA_LOOP;
1212     }
1213     }
1214    
1215     $bytes = substr($bytes, 0, length($bytes) - 3); # remove last "00"
1216     $bytes .= "$footer";
1217    
1218     # in case we couldn't send whole record
1219     $record = "";
1220     foreach $col_data (@columns) {
1221     $record .= $col_data . "|";
1222     }
1223     if (@columns) {
1224     $record =~ s/\|$//;
1225     unshift @QUERY_RESULT, $record;
1226     $ROW_CNT--;
1227     }
1228     }
1229    
1230     return $bytes;
1231     }
1232    
1233     sub logged_in {
1234     my ($state, $bytes) = @_;
1235    
1236     my ($req_type);
1237    
1238     if ($state eq "USER_PASSWD") {
1239     logmsg \*LOG, "state = USER_PASSWD\n";
1240     $req_type = get_request_type($bytes);
1241    
1242     if ( $req_type =~ /ACK|ACK70/ ) {
1243    
1244     if ($req_type eq "ACK70") {
1245     $GOOD_LOGIN_ACK = $GOOD_LOGIN_ACK70;
1246     $BI_QUERY_VERSION = '70';
1247     }
1248    
1249     logmsg \*LOG, "state = USER_PASSWD, getting ACK\n";
1250     logmsg \*LOG, hexdump($bytes), "\n";
1251     logmsg \*LOG, $GOOD_LOGIN_ACK, "\n";
1252    
1253     if ( hexdump($bytes) eq $GOOD_LOGIN_ACK ) {
1254     logmsg \*LOG, "GOOD_LOGIN";
1255     return 1;
1256     }
1257     else {
1258     logmsg \*LOG, "BAD_LOGIN";
1259     $BAD_LOGIN = 1;
1260     }
1261     }
1262     }
1263    
1264     # fall-through
1265     return 0;
1266     }
1267    
1268     sub handshake_done {
1269     my $bytes = shift;
1270    
1271     if ( strings($bytes) =~ /alter session set NLS_DATE_FORMAT/i ) {
1272     return 1;
1273     }
1274    
1275     # fall-through
1276     return 0;
1277     }
1278    
1279     sub obj_srvr_user {
1280     my $real_db = shift;
1281    
1282     my ($qry_hdr, $len, $lenH, $lenL, $qry_len_plus_1, $qry_hex, $bytes,
1283     $valid_obj_srvr_user);
1284    
1285     $qry_len_plus_1 = length($OBJ_SRVR_USER_QRY) + 1;
1286     # header is 23
1287     $len = 23 + $qry_len_plus_1; # plus 1 for linefeed on the end
1288    
1289     $lenH = $len >> 8;
1290     $lenL = $len & 0xff;
1291    
1292     # now "hex format" the lengths
1293     $qry_len_plus_1 = sprintf "%.2x", $qry_len_plus_1;
1294     $lenH = sprintf "%.2x", $lenH;
1295     $lenL = sprintf "%.2x", $lenL;
1296    
1297     # has 23 bytes
1298     $qry_hdr = "$lenH $lenL 00 00 06 00 00 00 00 00 03 03 13 01 00 00
1299     00 01 40 00 00 00 $qry_len_plus_1";
1300    
1301     $qry_hex = $qry_hdr . " " . hexify($OBJ_SRVR_USER_QRY) . " 0a";
1302    
1303     # =======================================================================
1304     # Send a sequence of commands in order to send $qry_hex and get results
1305     # =======================================================================
1306     send_command($real_db, lookup_command($REP_LOOKUP_FILE, "HANDSHAKE7_2_CMD") );
1307     sysread($real_db, $bytes, $MAX_LINESIZE) or return 0; # get ACK
1308     logmsg \*LOG, "DB, for HANDSHAKE7_2_CMD: $bytes\n";
1309    
1310     send_command($real_db, lookup_command($REP_LOOKUP_FILE, "HANDSHAKE7_CMD") );
1311     sysread($real_db, $bytes, $MAX_LINESIZE) or return 0; # get ACK
1312     logmsg \*LOG, "DB, for HANDSHAKE7_CMD: $bytes\n";
1313    
1314     send_command($real_db, lookup_command($REP_LOOKUP_FILE, "SQL_OPEN_CMD") );
1315     sysread($real_db, $bytes, $MAX_LINESIZE) or return 0; # get ACK
1316     logmsg \*LOG, "DB, for SQL_OPEN_CMD: $bytes\n";
1317    
1318     # send valid_user query
1319     send_command($real_db, $qry_hex);
1320     logmsg \*LOG, "$0: $qry_hex\n";
1321     sysread($real_db, $bytes, $MAX_LINESIZE) or return 0; # get ACK
1322     logmsg \*LOG, "DB, for Query: $bytes\n";
1323    
1324     send_command($real_db, lookup_command($REP_LOOKUP_FILE, "QUERY_SECOND_CMD") );
1325     sysread($real_db, $bytes, $MAX_LINESIZE) or return 0; # get ACK
1326     logmsg \*LOG, "DB, for QUERY_SECOND_CMD: $bytes\n";
1327    
1328     send_command($real_db, lookup_command($REP_LOOKUP_FILE, "DESC_COLS_CMD") );
1329     sysread($real_db, $bytes, $MAX_LINESIZE) or return 0; # get col desc
1330     logmsg \*LOG, "DB, for DESC_COLS_CMD: $bytes\n";
1331    
1332     if ($BI_QUERY_VERSION eq '60') {
1333     send_command($real_db, lookup_command($REP_LOOKUP_FILE, "FETCH_CMD") );
1334     }
1335     elsif ($BI_QUERY_VERSION eq '70') {
1336     send_command($real_db, lookup_command($REP_LOOKUP_FILE, "FETCH_CMD70") );
1337     }
1338    
1339     $valid_obj_srvr_user = 0;
1340    
1341     if ( sysread($real_db, $bytes, $MAX_LINESIZE) ) {
1342     logmsg \*LOG, "DB, for FETCH_CMD: $bytes\n";
1343    
1344     if (strings($bytes) =~ /valid_obj_srvr_user/i ) {
1345     $valid_obj_srvr_user = 1;
1346     }
1347    
1348     return $valid_obj_srvr_user;
1349    
1350     }
1351     }

  ViewVC Help
Powered by ViewVC 1.1.26