~percona-toolkit-dev/percona-toolkit/fix-zombie-bug-919819 : revision 134

39

use strict;

40

use warnings FATAL => 'all';

41

use English qw(-no_match_vars);

42

use constant MKDEBUG => $ENV{MKDEBUG} || 0;

42

use constant PTDEBUG => $ENV{PTDEBUG} || 0;

43

44

eval {

45

require IO::Uncompress::Inflate;

238

o => $args{o},

239

fake_thread_id => 2**32, # see _make_event()

240

};

241

MKDEBUG && $self->{server} && _d('Watching only server', $self->{server});

241

PTDEBUG && $self->{server} && _d('Watching only server', $self->{server});

242

return bless $self, $class;

243

}

244

258

if ( my $server = $self->{server} ) { # Watch only the given server.

259

$server .= ":$self->{port}";

260

if ( $src_host ne $server && $dst_host ne $server ) {

261

MKDEBUG && _d('Packet is not to or from', $server);

261

PTDEBUG && _d('Packet is not to or from', $server);

262

return;

263

}

264

}

276

$client = $src_host;

277

}

278

else {

279

MKDEBUG && _d('Packet is not to or from a MySQL server');

279

PTDEBUG && _d('Packet is not to or from a MySQL server');

280

return;

281

}

282

MKDEBUG && _d('Client', $client);

282

PTDEBUG && _d('Client', $client);

283

284

# Get the client's session info or create a new session if

285

# we catch the TCP SYN sequence or the packetno is 0.

294

}

295

if ( !exists $self->{sessions}->{$client} ) {

296

if ( $packet->{syn} ) {

297

MKDEBUG && _d('New session (SYN)');

297

PTDEBUG && _d('New session (SYN)');

298

}

299

elsif ( $packetno == 0 ) {

300

MKDEBUG && _d('New session (packetno 0)');

300

PTDEBUG && _d('New session (packetno 0)');

301

}

302

else {

303

MKDEBUG && _d('Ignoring mid-stream', $packet_from, 'data,',

303

PTDEBUG && _d('Ignoring mid-stream', $packet_from, 'data,',

304

'packetno', $packetno);

305

return;

306

}

318

};

319

}

320

my $session = $self->{sessions}->{$client};

321

MKDEBUG && _d('Client state:', $session->{state});

321

PTDEBUG && _d('Client state:', $session->{state});

322

323

# Save raw packets to dump later in case something fails.

324

push @{$session->{raw_packets}}, $packet->{raw_packet};

326

# Check client port reuse.

327

# http://code.google.com/p/maatkit/issues/detail?id=794

328

if ( $packet->{syn} && ($session->{n_queries} > 0 || $session->{state}) ) {

329

MKDEBUG && _d('Client port reuse and last session did not quit');

329

PTDEBUG && _d('Client port reuse and last session did not quit');

330

# Fail the session so we can see the last thing the previous

331

# session was doing.

332

$self->fail_session($session,

338

# Return early if there's no TCP/MySQL data. These are usually

339

# TCP control packets: SYN, ACK, FIN, etc.

340

if ( $packet->{data_len} == 0 ) {

341

MKDEBUG && _d('TCP control:',

341

PTDEBUG && _d('TCP control:',

342

map { uc $_ } grep { $packet->{$_} } qw(syn ack fin rst));

343

return;

344

}

364

$packet->{mysql_data_len} = $session->{mysql_data_len};

365

$packet->{number} = $session->{number};

366

367

MKDEBUG && _d('Appending data to buff; expecting',

367

PTDEBUG && _d('Appending data to buff; expecting',

368

$session->{buff_left}, 'more bytes');

369

}

370

else {

376

remove_mysql_header($packet);

377

};

378

if ( $EVAL_ERROR ) {

379

MKDEBUG && _d('remove_mysql_header() failed; failing session');

379

PTDEBUG && _d('remove_mysql_header() failed; failing session');

380

$session->{EVAL_ERROR} = $EVAL_ERROR;

381

$self->fail_session($session, 'remove_mysql_header() failed');

382

return;

392

elsif ( $packet_from eq 'client' ) {

393

if ( $session->{buff} ) {

394

if ( $session->{buff_left} <= 0 ) {

395

MKDEBUG && _d('Data is complete');

395

PTDEBUG && _d('Data is complete');

396

$self->_delete_buff($session);

397

}

398

else {

403

404

# http://code.google.com/p/maatkit/issues/detail?id=832

405

if ( $session->{cmd} && ($session->{state} || '') eq 'awaiting_reply' ) {

406

MKDEBUG && _d('No server OK to previous command (frag)');

406

PTDEBUG && _d('No server OK to previous command (frag)');

407

$self->fail_session($session, 'no server OK to previous command');

408

# The MySQL header is removed by this point, so put it back.

409

$packet->{data} = $packet->{mysql_hdr} . $packet->{data};

422

$session->{buff_left}

423

||= $packet->{mysql_data_len} - ($packet->{data_len} - 4);

424

425

MKDEBUG && _d('Data not complete; expecting',

425

PTDEBUG && _d('Data not complete; expecting',

426

$session->{buff_left}, 'more bytes');

427

return;

428

}

434

# query, chances are we missed the server's OK response to the

435

# first query. So fail the first query and re-parse this second

436

# query.

437

MKDEBUG && _d('No server OK to previous command');

437

PTDEBUG && _d('No server OK to previous command');

438

$self->fail_session($session, 'no server OK to previous command');

439

# The MySQL header is removed by this point, so put it back.

440

$packet->{data} = $packet->{mysql_hdr} . $packet->{data};

448

die 'Packet origin unknown';

449

}

450

451

MKDEBUG && _d('Done parsing packet; client state:', $session->{state});

451

PTDEBUG && _d('Done parsing packet; client state:', $session->{state});

452

if ( $session->{closed} ) {

453

delete $self->{sessions}->{$session->{client}};

454

MKDEBUG && _d('Session deleted');

454

PTDEBUG && _d('Session deleted');

455

}

456

457

$args{stats}->{events_parsed}++ if $args{stats};

470

die "I need a packet" unless $packet;

471

die "I need a session" unless $session;

472

473

MKDEBUG && _d('Packet is from server; client state:', $session->{state});

473

PTDEBUG && _d('Packet is from server; client state:', $session->{state});

474

475

if ( ($session->{server_seq} || '') eq $packet->{seq} ) {

476

push @{ $session->{server_retransmissions} }, $packet->{seq};

477

MKDEBUG && _d('TCP retransmission');

477

PTDEBUG && _d('TCP retransmission');

478

return;

479

}

480

$session->{server_seq} = $packet->{seq};

488

# be a result set header, field, row data, etc.

489

490

my ( $first_byte ) = substr($data, 0, 2, '');

491

MKDEBUG && _d('First byte of packet:', $first_byte);

491

PTDEBUG && _d('First byte of packet:', $first_byte);

492

if ( !$first_byte ) {

493

$self->fail_session($session, 'no first byte');

494

return;

522

return;

523

}

524

else {

525

MKDEBUG && _d('Ignoring mid-stream server response');

525

PTDEBUG && _d('Ignoring mid-stream server response');

526

return;

527

}

528

}

533

534

$session->{compress} = $session->{will_compress};

535

delete $session->{will_compress};

536

MKDEBUG && $session->{compress} && _d('Packets will be compressed');

536

PTDEBUG && $session->{compress} && _d('Packets will be compressed');

537

538

MKDEBUG && _d('Admin command: Connect');

538

PTDEBUG && _d('Admin command: Connect');

539

return $self->_make_event(

540

{ cmd => 'Admin',

541

arg => 'administrator command: Connect',

550

my $com = $session->{cmd}->{cmd};

551

my $ok;

552

if ( $com eq COM_STMT_PREPARE ) {

553

MKDEBUG && _d('OK for prepared statement');

553

PTDEBUG && _d('OK for prepared statement');

554

$ok = parse_ok_prepared_statement_packet($data);

555

if ( !$ok ) {

556

$self->fail_session($session,

601

);

602

}

603

else {

604

MKDEBUG && _d('Looks like an OK packet but session has no cmd');

604

PTDEBUG && _d('Looks like an OK packet but session has no cmd');

605

}

606

}

607

elsif ( $first_byte eq 'ff' ) {

613

my $event;

614

615

if ( $session->{state} eq 'client_auth' ) {

616

MKDEBUG && _d('Connection failed');

616

PTDEBUG && _d('Connection failed');

617

$event = {

618

cmd => 'Admin',

619

arg => 'administrator command: Connect',

650

return $self->_make_event($event, $packet, $session);

651

}

652

else {

653

MKDEBUG && _d('Looks like an error packet but client is not '

653

PTDEBUG && _d('Looks like an error packet but client is not '

654

. 'authenticating and session has no cmd');

655

}

656

}

660

&& $session->{state} eq 'client_auth'

661

&& $packet->{number} == 2 )

662

{

663

MKDEBUG && _d('Server has old password table;',

663

PTDEBUG && _d('Server has old password table;',

664

'client will resend password using old algorithm');

665

$session->{state} = 'client_auth_resend';

666

}

667

else {

668

MKDEBUG && _d('Got an EOF packet');

668

PTDEBUG && _d('Got an EOF packet');

669

$self->fail_session($session, 'got an unexpected EOF packet');

670

# ^^^ We shouldn't reach this because EOF should come after a

671

# header, field, or row data packet; and we should be firing the

680

# is not done. This means we will NOT process EOF packets

681

# themselves (see above).

682

if ( $session->{cmd} ) {

683

MKDEBUG && _d('Got a row/field/result packet');

683

PTDEBUG && _d('Got a row/field/result packet');

684

my $com = $session->{cmd}->{cmd};

685

MKDEBUG && _d('Responding to client', $com_for{$com});

685

PTDEBUG && _d('Responding to client', $com_for{$com});

686

my $event = { ts => $packet->{ts} };

687

if ( $com eq COM_QUERY || $com eq COM_STMT_EXECUTE ) {

688

$event->{cmd} = 'Query';

713

return $self->_make_event($event, $packet, $session);

714

}

715

else {

716

MKDEBUG && _d('Unknown in-stream server response');

716

PTDEBUG && _d('Unknown in-stream server response');

717

}

718

}

719

}

733

die "I need a packet" unless $packet;

734

die "I need a session" unless $session;

735

736

MKDEBUG && _d('Packet is from client; state:', $session->{state});

736

PTDEBUG && _d('Packet is from client; state:', $session->{state});

737

738

if ( ($session->{client_seq} || '') eq $packet->{seq} ) {

739

push @{ $session->{client_retransmissions} }, $packet->{seq};

740

MKDEBUG && _d('TCP retransmission');

740

PTDEBUG && _d('TCP retransmission');

741

return;

742

}

743

$session->{client_seq} = $packet->{seq};

746

my $ts = $packet->{ts};

747

748

if ( ($session->{state} || '') eq 'server_handshake' ) {

749

MKDEBUG && _d('Expecting client authentication packet');

749

PTDEBUG && _d('Expecting client authentication packet');

750

# The connection is a 3-way handshake:

751

# server > client (protocol version, thread id, etc.)

752

# client > server (user, pass, default db, etc.)

772

}

773

elsif ( ($session->{state} || '') eq 'client_auth_resend' ) {

774

# Don't know how to parse this packet.

775

MKDEBUG && _d('Client resending password using old algorithm');

775

PTDEBUG && _d('Client resending password using old algorithm');

776

$session->{state} = 'client_auth';

777

}

778

elsif ( ($session->{state} || '') eq 'awaiting_reply' ) {

779

my $arg = $session->{cmd}->{arg} ? substr($session->{cmd}->{arg}, 0, 50)

780

: 'unknown';

781

MKDEBUG && _d('More data for previous command:', $arg, '...');

781

PTDEBUG && _d('More data for previous command:', $arg, '...');

782

return;

783

}

784

else {

805

}

806

807

if ( $com->{code} eq COM_STMT_EXECUTE ) {

808

MKDEBUG && _d('Execute prepared statement');

808

PTDEBUG && _d('Execute prepared statement');

809

my $exec = parse_execute_packet($com->{data}, $session->{sths});

810

if ( !$exec ) {

811

# This does not signal a failure, it could just be that

812

# the statement handle ID is unknown.

813

MKDEBUG && _d('Failed to parse execute packet');

813

PTDEBUG && _d('Failed to parse execute packet');

814

$session->{state} = undef;

815

return;

816

}

837

};

838

839

if ( $com->{code} eq COM_QUIT ) { # Fire right away; will cleanup later.

840

MKDEBUG && _d('Got a COM_QUIT');

840

PTDEBUG && _d('Got a COM_QUIT');

841

842

# See http://code.google.com/p/maatkit/issues/detail?id=794

843

$session->{closed} = 1; # delete session when done

875

# Make and return an event from the given packet and session.

876

sub _make_event {

877

my ( $self, $event, $packet, $session ) = @_;

878

MKDEBUG && _d('Making event');

878

PTDEBUG && _d('Making event');

879

880

# Clear packets that preceded this event.

881

$session->{raw_packets} = [];

884

if ( !$session->{thread_id} ) {

885

# Only the server handshake packet gives the thread id, so for

886

# sessions caught mid-stream we assign a fake thread id.

887

MKDEBUG && _d('Giving session fake thread id', $self->{fake_thread_id});

887

PTDEBUG && _d('Giving session fake thread id', $self->{fake_thread_id});

888

$session->{thread_id} = $self->{fake_thread_id}++;

889

}

890

909

No_index_used => ($event->{No_index_used} ? 'Yes' : 'No'),

910

};

911

@{$new_event}{keys %{$session->{attribs}}} = values %{$session->{attribs}};

912

MKDEBUG && _d('Properties of event:', Dumper($new_event));

912

PTDEBUG && _d('Properties of event:', Dumper($new_event));

913

914

# Delete cmd to prevent re-making the same event if the

915

# server sends extra stuff that looks like a result set, etc.

1002

else {

1003

# This shouldn't happen, but it may if we're passed data

1004

# that isn't length encoded.

1005

MKDEBUG && _d('data:', $data, 'first byte:', $first_byte);

1005

PTDEBUG && _d('data:', $data, 'first byte:', $first_byte);

1006

die "Invalid length encoded byte: $first_byte";

1007

}

1008

1009

MKDEBUG && _d('len:', $len, 'encode len', $encode_len);

1009

PTDEBUG && _d('len:', $len, 'encode len', $encode_len);

1010

return $data, $len, $encode_len;

1011

}

1012

1063

sub parse_error_packet {

1064

my ( $data ) = @_;

1065

return unless $data;

1066

MKDEBUG && _d('ERROR data:', $data);

1066

PTDEBUG && _d('ERROR data:', $data);

1067

if ( length $data < 16 ) {

1068

MKDEBUG && _d('Error packet is too short:', $data);

1068

PTDEBUG && _d('Error packet is too short:', $data);

1069

return;

1070

}

1071

my $errno = to_num(substr($data, 0, 4));

1078

sqlstate => $marker . $sqlstate,

1079

message => $message,

1080

};

1081

MKDEBUG && _d('Error packet:', Dumper($pkt));

1081

PTDEBUG && _d('Error packet:', Dumper($pkt));

1082

return $pkt;

1083

}

1084

1095

sub parse_ok_packet {

1096

my ( $data ) = @_;

1097

return unless $data;

1098

MKDEBUG && _d('OK data:', $data);

1098

PTDEBUG && _d('OK data:', $data);

1099

if ( length $data < 12 ) {

1100

MKDEBUG && _d('OK packet is too short:', $data);

1100

PTDEBUG && _d('OK packet is too short:', $data);

1101

return;

1102

}

1103

my $affected_rows = get_lcb(\$data);

1114

warnings => $warnings,

1115

message => $message,

1116

};

1117

MKDEBUG && _d('OK packet:', Dumper($pkt));

1117

PTDEBUG && _d('OK packet:', Dumper($pkt));

1118

return $pkt;

1119

}

1120

1128

sub parse_ok_prepared_statement_packet {

1129

my ( $data ) = @_;

1130

return unless $data;

1131

MKDEBUG && _d('OK prepared statement data:', $data);

1131

PTDEBUG && _d('OK prepared statement data:', $data);

1132

if ( length $data < 8 ) {

1133

MKDEBUG && _d('OK prepared statement packet is too short:', $data);

1133

PTDEBUG && _d('OK prepared statement packet is too short:', $data);

1134

return;

1135

}

1136

my $sth_id = to_num(substr($data, 0, 8, ''));

1141

num_cols => $num_cols,

1142

num_params => $num_params,

1143

};

1144

MKDEBUG && _d('OK prepared packet:', Dumper($pkt));

1144

PTDEBUG && _d('OK prepared packet:', Dumper($pkt));

1145

return $pkt;

1146

}

1147

1149

sub parse_server_handshake_packet {

1150

my ( $data ) = @_;

1151

return unless $data;

1152

MKDEBUG && _d('Server handshake data:', $data);

1152

PTDEBUG && _d('Server handshake data:', $data);

1153

my $handshake_pattern = qr{

1154

# Bytes Name

1155

^ # ----- ----

1169

thread_id => to_num($thread_id),

1170

flags => parse_flags($flags),

1171

};

1172

MKDEBUG && _d('Server handshake packet:', Dumper($pkt));

1172

PTDEBUG && _d('Server handshake packet:', Dumper($pkt));

1173

return $pkt;

1174

}

1175

1177

sub parse_client_handshake_packet {

1178

my ( $data ) = @_;

1179

return unless $data;

1180

MKDEBUG && _d('Client handshake data:', $data);

1180

PTDEBUG && _d('Client handshake data:', $data);

1181

my ( $flags, $user, $buff_len ) = $data =~ m{

1182

^

1183

(.{8}) # Client flags

1191

# the server sends the client a packet first (its handshake) and

1192

# then the client only and ever sends back its handshake.

1193

if ( !$buff_len ) {

1194

MKDEBUG && _d('Did not match client handshake packet');

1194

PTDEBUG && _d('Did not match client handshake packet');

1195

return;

1196

}

1197

1208

db => $db ? to_string($db) : '',

1209

flags => parse_flags($flags),

1210

};

1211

MKDEBUG && _d('Client handshake packet:', Dumper($pkt));

1211

PTDEBUG && _d('Client handshake packet:', Dumper($pkt));

1212

return $pkt;

1213

}

1214

1217

sub parse_com_packet {

1218

my ( $data, $len ) = @_;

1219

return unless $data && $len;

1220

MKDEBUG && _d('COM data:',

1220

PTDEBUG && _d('COM data:',

1221

(substr($data, 0, 100).(length $data > 100 ? '...' : '')),

1222

'len:', $len);

1223

my $code = substr($data, 0, 2);

1224

my $com = $com_for{$code};

1225

if ( !$com ) {

1226

MKDEBUG && _d('Did not match COM packet');

1226

PTDEBUG && _d('Did not match COM packet');

1227

return;

1228

}

1229

if ( $code ne COM_STMT_EXECUTE

1240

com => $com,

1241

data => $data,

1242

};

1243

MKDEBUG && _d('COM packet:', Dumper($pkt));

1243

PTDEBUG && _d('COM packet:', Dumper($pkt));

1244

return $pkt;

1245

}

1246

1263

1264

my $sth = $sths->{$sth_id};

1265

if ( !$sth ) {

1266

MKDEBUG && _d('Skipping unknown statement handle', $sth_id);

1266

PTDEBUG && _d('Skipping unknown statement handle', $sth_id);

1267

return;

1268

}

1269

my $null_count = int(($sth->{num_params} + 7) / 8) || 1;

1270

my $null_bitmap = to_num(substr($data, 20, $null_count * 2));

1271

MKDEBUG && _d('NULL bitmap:', $null_bitmap, 'count:', $null_count);

1271

PTDEBUG && _d('NULL bitmap:', $null_bitmap, 'count:', $null_count);

1272

1273

# This chops off everything up to the byte for new params.

1274

substr($data, 0, 20 + ($null_count * 2), '');

1276

my $new_params = to_num(substr($data, 0, 2, ''));

1277

my @types;

1278

if ( $new_params ) {

1279

MKDEBUG && _d('New param types');

1279

PTDEBUG && _d('New param types');

1280

# It seems all params are type 254, MYSQL_TYPE_STRING. Perhaps

1281

# this depends on the client. If we ever need these types, they

1282

# can be saved here. Otherwise for now I just want to see the

1284

for my $i ( 0..($sth->{num_params}-1) ) {

1285

my $type = to_num(substr($data, 0, 4, ''));

1286

push @types, $type_for{$type};

1287

MKDEBUG && _d('Param', $i, 'type:', $type, $type_for{$type});

1287

PTDEBUG && _d('Param', $i, 'type:', $type, $type_for{$type});

1288

}

1289

$sth->{types} = \@types;

1290

}

1296

# $data should now be truncated up to the parameter values.

1297

1298

my $arg = $sth->{statement};

1299

MKDEBUG && _d('Statement:', $arg);

1299

PTDEBUG && _d('Statement:', $arg);

1300

for my $i ( 0..($sth->{num_params}-1) ) {

1301

my $val;

1302

my $len; # in bytes

1303

if ( $null_bitmap & (2**$i) ) {

1304

MKDEBUG && _d('Param', $i, 'is NULL (bitmap)');

1304

PTDEBUG && _d('Param', $i, 'is NULL (bitmap)');

1305

$val = 'NULL';

1306

$len = 0;

1307

}

1311

}

1312

else {

1313

# TODO: this is probably going to break parsing other param vals

1314

MKDEBUG && _d('No handler for param', $i, 'type', $types[$i]);

1314

PTDEBUG && _d('No handler for param', $i, 'type', $types[$i]);

1315

$val = '?';

1316

$len = 0;

1317

}

1318

}

1319

1320

# Replace ? in prepared statement with value.

1321

MKDEBUG && _d('Param', $i, 'val:', $val);

1321

PTDEBUG && _d('Param', $i, 'val:', $val);

1322

$arg =~ s/\?/$val/;

1323

1324

# Remove this param val from the data, putting us at the next one.

1329

sth_id => $sth_id,

1330

arg => "EXECUTE $arg",

1331

};

1332

MKDEBUG && _d('Execute packet:', Dumper($pkt));

1332

PTDEBUG && _d('Execute packet:', Dumper($pkt));

1333

return $pkt;

1334

}

1335

1343

sub parse_flags {

1344

my ( $flags ) = @_;

1345

die "I need flags" unless $flags;

1346

MKDEBUG && _d('Flag data:', $flags);

1346

PTDEBUG && _d('Flag data:', $flags);

1347

my %flags = %flag_for;

1348

my $flags_dec = to_num($flags);

1349

foreach my $flag ( keys %flag_for ) {

1361

die "I need data" unless $data;

1362

die "I need a len argument" unless $len;

1363

die "I need a scalar reference to data" unless ref $data eq 'SCALAR';

1364

MKDEBUG && _d('Uncompressing data');

1364

PTDEBUG && _d('Uncompressing data');

1365

our $InflateError;

1366

1367

# Pack hex string into compressed binary data.

1387

# (uncompress_packet() returns 0).

1388

sub detect_compression {

1389

my ( $self, $packet, $session ) = @_;

1390

MKDEBUG && _d('Checking for client compression');

1390

PTDEBUG && _d('Checking for client compression');

1391

# This is a necessary hack for detecting compression in-stream without

1392

# having seen the client handshake and CLIENT_COMPRESS flag. If the

1393

# client is compressing packets, there will be an extra 7 bytes before

1398

# compression.

1399

my $com = parse_com_packet($packet->{data}, $packet->{mysql_data_len});

1400

if ( $com && $com->{code} eq COM_SLEEP ) {

1401

MKDEBUG && _d('Client is using compression');

1401

PTDEBUG && _d('Client is using compression');

1402

$session->{compress} = 1;

1403

1404

# Since parse_packet() didn't know the packet was compressed, it

1410

remove_mysql_header($packet);

1411

}

1412

else {

1413

MKDEBUG && _d('Client is NOT using compression');

1413

PTDEBUG && _d('Client is NOT using compression');

1414

$session->{compress} = 0;

1415

}

1416

return 1;

1442

$comp_data_len = to_num(substr($comp_hdr, 0, 6));

1443

$pkt_num = to_num(substr($comp_hdr, 6, 2));

1444

$uncomp_data_len = to_num(substr($comp_hdr, 8, 6));

1445

MKDEBUG && _d('Compression header data:', $comp_hdr,

1445

PTDEBUG && _d('Compression header data:', $comp_hdr,

1446

'compressed data len (bytes)', $comp_data_len,

1447

'number', $pkt_num,

1448

'uncompressed data len (bytes)', $uncomp_data_len);

1466

}

1467

}

1468

else {

1469

MKDEBUG && _d('Packet is not really compressed');

1469

PTDEBUG && _d('Packet is not really compressed');

1470

$packet->{data} = $$data;

1471

}

1472

1486

my $mysql_hdr = substr($packet->{data}, 0, 8, '');

1487

my $mysql_data_len = to_num(substr($mysql_hdr, 0, 6));

1488

my $pkt_num = to_num(substr($mysql_hdr, 6, 2));

1489

MKDEBUG && _d('MySQL packet: header data', $mysql_hdr,

1489

PTDEBUG && _d('MySQL packet: header data', $mysql_hdr,

1490

'data len (bytes)', $mysql_data_len, 'number', $pkt_num);

1491

1492

$packet->{mysql_hdr} = $mysql_hdr;

1505

my $o = $self->{o};

1506

if ( $o && $o->has('tcpdump-errors') && $o->got('tcpdump-errors') ) {

1507

my $errors_file = $o->get('tcpdump-errors');

1508

MKDEBUG && _d('tcpdump-errors file:', $errors_file);

1508

PTDEBUG && _d('tcpdump-errors file:', $errors_file);

1509

open $errors_fh, '>>', $errors_file

1510

or die "Cannot open tcpdump-errors file $errors_file: $OS_ERROR";

1511

}

1516

1517

sub fail_session {

1518

my ( $self, $session, $reason ) = @_;

1519

MKDEBUG && _d('Client', $session->{client}, 'failed because', $reason);

1519

PTDEBUG && _d('Client', $session->{client}, 'failed because', $reason);

1520

my $errors_fh = $self->_get_errors_fh();

1521

if ( $errors_fh ) {

1522

my $raw_packets = $session->{raw_packets};