← Back to branch summary

~percona-toolkit-dev/percona-toolkit/fix-zombie-bug-919819

« back to all changes in this revision

Viewing changes to lib/ProtocolParser.pm

  • Committer: Daniel Nichter
  • Date: 2012-01-19 19:46:56 UTC
  • Revision ID: daniel@percona.com-20120119194656-3l1nzgtq1p7xvigo
Replace MKDEBUG with PTDEBUG in modules.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/ProtocolParser.pm
25
25
use strict;
26
26
use warnings FATAL => 'all';
27
27
use English qw(-no_match_vars);
28
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
28
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
29
29
 
30
30
eval {
31
31
   require IO::Uncompress::Inflate;
65
65
      if ( $packet->{data_len} ) {
66
66
         if ( $packet_from eq 'client' ) {
67
67
            push @{$session->{client_packets}}, $packet;
68
 
            MKDEBUG && _d('Saved client packet');
 
68
            PTDEBUG && _d('Saved client packet');
69
69
         }
70
70
         else {
71
71
            push @{$session->{server_packets}}, $packet;
72
 
            MKDEBUG && _d('Saved server packet');
 
72
            PTDEBUG && _d('Saved server packet');
73
73
         }
74
74
      }
75
75
 
97
97
      # Return early if there's no TCP data.  These are usually ACK packets, but
98
98
      # they could also be FINs in which case, we should close and delete the
99
99
      # client's session.
100
 
      MKDEBUG && _d('No TCP data');
 
100
      PTDEBUG && _d('No TCP data');
101
101
      return;
102
102
   }
103
103
 
112
112
   my ( $self, $packet, $misc ) = @_;
113
113
 
114
114
   my ($packet_from, $session) = $self->_get_session($packet);
115
 
   MKDEBUG && _d('State:', $session->{state});
 
115
   PTDEBUG && _d('State:', $session->{state});
116
116
 
117
117
   # Save raw packets to dump later in case something fails.
118
118
   push @{$session->{raw_packets}}, $packet->{raw_packet}
123
123
      # to what we've been buffering.
124
124
      $session->{buff_left} -= $packet->{data_len};
125
125
      if ( $session->{buff_left} > 0 ) {
126
 
         MKDEBUG && _d('Added data to buff; expecting', $session->{buff_left},
 
126
         PTDEBUG && _d('Added data to buff; expecting', $session->{buff_left},
127
127
            'more bytes');
128
128
         return;
129
129
      }
130
130
 
131
 
      MKDEBUG && _d('Got all data; buff left:', $session->{buff_left});
 
131
      PTDEBUG && _d('Got all data; buff left:', $session->{buff_left});
132
132
      $packet->{data}       = $session->{buff} . $packet->{data};
133
133
      $packet->{data_len}  += length $session->{buff};
134
134
      $session->{buff}      = '';
148
148
      # Should not get here.
149
149
      die 'Packet origin unknown';
150
150
   }
151
 
   MKDEBUG && _d('State:', $session->{state});
 
151
   PTDEBUG && _d('State:', $session->{state});
152
152
 
153
153
   if ( $session->{out_of_order} ) {
154
 
      MKDEBUG && _d('Session packets are out of order');
 
154
      PTDEBUG && _d('Session packets are out of order');
155
155
      push @{$session->{packets}}, $packet;
156
156
      $session->{ts_min}
157
157
         = $packet->{ts} if $packet->{ts} lt ($session->{ts_min} || '');
158
158
      $session->{ts_max}
159
159
         = $packet->{ts} if $packet->{ts} gt ($session->{ts_max} || '');
160
160
      if ( $session->{have_all_packets} ) {
161
 
         MKDEBUG && _d('Have all packets; ordering and processing');
 
161
         PTDEBUG && _d('Have all packets; ordering and processing');
162
162
         delete $session->{out_of_order};
163
163
         delete $session->{have_all_packets};
164
164
         map {
167
167
      }
168
168
   }
169
169
 
170
 
   MKDEBUG && _d('Done with packet; event:', Dumper($event));
 
170
   PTDEBUG && _d('Done with packet; event:', Dumper($event));
171
171
   return $event;
172
172
}
173
173
 
180
180
   if ( my $server = $self->{server} ) {  # Watch only the given server.
181
181
      $server .= ":$self->{port}";
182
182
      if ( $src_host ne $server && $dst_host ne $server ) {
183
 
         MKDEBUG && _d('Packet is not to or from', $server);
 
183
         PTDEBUG && _d('Packet is not to or from', $server);
184
184
         return;
185
185
      }
186
186
   }
200
200
      warn 'Packet is not to or from server: ', Dumper($packet);
201
201
      return;
202
202
   }
203
 
   MKDEBUG && _d('Client:', $client);
 
203
   PTDEBUG && _d('Client:', $client);
204
204
 
205
205
   # Get the client's session info or create a new session if the
206
206
   # client hasn't been seen before.
207
207
   if ( !exists $self->{sessions}->{$client} ) {
208
 
      MKDEBUG && _d('New session');
 
208
      PTDEBUG && _d('New session');
209
209
      $self->{sessions}->{$client} = {
210
210
         client      => $client,
211
211
         state       => undef,
233
233
   my $start_request = $session->{start_request} || 0;
234
234
   my $start_reply   = $session->{start_reply}   || 0;
235
235
   my $end_reply     = $session->{end_reply}     || 0;
236
 
   MKDEBUG && _d('Request start:', $start_request,
 
236
   PTDEBUG && _d('Request start:', $start_request,
237
237
      'reply start:', $start_reply, 'reply end:', $end_reply);
238
238
   my $event = {
239
239
      Query_time    => $self->timestamp_diff($start_request, $start_reply),
252
252
   my $o = $self->{o};
253
253
   if ( $o && $o->has('tcpdump-errors') && $o->got('tcpdump-errors') ) {
254
254
      my $errors_file = $o->get('tcpdump-errors');
255
 
      MKDEBUG && _d('tcpdump-errors file:', $errors_file);
 
255
      PTDEBUG && _d('tcpdump-errors file:', $errors_file);
256
256
      open $errors_fh, '>>', $errors_file
257
257
         or die "Cannot open tcpdump-errors file $errors_file: $OS_ERROR";
258
258
   }
276
276
         print $errors_fh "\n";
277
277
      }
278
278
   }
279
 
   MKDEBUG && _d('Failed session', $session->{client}, 'because', $reason);
 
279
   PTDEBUG && _d('Failed session', $session->{client}, 'because', $reason);
280
280
   delete $self->{sessions}->{$session->{client}};
281
281
   return;
282
282
}
307
307
   die "I need data" unless $data;
308
308
   die "I need a len argument" unless $len;
309
309
   die "I need a scalar reference to data" unless ref $data eq 'SCALAR';
310
 
   MKDEBUG && _d('Uncompressing data');
 
310
   PTDEBUG && _d('Uncompressing data');
311
311
   our $InflateError;
312
312
 
313
313
   # Pack hex string into compressed binary data.