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 |
|
|
} |