Merge lp:~percona-toolkit-dev/percona-toolkit/simplify-pqd into lp:percona-toolkit/2.2
- simplify-pqd
- Merge into 2.2
Proposed by
Brian Fraser
Status: | Merged |
---|---|
Approved by: | Daniel Nichter |
Approved revision: | 518 |
Merged at revision: | 514 |
Proposed branch: | lp:~percona-toolkit-dev/percona-toolkit/simplify-pqd |
Merge into: | lp:percona-toolkit/2.2 |
Diff against target: |
224909 lines (+12/-224362) 75 files modified
bin/pt-query-digest (+8/-1514) lib/HTTPProtocolParser.pm (+0/-242) lib/MemcachedEvent.pm (+0/-216) lib/MemcachedProtocolParser.pm (+0/-424) lib/PgLogParser.pm (+0/-669) lib/QueryReportFormatter.pm (+1/-3) lib/SysLogParser.pm (+0/-259) lib/TcpdumpParser.pm (+1/-4) t/lib/HTTPProtocolParser.t (+0/-286) t/lib/MemcachedEvent.t (+0/-766) t/lib/MemcachedProtocolParser.t (+0/-414) t/lib/PgLogParser.t (+0/-604) t/lib/SysLogParser.t (+0/-205) t/lib/samples/http/http_tcpdump001.txt (+0/-107) t/lib/samples/http/http_tcpdump002.txt (+0/-3564) t/lib/samples/http/http_tcpdump003.txt (+0/-16163) t/lib/samples/http/http_tcpdump004.txt (+0/-898) t/lib/samples/http/http_tcpdump005.txt (+0/-465) t/lib/samples/http/http_tcpdump006.txt (+0/-322) t/lib/samples/http/http_tcpdump007.txt (+0/-184146) t/lib/samples/http/http_tcpdump008.txt (+0/-112) t/lib/samples/http/http_tcpdump009.txt (+0/-106) t/lib/samples/memcached/memc_tcpdump001.txt (+0/-12) t/lib/samples/memcached/memc_tcpdump002.txt (+0/-13) t/lib/samples/memcached/memc_tcpdump003.txt (+0/-20) t/lib/samples/memcached/memc_tcpdump004.txt (+0/-60) t/lib/samples/memcached/memc_tcpdump005.txt (+0/-1163) t/lib/samples/memcached/memc_tcpdump006.txt (+0/-1170) t/lib/samples/memcached/memc_tcpdump007.txt (+0/-11) t/lib/samples/memcached/memc_tcpdump008.txt (+0/-121) t/lib/samples/memcached/memc_tcpdump009.txt (+0/-11) t/lib/samples/memcached/memc_tcpdump010.txt (+0/-11) t/lib/samples/memcached/memc_tcpdump011.txt (+0/-25) t/lib/samples/memcached/memc_tcpdump013.txt (+0/-6) t/lib/samples/memcached/memc_tcpdump014.txt (+0/-19) t/lib/samples/memcached/memc_tcpdump015.txt (+0/-25) t/lib/samples/memcached/memc_tcpdump016.txt (+0/-37) t/lib/samples/pg/pg-log-001.txt (+0/-8) t/lib/samples/pg/pg-log-002.txt (+0/-15) t/lib/samples/pg/pg-log-003.txt (+0/-10) t/lib/samples/pg/pg-log-004.txt (+0/-4) t/lib/samples/pg/pg-log-005.txt (+0/-6) t/lib/samples/pg/pg-log-006.txt (+0/-16) t/lib/samples/pg/pg-log-007.txt (+0/-13) t/lib/samples/pg/pg-log-008.txt (+0/-3) t/lib/samples/pg/pg-log-009.txt (+0/-2980) t/lib/samples/pg/pg-log-010.txt (+0/-3693) t/lib/samples/pg/pg-syslog-001.txt (+0/-13) t/lib/samples/pg/pg-syslog-002.txt (+0/-5) t/lib/samples/pg/pg-syslog-003.txt (+0/-14) t/lib/samples/pg/pg-syslog-004.txt (+0/-8) t/lib/samples/pg/pg-syslog-005.txt (+0/-5) t/lib/samples/pg/pg-syslog-006.txt (+0/-9) t/lib/samples/pg/pg-syslog-007.txt (+0/-11) t/lib/samples/pg/pg-syslog-008.txt (+0/-123) t/lib/samples/pg/pg-syslog-009.txt (+0/-2437) t/lib/samples/pg/pg-syslog-010.txt (+0/-23) t/pt-query-digest/http_analyses.t (+0/-26) t/pt-query-digest/memcached_analyses.t (+0/-90) t/pt-query-digest/pglog_analyses.t (+0/-44) t/pt-query-digest/resume.t (+2/-2) t/pt-query-digest/samples/http_tcpdump002.txt (+0/-240) t/pt-query-digest/samples/memc_tcpdump001.txt (+0/-25) t/pt-query-digest/samples/memc_tcpdump002.txt (+0/-25) t/pt-query-digest/samples/memc_tcpdump003.txt (+0/-50) t/pt-query-digest/samples/memc_tcpdump003_report_key_print.txt (+0/-29) t/pt-query-digest/samples/memc_tcpdump004.txt (+0/-52) t/pt-query-digest/samples/memc_tcpdump005.txt (+0/-25) t/pt-query-digest/samples/memc_tcpdump006.txt (+0/-25) t/pt-query-digest/samples/memc_tcpdump007.txt (+0/-26) t/pt-query-digest/samples/memc_tcpdump008.txt (+0/-26) t/pt-query-digest/samples/memc_tcpdump009.txt (+0/-26) t/pt-query-digest/samples/memc_tcpdump010.txt (+0/-25) t/pt-query-digest/samples/pg-sample1 (+0/-25) t/pt-query-digest/samples/pg-syslog-sample1 (+0/-12) |
To merge this branch: | bzr merge lp:~percona-toolkit-dev/percona-toolkit/simplify-pqd |
Related bugs: | |
Related blueprints: |
Simplify pt-query-digest
(Essential)
|
Reviewer | Review Type | Date Requested | Status |
---|---|---|---|
Daniel Nichter | Approve | ||
Review via email: mp+146196@code.launchpad.net |
Commit message
Description of the change
To post a comment you must log in.
Revision history for this message
Daniel Nichter (daniel-nichter) wrote : | # |
Somehow https:/
Preview Diff
[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
1 | === modified file 'bin/pt-query-digest' | |||
2 | --- bin/pt-query-digest 2013-01-31 17:52:34 +0000 | |||
3 | +++ bin/pt-query-digest 2013-02-01 18:19:34 +0000 | |||
4 | @@ -23,8 +23,6 @@ | |||
5 | 23 | Processlist | 23 | Processlist |
6 | 24 | TcpdumpParser | 24 | TcpdumpParser |
7 | 25 | MySQLProtocolParser | 25 | MySQLProtocolParser |
8 | 26 | SysLogParser | ||
9 | 27 | PgLogParser | ||
10 | 28 | SlowLogParser | 26 | SlowLogParser |
11 | 29 | SlowLogWriter | 27 | SlowLogWriter |
12 | 30 | EventAggregator | 28 | EventAggregator |
13 | @@ -36,13 +34,10 @@ | |||
14 | 36 | TableParser | 34 | TableParser |
15 | 37 | QueryReview | 35 | QueryReview |
16 | 38 | Daemon | 36 | Daemon |
17 | 39 | MemcachedProtocolParser | ||
18 | 40 | MemcachedEvent | ||
19 | 41 | BinaryLogParser | 37 | BinaryLogParser |
20 | 42 | GeneralLogParser | 38 | GeneralLogParser |
21 | 43 | RawLogParser | 39 | RawLogParser |
22 | 44 | ProtocolParser | 40 | ProtocolParser |
23 | 45 | HTTPProtocolParser | ||
24 | 46 | MasterSlave | 41 | MasterSlave |
25 | 47 | Progress | 42 | Progress |
26 | 48 | FileIterator | 43 | FileIterator |
27 | @@ -3283,10 +3278,7 @@ | |||
28 | 3283 | sub port_number { | 3278 | sub port_number { |
29 | 3284 | my ( $self, $port ) = @_; | 3279 | my ( $self, $port ) = @_; |
30 | 3285 | return unless $port; | 3280 | return unless $port; |
35 | 3286 | return $port eq 'memcached' ? 11211 | 3281 | return $port eq 'mysql' ? 3306 : $port; |
32 | 3287 | : $port eq 'http' ? 80 | ||
33 | 3288 | : $port eq 'mysql' ? 3306 | ||
34 | 3289 | : $port; | ||
36 | 3290 | } | 3282 | } |
37 | 3291 | 3283 | ||
38 | 3292 | sub _d { | 3284 | sub _d { |
39 | @@ -4587,617 +4579,6 @@ | |||
40 | 4587 | # ########################################################################### | 4579 | # ########################################################################### |
41 | 4588 | 4580 | ||
42 | 4589 | # ########################################################################### | 4581 | # ########################################################################### |
43 | 4590 | # SysLogParser package | ||
44 | 4591 | # This package is a copy without comments from the original. The original | ||
45 | 4592 | # with comments and its test file can be found in the Bazaar repository at, | ||
46 | 4593 | # lib/SysLogParser.pm | ||
47 | 4594 | # t/lib/SysLogParser.t | ||
48 | 4595 | # See https://launchpad.net/percona-toolkit for more information. | ||
49 | 4596 | # ########################################################################### | ||
50 | 4597 | { | ||
51 | 4598 | package SysLogParser; | ||
52 | 4599 | |||
53 | 4600 | use strict; | ||
54 | 4601 | use warnings FATAL => 'all'; | ||
55 | 4602 | use English qw(-no_match_vars); | ||
56 | 4603 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
57 | 4604 | |||
58 | 4605 | my $syslog_regex = qr{\A.*\w+\[\d+\]: \[(\d+)-(\d+)\] (.*)\Z}; | ||
59 | 4606 | |||
60 | 4607 | sub new { | ||
61 | 4608 | my ( $class ) = @_; | ||
62 | 4609 | my $self = {}; | ||
63 | 4610 | return bless $self, $class; | ||
64 | 4611 | } | ||
65 | 4612 | |||
66 | 4613 | sub parse_event { | ||
67 | 4614 | my ( $self, %args ) = @_; | ||
68 | 4615 | my ( $next_event, $tell, $is_syslog ) = $self->generate_wrappers(%args); | ||
69 | 4616 | return $next_event->(); | ||
70 | 4617 | } | ||
71 | 4618 | |||
72 | 4619 | sub generate_wrappers { | ||
73 | 4620 | my ( $self, %args ) = @_; | ||
74 | 4621 | |||
75 | 4622 | if ( ($self->{sanity} || '') ne "$args{next_event}" ){ | ||
76 | 4623 | PTDEBUG && _d("Clearing and recreating internal state"); | ||
77 | 4624 | @{$self}{qw(next_event tell is_syslog)} = $self->make_closures(%args); | ||
78 | 4625 | $self->{sanity} = "$args{next_event}"; | ||
79 | 4626 | } | ||
80 | 4627 | |||
81 | 4628 | return @{$self}{qw(next_event tell is_syslog)}; | ||
82 | 4629 | } | ||
83 | 4630 | |||
84 | 4631 | sub make_closures { | ||
85 | 4632 | my ( $self, %args ) = @_; | ||
86 | 4633 | |||
87 | 4634 | my $next_event = $args{'next_event'}; | ||
88 | 4635 | my $tell = $args{'tell'}; | ||
89 | 4636 | my $new_event_test = $args{'misc'}->{'new_event_test'}; | ||
90 | 4637 | my $line_filter = $args{'misc'}->{'line_filter'}; | ||
91 | 4638 | |||
92 | 4639 | my $test_line = $next_event->(); | ||
93 | 4640 | PTDEBUG && _d('Read first sample/test line:', $test_line); | ||
94 | 4641 | |||
95 | 4642 | if ( defined $test_line && $test_line =~ m/$syslog_regex/o ) { | ||
96 | 4643 | |||
97 | 4644 | PTDEBUG && _d('This looks like a syslog line, PTDEBUG prefix=LLSP'); | ||
98 | 4645 | |||
99 | 4646 | my ($msg_nr, $line_nr, $content) = $test_line =~ m/$syslog_regex/o; | ||
100 | 4647 | my @pending = ($test_line); | ||
101 | 4648 | my $last_msg_nr = $msg_nr; | ||
102 | 4649 | my $pos_in_log = 0; | ||
103 | 4650 | |||
104 | 4651 | my $new_next_event = sub { | ||
105 | 4652 | PTDEBUG && _d('LLSP: next_event()'); | ||
106 | 4653 | |||
107 | 4654 | PTDEBUG && _d('LLSP: Current virtual $fh position:', $pos_in_log); | ||
108 | 4655 | my $new_pos = 0; | ||
109 | 4656 | |||
110 | 4657 | my @arg_lines; | ||
111 | 4658 | |||
112 | 4659 | my $line; | ||
113 | 4660 | LINE: | ||
114 | 4661 | while ( | ||
115 | 4662 | defined($line = shift @pending) | ||
116 | 4663 | || do { | ||
117 | 4664 | eval { $new_pos = -1; $new_pos = $tell->() }; | ||
118 | 4665 | defined($line = $next_event->()); | ||
119 | 4666 | } | ||
120 | 4667 | ) { | ||
121 | 4668 | PTDEBUG && _d('LLSP: Line:', $line); | ||
122 | 4669 | |||
123 | 4670 | ($msg_nr, $line_nr, $content) = $line =~ m/$syslog_regex/o; | ||
124 | 4671 | if ( !$msg_nr ) { | ||
125 | 4672 | die "Can't parse line: $line"; | ||
126 | 4673 | } | ||
127 | 4674 | |||
128 | 4675 | elsif ( $msg_nr != $last_msg_nr ) { | ||
129 | 4676 | PTDEBUG && _d('LLSP: $msg_nr', $last_msg_nr, '=>', $msg_nr); | ||
130 | 4677 | $last_msg_nr = $msg_nr; | ||
131 | 4678 | last LINE; | ||
132 | 4679 | } | ||
133 | 4680 | |||
134 | 4681 | elsif ( @arg_lines && $new_event_test && $new_event_test->($content) ) { | ||
135 | 4682 | PTDEBUG && _d('LLSP: $new_event_test matches'); | ||
136 | 4683 | last LINE; | ||
137 | 4684 | } | ||
138 | 4685 | |||
139 | 4686 | $content =~ s/#(\d{3})/chr(oct($1))/ge; | ||
140 | 4687 | $content =~ s/\^I/\t/g; | ||
141 | 4688 | if ( $line_filter ) { | ||
142 | 4689 | PTDEBUG && _d('LLSP: applying $line_filter'); | ||
143 | 4690 | $content = $line_filter->($content); | ||
144 | 4691 | } | ||
145 | 4692 | |||
146 | 4693 | push @arg_lines, $content; | ||
147 | 4694 | } | ||
148 | 4695 | PTDEBUG && _d('LLSP: Exited while-loop after finding a complete entry'); | ||
149 | 4696 | |||
150 | 4697 | my $psql_log_event = @arg_lines ? join('', @arg_lines) : undef; | ||
151 | 4698 | PTDEBUG && _d('LLSP: Final log entry:', $psql_log_event); | ||
152 | 4699 | |||
153 | 4700 | if ( defined $line ) { | ||
154 | 4701 | PTDEBUG && _d('LLSP: Saving $line:', $line); | ||
155 | 4702 | @pending = $line; | ||
156 | 4703 | PTDEBUG && _d('LLSP: $pos_in_log:', $pos_in_log, '=>', $new_pos); | ||
157 | 4704 | $pos_in_log = $new_pos; | ||
158 | 4705 | } | ||
159 | 4706 | else { | ||
160 | 4707 | PTDEBUG && _d('LLSP: EOF reached'); | ||
161 | 4708 | @pending = (); | ||
162 | 4709 | $last_msg_nr = 0; | ||
163 | 4710 | } | ||
164 | 4711 | |||
165 | 4712 | return $psql_log_event; | ||
166 | 4713 | }; | ||
167 | 4714 | |||
168 | 4715 | my $new_tell = sub { | ||
169 | 4716 | PTDEBUG && _d('LLSP: tell()', $pos_in_log); | ||
170 | 4717 | return $pos_in_log; | ||
171 | 4718 | }; | ||
172 | 4719 | |||
173 | 4720 | return ($new_next_event, $new_tell, 1); | ||
174 | 4721 | } | ||
175 | 4722 | |||
176 | 4723 | else { | ||
177 | 4724 | |||
178 | 4725 | PTDEBUG && _d('Plain log, or we are at EOF; PTDEBUG prefix=PLAIN'); | ||
179 | 4726 | |||
180 | 4727 | my @pending = defined $test_line ? ($test_line) : (); | ||
181 | 4728 | |||
182 | 4729 | my $new_next_event = sub { | ||
183 | 4730 | PTDEBUG && _d('PLAIN: next_event(); @pending:', scalar @pending); | ||
184 | 4731 | return @pending ? shift @pending : $next_event->(); | ||
185 | 4732 | }; | ||
186 | 4733 | my $new_tell = sub { | ||
187 | 4734 | PTDEBUG && _d('PLAIN: tell(); @pending:', scalar @pending); | ||
188 | 4735 | return @pending ? 0 : $tell->(); | ||
189 | 4736 | }; | ||
190 | 4737 | return ($new_next_event, $new_tell, 0); | ||
191 | 4738 | } | ||
192 | 4739 | } | ||
193 | 4740 | |||
194 | 4741 | sub _d { | ||
195 | 4742 | my ($package, undef, $line) = caller 0; | ||
196 | 4743 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | ||
197 | 4744 | map { defined $_ ? $_ : 'undef' } | ||
198 | 4745 | @_; | ||
199 | 4746 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | ||
200 | 4747 | } | ||
201 | 4748 | |||
202 | 4749 | 1; | ||
203 | 4750 | } | ||
204 | 4751 | # ########################################################################### | ||
205 | 4752 | # End SysLogParser package | ||
206 | 4753 | # ########################################################################### | ||
207 | 4754 | |||
208 | 4755 | # ########################################################################### | ||
209 | 4756 | # PgLogParser package | ||
210 | 4757 | # This package is a copy without comments from the original. The original | ||
211 | 4758 | # with comments and its test file can be found in the Bazaar repository at, | ||
212 | 4759 | # lib/PgLogParser.pm | ||
213 | 4760 | # t/lib/PgLogParser.t | ||
214 | 4761 | # See https://launchpad.net/percona-toolkit for more information. | ||
215 | 4762 | # ########################################################################### | ||
216 | 4763 | { | ||
217 | 4764 | package PgLogParser; | ||
218 | 4765 | |||
219 | 4766 | use strict; | ||
220 | 4767 | use warnings FATAL => 'all'; | ||
221 | 4768 | use English qw(-no_match_vars); | ||
222 | 4769 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
223 | 4770 | |||
224 | 4771 | use Data::Dumper; | ||
225 | 4772 | $Data::Dumper::Indent = 1; | ||
226 | 4773 | $Data::Dumper::Sortkeys = 1; | ||
227 | 4774 | $Data::Dumper::Quotekeys = 0; | ||
228 | 4775 | |||
229 | 4776 | my $log_line_regex = qr{ | ||
230 | 4777 | (LOG|DEBUG|CONTEXT|WARNING|ERROR|FATAL|PANIC|HINT | ||
231 | 4778 | |DETAIL|NOTICE|STATEMENT|INFO|LOCATION) | ||
232 | 4779 | :\s\s+ | ||
233 | 4780 | }x; | ||
234 | 4781 | |||
235 | 4782 | my %attrib_name_for = ( | ||
236 | 4783 | u => 'user', | ||
237 | 4784 | d => 'db', | ||
238 | 4785 | r => 'host', # With port | ||
239 | 4786 | h => 'host', | ||
240 | 4787 | p => 'Process_id', | ||
241 | 4788 | t => 'ts', | ||
242 | 4789 | m => 'ts', # With milliseconds | ||
243 | 4790 | i => 'Query_type', | ||
244 | 4791 | c => 'Session_id', | ||
245 | 4792 | l => 'Line_no', | ||
246 | 4793 | s => 'Session_id', | ||
247 | 4794 | v => 'Vrt_trx_id', | ||
248 | 4795 | x => 'Trx_id', | ||
249 | 4796 | ); | ||
250 | 4797 | |||
251 | 4798 | sub new { | ||
252 | 4799 | my ( $class ) = @_; | ||
253 | 4800 | my $self = { | ||
254 | 4801 | pending => [], | ||
255 | 4802 | is_syslog => undef, | ||
256 | 4803 | next_event => undef, | ||
257 | 4804 | 'tell' => undef, | ||
258 | 4805 | }; | ||
259 | 4806 | return bless $self, $class; | ||
260 | 4807 | } | ||
261 | 4808 | |||
262 | 4809 | sub parse_event { | ||
263 | 4810 | my ( $self, %args ) = @_; | ||
264 | 4811 | my @required_args = qw(next_event tell); | ||
265 | 4812 | foreach my $arg ( @required_args ) { | ||
266 | 4813 | die "I need a $arg argument" unless $args{$arg}; | ||
267 | 4814 | } | ||
268 | 4815 | |||
269 | 4816 | my ( $next_event, $tell, $is_syslog ) = $self->generate_wrappers(%args); | ||
270 | 4817 | |||
271 | 4818 | my @properties = (); | ||
272 | 4819 | |||
273 | 4820 | my ($pos_in_log, $line, $was_pending) = $self->get_line(); | ||
274 | 4821 | my $new_pos; | ||
275 | 4822 | |||
276 | 4823 | my @arg_lines; | ||
277 | 4824 | |||
278 | 4825 | my $done; | ||
279 | 4826 | |||
280 | 4827 | my $got_duration; | ||
281 | 4828 | |||
282 | 4829 | if ( !$was_pending && (!defined $line || $line !~ m/$log_line_regex/o) ) { | ||
283 | 4830 | PTDEBUG && _d('Skipping lines until I find a header'); | ||
284 | 4831 | my $found_header; | ||
285 | 4832 | LINE: | ||
286 | 4833 | while ( | ||
287 | 4834 | eval { | ||
288 | 4835 | ($new_pos, $line) = $self->get_line(); | ||
289 | 4836 | defined $line; | ||
290 | 4837 | } | ||
291 | 4838 | ) { | ||
292 | 4839 | if ( $line =~ m/$log_line_regex/o ) { | ||
293 | 4840 | $pos_in_log = $new_pos; | ||
294 | 4841 | last LINE; | ||
295 | 4842 | } | ||
296 | 4843 | else { | ||
297 | 4844 | PTDEBUG && _d('Line was not a header, will fetch another'); | ||
298 | 4845 | } | ||
299 | 4846 | } | ||
300 | 4847 | PTDEBUG && _d('Found a header line, now at pos_in_line', $pos_in_log); | ||
301 | 4848 | } | ||
302 | 4849 | |||
303 | 4850 | my $first_line; | ||
304 | 4851 | |||
305 | 4852 | my $line_type; | ||
306 | 4853 | |||
307 | 4854 | LINE: | ||
308 | 4855 | while ( !$done && defined $line ) { | ||
309 | 4856 | |||
310 | 4857 | chomp $line unless $is_syslog; | ||
311 | 4858 | |||
312 | 4859 | if ( (($line_type) = $line =~ m/$log_line_regex/o) && $line_type ne 'LOG' ) { | ||
313 | 4860 | |||
314 | 4861 | if ( @arg_lines ) { | ||
315 | 4862 | PTDEBUG && _d('Found a non-LOG line, exiting loop'); | ||
316 | 4863 | last LINE; | ||
317 | 4864 | } | ||
318 | 4865 | |||
319 | 4866 | else { | ||
320 | 4867 | $first_line ||= $line; | ||
321 | 4868 | |||
322 | 4869 | if ( my ($e) = $line =~ m/ERROR:\s+(\S.*)\Z/s ) { | ||
323 | 4870 | push @properties, 'Error_msg', $e; | ||
324 | 4871 | PTDEBUG && _d('Found an error msg, saving and continuing'); | ||
325 | 4872 | ($new_pos, $line) = $self->get_line(); | ||
326 | 4873 | next LINE; | ||
327 | 4874 | } | ||
328 | 4875 | |||
329 | 4876 | elsif ( my ($s) = $line =~ m/STATEMENT:\s+(\S.*)\Z/s ) { | ||
330 | 4877 | push @properties, 'arg', $s, 'cmd', 'Query'; | ||
331 | 4878 | PTDEBUG && _d('Found a statement, finishing up event'); | ||
332 | 4879 | $done = 1; | ||
333 | 4880 | last LINE; | ||
334 | 4881 | } | ||
335 | 4882 | |||
336 | 4883 | else { | ||
337 | 4884 | PTDEBUG && _d("I don't know what to do with this line"); | ||
338 | 4885 | } | ||
339 | 4886 | } | ||
340 | 4887 | |||
341 | 4888 | } | ||
342 | 4889 | |||
343 | 4890 | if ( | ||
344 | 4891 | $line =~ m{ | ||
345 | 4892 | Address\sfamily\snot\ssupported\sby\sprotocol | ||
346 | 4893 | |archived\stransaction\slog\sfile | ||
347 | 4894 | |autovacuum:\sprocessing\sdatabase | ||
348 | 4895 | |checkpoint\srecord\sis\sat | ||
349 | 4896 | |checkpoints\sare\soccurring\stoo\sfrequently\s\( | ||
350 | 4897 | |could\snot\sreceive\sdata\sfrom\sclient | ||
351 | 4898 | |database\ssystem\sis\sready | ||
352 | 4899 | |database\ssystem\sis\sshut\sdown | ||
353 | 4900 | |database\ssystem\swas\sshut\sdown | ||
354 | 4901 | |incomplete\sstartup\spacket | ||
355 | 4902 | |invalid\slength\sof\sstartup\spacket | ||
356 | 4903 | |next\sMultiXactId: | ||
357 | 4904 | |next\stransaction\sID: | ||
358 | 4905 | |received\ssmart\sshutdown\srequest | ||
359 | 4906 | |recycled\stransaction\slog\sfile | ||
360 | 4907 | |redo\srecord\sis\sat | ||
361 | 4908 | |removing\sfile\s" | ||
362 | 4909 | |removing\stransaction\slog\sfile\s" | ||
363 | 4910 | |shutting\sdown | ||
364 | 4911 | |transaction\sID\swrap\slimit\sis | ||
365 | 4912 | }x | ||
366 | 4913 | ) { | ||
367 | 4914 | PTDEBUG && _d('Skipping this line because it matches skip-pattern'); | ||
368 | 4915 | ($new_pos, $line) = $self->get_line(); | ||
369 | 4916 | next LINE; | ||
370 | 4917 | } | ||
371 | 4918 | |||
372 | 4919 | $first_line ||= $line; | ||
373 | 4920 | |||
374 | 4921 | if ( $line !~ m/$log_line_regex/o && @arg_lines ) { | ||
375 | 4922 | |||
376 | 4923 | if ( !$is_syslog ) { | ||
377 | 4924 | $line =~ s/\A\t?/\n/; | ||
378 | 4925 | } | ||
379 | 4926 | |||
380 | 4927 | push @arg_lines, $line; | ||
381 | 4928 | PTDEBUG && _d('This was a continuation line'); | ||
382 | 4929 | } | ||
383 | 4930 | |||
384 | 4931 | elsif ( | ||
385 | 4932 | my ( $sev, $label, $rest ) | ||
386 | 4933 | = $line =~ m/$log_line_regex(.+?):\s+(.*)\Z/so | ||
387 | 4934 | ) { | ||
388 | 4935 | PTDEBUG && _d('Line is case 1 or case 3'); | ||
389 | 4936 | |||
390 | 4937 | if ( @arg_lines ) { | ||
391 | 4938 | $done = 1; | ||
392 | 4939 | PTDEBUG && _d('There are saved @arg_lines, we are done'); | ||
393 | 4940 | |||
394 | 4941 | if ( $label eq 'duration' && $rest =~ m/[0-9.]+\s+\S+\Z/ ) { | ||
395 | 4942 | if ( $got_duration ) { | ||
396 | 4943 | PTDEBUG && _d('Discarding line, duration already found'); | ||
397 | 4944 | } | ||
398 | 4945 | else { | ||
399 | 4946 | push @properties, 'Query_time', $self->duration_to_secs($rest); | ||
400 | 4947 | PTDEBUG && _d("Line's duration is for previous event:", $rest); | ||
401 | 4948 | } | ||
402 | 4949 | } | ||
403 | 4950 | else { | ||
404 | 4951 | $self->pending($new_pos, $line); | ||
405 | 4952 | PTDEBUG && _d('Deferred line'); | ||
406 | 4953 | } | ||
407 | 4954 | } | ||
408 | 4955 | |||
409 | 4956 | elsif ( $label =~ m/\A(?:duration|statement|query)\Z/ ) { | ||
410 | 4957 | PTDEBUG && _d('Case 1: start a multi-line event'); | ||
411 | 4958 | |||
412 | 4959 | if ( $label eq 'duration' ) { | ||
413 | 4960 | |||
414 | 4961 | if ( | ||
415 | 4962 | (my ($dur, $stmt) | ||
416 | 4963 | = $rest =~ m/([0-9.]+ \S+)\s+(?:statement|query): *(.*)\Z/s) | ||
417 | 4964 | ) { | ||
418 | 4965 | push @properties, 'Query_time', $self->duration_to_secs($dur); | ||
419 | 4966 | $got_duration = 1; | ||
420 | 4967 | push @arg_lines, $stmt; | ||
421 | 4968 | PTDEBUG && _d('Duration + statement'); | ||
422 | 4969 | } | ||
423 | 4970 | |||
424 | 4971 | else { | ||
425 | 4972 | $first_line = undef; | ||
426 | 4973 | ($pos_in_log, $line) = $self->get_line(); | ||
427 | 4974 | PTDEBUG && _d('Line applies to event we never saw, discarding'); | ||
428 | 4975 | next LINE; | ||
429 | 4976 | } | ||
430 | 4977 | } | ||
431 | 4978 | else { | ||
432 | 4979 | push @arg_lines, $rest; | ||
433 | 4980 | PTDEBUG && _d('Putting onto @arg_lines'); | ||
434 | 4981 | } | ||
435 | 4982 | } | ||
436 | 4983 | |||
437 | 4984 | else { | ||
438 | 4985 | $done = 1; | ||
439 | 4986 | PTDEBUG && _d('Line is case 3, event is done'); | ||
440 | 4987 | |||
441 | 4988 | if ( @arg_lines ) { | ||
442 | 4989 | $self->pending($new_pos, $line); | ||
443 | 4990 | PTDEBUG && _d('There was @arg_lines, putting line to pending'); | ||
444 | 4991 | } | ||
445 | 4992 | |||
446 | 4993 | else { | ||
447 | 4994 | PTDEBUG && _d('No need to defer, process event from this line now'); | ||
448 | 4995 | push @properties, 'cmd', 'Admin', 'arg', $label; | ||
449 | 4996 | |||
450 | 4997 | if ( $label =~ m/\A(?:dis)?connection(?: received| authorized)?\Z/ ) { | ||
451 | 4998 | push @properties, $self->get_meta($rest); | ||
452 | 4999 | } | ||
453 | 5000 | |||
454 | 5001 | else { | ||
455 | 5002 | die "I don't understand line $line"; | ||
456 | 5003 | } | ||
457 | 5004 | |||
458 | 5005 | } | ||
459 | 5006 | } | ||
460 | 5007 | |||
461 | 5008 | } | ||
462 | 5009 | |||
463 | 5010 | else { | ||
464 | 5011 | die "I don't understand line $line"; | ||
465 | 5012 | } | ||
466 | 5013 | |||
467 | 5014 | if ( !$done ) { | ||
468 | 5015 | ($new_pos, $line) = $self->get_line(); | ||
469 | 5016 | } | ||
470 | 5017 | } # LINE | ||
471 | 5018 | |||
472 | 5019 | if ( !defined $line ) { | ||
473 | 5020 | PTDEBUG && _d('Line not defined, at EOF; calling oktorun(0) if exists'); | ||
474 | 5021 | $args{oktorun}->(0) if $args{oktorun}; | ||
475 | 5022 | if ( !@arg_lines ) { | ||
476 | 5023 | PTDEBUG && _d('No saved @arg_lines either, we are all done'); | ||
477 | 5024 | return undef; | ||
478 | 5025 | } | ||
479 | 5026 | } | ||
480 | 5027 | |||
481 | 5028 | if ( $line_type && $line_type ne 'LOG' ) { | ||
482 | 5029 | PTDEBUG && _d('Line is not a LOG line'); | ||
483 | 5030 | |||
484 | 5031 | if ( $line_type eq 'ERROR' ) { | ||
485 | 5032 | PTDEBUG && _d('Line is ERROR'); | ||
486 | 5033 | |||
487 | 5034 | if ( @arg_lines ) { | ||
488 | 5035 | PTDEBUG && _d('There is @arg_lines, will peek ahead one line'); | ||
489 | 5036 | my ( $temp_pos, $temp_line ) = $self->get_line(); | ||
490 | 5037 | my ( $type, $msg ); | ||
491 | 5038 | if ( | ||
492 | 5039 | defined $temp_line | ||
493 | 5040 | && ( ($type, $msg) = $temp_line =~ m/$log_line_regex(.*)/o ) | ||
494 | 5041 | && ( $type ne 'STATEMENT' || $msg eq $arg_lines[-1] ) | ||
495 | 5042 | ) { | ||
496 | 5043 | PTDEBUG && _d('Error/statement line pertain to current event'); | ||
497 | 5044 | push @properties, 'Error_msg', $line =~ m/ERROR:\s*(\S.*)\Z/s; | ||
498 | 5045 | if ( $type ne 'STATEMENT' ) { | ||
499 | 5046 | PTDEBUG && _d('Must save peeked line, it is a', $type); | ||
500 | 5047 | $self->pending($temp_pos, $temp_line); | ||
501 | 5048 | } | ||
502 | 5049 | } | ||
503 | 5050 | elsif ( defined $temp_line && defined $type ) { | ||
504 | 5051 | PTDEBUG && _d('Error/statement line are a new event'); | ||
505 | 5052 | $self->pending($new_pos, $line); | ||
506 | 5053 | $self->pending($temp_pos, $temp_line); | ||
507 | 5054 | } | ||
508 | 5055 | else { | ||
509 | 5056 | PTDEBUG && _d("Unknown line", $line); | ||
510 | 5057 | } | ||
511 | 5058 | } | ||
512 | 5059 | } | ||
513 | 5060 | else { | ||
514 | 5061 | PTDEBUG && _d("Unknown line", $line); | ||
515 | 5062 | } | ||
516 | 5063 | } | ||
517 | 5064 | |||
518 | 5065 | if ( $done || @arg_lines ) { | ||
519 | 5066 | PTDEBUG && _d('Making event'); | ||
520 | 5067 | |||
521 | 5068 | push @properties, 'pos_in_log', $pos_in_log; | ||
522 | 5069 | |||
523 | 5070 | if ( @arg_lines ) { | ||
524 | 5071 | PTDEBUG && _d('Assembling @arg_lines: ', scalar @arg_lines); | ||
525 | 5072 | push @properties, 'arg', join('', @arg_lines), 'cmd', 'Query'; | ||
526 | 5073 | } | ||
527 | 5074 | |||
528 | 5075 | if ( $first_line ) { | ||
529 | 5076 | if ( my ($ts) = $first_line =~ m/([0-9-]{10} [0-9:.]{8,12})/ ) { | ||
530 | 5077 | PTDEBUG && _d('Getting timestamp', $ts); | ||
531 | 5078 | push @properties, 'ts', $ts; | ||
532 | 5079 | } | ||
533 | 5080 | |||
534 | 5081 | if ( my ($meta) = $first_line =~ m/(.*?)[A-Z]{3,}: / ) { | ||
535 | 5082 | PTDEBUG && _d('Found a meta-data chunk:', $meta); | ||
536 | 5083 | push @properties, $self->get_meta($meta); | ||
537 | 5084 | } | ||
538 | 5085 | } | ||
539 | 5086 | |||
540 | 5087 | PTDEBUG && _d('Properties of event:', Dumper(\@properties)); | ||
541 | 5088 | my $event = { @properties }; | ||
542 | 5089 | $event->{bytes} = length($event->{arg} || ''); | ||
543 | 5090 | return $event; | ||
544 | 5091 | } | ||
545 | 5092 | |||
546 | 5093 | } | ||
547 | 5094 | |||
548 | 5095 | sub get_meta { | ||
549 | 5096 | my ( $self, $meta ) = @_; | ||
550 | 5097 | my @properties; | ||
551 | 5098 | foreach my $set ( $meta =~ m/(\w+=[^, ]+)/g ) { | ||
552 | 5099 | my ($key, $val) = split(/=/, $set); | ||
553 | 5100 | if ( $key && $val ) { | ||
554 | 5101 | if ( my $prop = $attrib_name_for{lc substr($key, 0, 1)} ) { | ||
555 | 5102 | push @properties, $prop, $val; | ||
556 | 5103 | } | ||
557 | 5104 | else { | ||
558 | 5105 | PTDEBUG && _d('Bad meta key', $set); | ||
559 | 5106 | } | ||
560 | 5107 | } | ||
561 | 5108 | else { | ||
562 | 5109 | PTDEBUG && _d("Can't figure out meta from", $set); | ||
563 | 5110 | } | ||
564 | 5111 | } | ||
565 | 5112 | return @properties; | ||
566 | 5113 | } | ||
567 | 5114 | |||
568 | 5115 | sub get_line { | ||
569 | 5116 | my ( $self ) = @_; | ||
570 | 5117 | my ($pos, $line, $was_pending) = $self->pending; | ||
571 | 5118 | if ( ! defined $line ) { | ||
572 | 5119 | PTDEBUG && _d('Got nothing from pending, trying the $fh'); | ||
573 | 5120 | my ( $next_event, $tell) = @{$self}{qw(next_event tell)}; | ||
574 | 5121 | eval { | ||
575 | 5122 | $pos = $tell->(); | ||
576 | 5123 | $line = $next_event->(); | ||
577 | 5124 | }; | ||
578 | 5125 | if ( PTDEBUG && $EVAL_ERROR ) { | ||
579 | 5126 | _d($EVAL_ERROR); | ||
580 | 5127 | } | ||
581 | 5128 | } | ||
582 | 5129 | |||
583 | 5130 | PTDEBUG && _d('Got pos/line:', $pos, $line); | ||
584 | 5131 | return ($pos, $line); | ||
585 | 5132 | } | ||
586 | 5133 | |||
587 | 5134 | sub pending { | ||
588 | 5135 | my ( $self, $val, $pos_in_log ) = @_; | ||
589 | 5136 | my $was_pending; | ||
590 | 5137 | PTDEBUG && _d('In sub pending, val:', $val); | ||
591 | 5138 | if ( $val ) { | ||
592 | 5139 | push @{$self->{pending}}, [$val, $pos_in_log]; | ||
593 | 5140 | } | ||
594 | 5141 | elsif ( @{$self->{pending}} ) { | ||
595 | 5142 | ($val, $pos_in_log) = @{ shift @{$self->{pending}} }; | ||
596 | 5143 | $was_pending = 1; | ||
597 | 5144 | } | ||
598 | 5145 | PTDEBUG && _d('Return from pending:', $val, $pos_in_log); | ||
599 | 5146 | return ($val, $pos_in_log, $was_pending); | ||
600 | 5147 | } | ||
601 | 5148 | |||
602 | 5149 | sub generate_wrappers { | ||
603 | 5150 | my ( $self, %args ) = @_; | ||
604 | 5151 | |||
605 | 5152 | if ( ($self->{sanity} || '') ne "$args{next_event}" ){ | ||
606 | 5153 | PTDEBUG && _d("Clearing and recreating internal state"); | ||
607 | 5154 | eval { require SysLogParser; }; # Required for tests to work. | ||
608 | 5155 | my $sl = new SysLogParser(); | ||
609 | 5156 | |||
610 | 5157 | $args{misc}->{new_event_test} = sub { | ||
611 | 5158 | my ( $content ) = @_; | ||
612 | 5159 | return unless defined $content; | ||
613 | 5160 | return $content =~ m/$log_line_regex/o; | ||
614 | 5161 | }; | ||
615 | 5162 | |||
616 | 5163 | $args{misc}->{line_filter} = sub { | ||
617 | 5164 | my ( $content ) = @_; | ||
618 | 5165 | $content =~ s/\A\t/\n/; | ||
619 | 5166 | return $content; | ||
620 | 5167 | }; | ||
621 | 5168 | |||
622 | 5169 | @{$self}{qw(next_event tell is_syslog)} = $sl->make_closures(%args); | ||
623 | 5170 | $self->{sanity} = "$args{next_event}"; | ||
624 | 5171 | } | ||
625 | 5172 | |||
626 | 5173 | return @{$self}{qw(next_event tell is_syslog)}; | ||
627 | 5174 | } | ||
628 | 5175 | |||
629 | 5176 | sub duration_to_secs { | ||
630 | 5177 | my ( $self, $str ) = @_; | ||
631 | 5178 | PTDEBUG && _d('Duration:', $str); | ||
632 | 5179 | my ( $num, $suf ) = split(/\s+/, $str); | ||
633 | 5180 | my $factor = $suf eq 'ms' ? 1000 | ||
634 | 5181 | : $suf eq 'sec' ? 1 | ||
635 | 5182 | : die("Unknown suffix '$suf'"); | ||
636 | 5183 | return $num / $factor; | ||
637 | 5184 | } | ||
638 | 5185 | |||
639 | 5186 | sub _d { | ||
640 | 5187 | my ($package, undef, $line) = caller 0; | ||
641 | 5188 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | ||
642 | 5189 | map { defined $_ ? $_ : 'undef' } | ||
643 | 5190 | @_; | ||
644 | 5191 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | ||
645 | 5192 | } | ||
646 | 5193 | |||
647 | 5194 | 1; | ||
648 | 5195 | } | ||
649 | 5196 | # ########################################################################### | ||
650 | 5197 | # End PgLogParser package | ||
651 | 5198 | # ########################################################################### | ||
652 | 5199 | |||
653 | 5200 | # ########################################################################### | ||
654 | 5201 | # SlowLogParser package | 4582 | # SlowLogParser package |
655 | 5202 | # This package is a copy without comments from the original. The original | 4583 | # This package is a copy without comments from the original. The original |
656 | 5203 | # with comments and its test file can be found in the Bazaar repository at, | 4584 | # with comments and its test file can be found in the Bazaar repository at, |
657 | @@ -7197,9 +6578,7 @@ | |||
658 | 7197 | } | 6578 | } |
659 | 7198 | 6579 | ||
660 | 7199 | my $log_type = $args{log_type} || ''; | 6580 | my $log_type = $args{log_type} || ''; |
664 | 7200 | my $mark = $log_type eq 'memcached' | 6581 | my $mark = '\G'; |
662 | 7201 | || $log_type eq 'http' | ||
663 | 7202 | || $log_type eq 'pglog' ? '' : '\G'; | ||
665 | 7203 | 6582 | ||
666 | 7204 | if ( $item =~ m/^(?:[\(\s]*select|insert|replace)/ ) { | 6583 | if ( $item =~ m/^(?:[\(\s]*select|insert|replace)/ ) { |
667 | 7205 | if ( $item =~ m/^(?:insert|replace)/ ) { # No EXPLAIN | 6584 | if ( $item =~ m/^(?:insert|replace)/ ) { # No EXPLAIN |
668 | @@ -9453,522 +8832,6 @@ | |||
669 | 9453 | # ########################################################################### | 8832 | # ########################################################################### |
670 | 9454 | 8833 | ||
671 | 9455 | # ########################################################################### | 8834 | # ########################################################################### |
672 | 9456 | # MemcachedProtocolParser package | ||
673 | 9457 | # This package is a copy without comments from the original. The original | ||
674 | 9458 | # with comments and its test file can be found in the Bazaar repository at, | ||
675 | 9459 | # lib/MemcachedProtocolParser.pm | ||
676 | 9460 | # t/lib/MemcachedProtocolParser.t | ||
677 | 9461 | # See https://launchpad.net/percona-toolkit for more information. | ||
678 | 9462 | # ########################################################################### | ||
679 | 9463 | { | ||
680 | 9464 | package MemcachedProtocolParser; | ||
681 | 9465 | |||
682 | 9466 | use strict; | ||
683 | 9467 | use warnings FATAL => 'all'; | ||
684 | 9468 | use English qw(-no_match_vars); | ||
685 | 9469 | |||
686 | 9470 | use Data::Dumper; | ||
687 | 9471 | $Data::Dumper::Indent = 1; | ||
688 | 9472 | $Data::Dumper::Sortkeys = 1; | ||
689 | 9473 | $Data::Dumper::Quotekeys = 0; | ||
690 | 9474 | |||
691 | 9475 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
692 | 9476 | |||
693 | 9477 | sub new { | ||
694 | 9478 | my ( $class, %args ) = @_; | ||
695 | 9479 | |||
696 | 9480 | my $self = { | ||
697 | 9481 | server => $args{server}, | ||
698 | 9482 | port => $args{port} || '11211', | ||
699 | 9483 | sessions => {}, | ||
700 | 9484 | o => $args{o}, | ||
701 | 9485 | }; | ||
702 | 9486 | return bless $self, $class; | ||
703 | 9487 | } | ||
704 | 9488 | |||
705 | 9489 | sub parse_event { | ||
706 | 9490 | my ( $self, %args ) = @_; | ||
707 | 9491 | my @required_args = qw(event); | ||
708 | 9492 | foreach my $arg ( @required_args ) { | ||
709 | 9493 | die "I need a $arg argument" unless $args{$arg}; | ||
710 | 9494 | } | ||
711 | 9495 | my $packet = @args{@required_args}; | ||
712 | 9496 | |||
713 | 9497 | if ( $packet->{data_len} == 0 ) { | ||
714 | 9498 | PTDEBUG && _d('No TCP data'); | ||
715 | 9499 | $args{stats}->{no_tcp_data}++ if $args{stats}; | ||
716 | 9500 | return; | ||
717 | 9501 | } | ||
718 | 9502 | |||
719 | 9503 | my $src_host = "$packet->{src_host}:$packet->{src_port}"; | ||
720 | 9504 | my $dst_host = "$packet->{dst_host}:$packet->{dst_port}"; | ||
721 | 9505 | |||
722 | 9506 | if ( my $server = $self->{server} ) { # Watch only the given server. | ||
723 | 9507 | $server .= ":$self->{port}"; | ||
724 | 9508 | if ( $src_host ne $server && $dst_host ne $server ) { | ||
725 | 9509 | PTDEBUG && _d('Packet is not to or from', $server); | ||
726 | 9510 | $args{stats}->{not_watched_server}++ if $args{stats}; | ||
727 | 9511 | return; | ||
728 | 9512 | } | ||
729 | 9513 | } | ||
730 | 9514 | |||
731 | 9515 | my $packet_from; | ||
732 | 9516 | my $client; | ||
733 | 9517 | if ( $src_host =~ m/:$self->{port}$/ ) { | ||
734 | 9518 | $packet_from = 'server'; | ||
735 | 9519 | $client = $dst_host; | ||
736 | 9520 | } | ||
737 | 9521 | elsif ( $dst_host =~ m/:$self->{port}$/ ) { | ||
738 | 9522 | $packet_from = 'client'; | ||
739 | 9523 | $client = $src_host; | ||
740 | 9524 | } | ||
741 | 9525 | else { | ||
742 | 9526 | warn 'Packet is not to or from memcached server: ', Dumper($packet); | ||
743 | 9527 | return; | ||
744 | 9528 | } | ||
745 | 9529 | PTDEBUG && _d('Client:', $client); | ||
746 | 9530 | |||
747 | 9531 | if ( !exists $self->{sessions}->{$client} ) { | ||
748 | 9532 | PTDEBUG && _d('New session'); | ||
749 | 9533 | $self->{sessions}->{$client} = { | ||
750 | 9534 | client => $client, | ||
751 | 9535 | state => undef, | ||
752 | 9536 | raw_packets => [], | ||
753 | 9537 | }; | ||
754 | 9538 | }; | ||
755 | 9539 | my $session = $self->{sessions}->{$client}; | ||
756 | 9540 | |||
757 | 9541 | push @{$session->{raw_packets}}, $packet->{raw_packet}; | ||
758 | 9542 | |||
759 | 9543 | $packet->{data} = pack('H*', $packet->{data}); | ||
760 | 9544 | my $event; | ||
761 | 9545 | if ( $packet_from eq 'server' ) { | ||
762 | 9546 | $event = $self->_packet_from_server($packet, $session, %args); | ||
763 | 9547 | } | ||
764 | 9548 | elsif ( $packet_from eq 'client' ) { | ||
765 | 9549 | $event = $self->_packet_from_client($packet, $session, %args); | ||
766 | 9550 | } | ||
767 | 9551 | else { | ||
768 | 9552 | $args{stats}->{unknown_packet_origin}++ if $args{stats}; | ||
769 | 9553 | die 'Packet origin unknown'; | ||
770 | 9554 | } | ||
771 | 9555 | |||
772 | 9556 | PTDEBUG && _d('Done with packet; event:', Dumper($event)); | ||
773 | 9557 | $args{stats}->{events_parsed}++ if $args{stats}; | ||
774 | 9558 | return $event; | ||
775 | 9559 | } | ||
776 | 9560 | |||
777 | 9561 | sub _packet_from_server { | ||
778 | 9562 | my ( $self, $packet, $session, %args ) = @_; | ||
779 | 9563 | die "I need a packet" unless $packet; | ||
780 | 9564 | die "I need a session" unless $session; | ||
781 | 9565 | |||
782 | 9566 | PTDEBUG && _d('Packet is from server; client state:', $session->{state}); | ||
783 | 9567 | |||
784 | 9568 | my $data = $packet->{data}; | ||
785 | 9569 | |||
786 | 9570 | if ( !$session->{state} ) { | ||
787 | 9571 | PTDEBUG && _d('Ignoring mid-stream server response'); | ||
788 | 9572 | $args{stats}->{ignored_midstream_server_response}++ if $args{stats}; | ||
789 | 9573 | return; | ||
790 | 9574 | } | ||
791 | 9575 | |||
792 | 9576 | if ( $session->{state} eq 'awaiting reply' ) { | ||
793 | 9577 | PTDEBUG && _d('State is awaiting reply'); | ||
794 | 9578 | my ($line1, $rest) = $packet->{data} =~ m/\A(.*?)\r\n(.*)?/s; | ||
795 | 9579 | if ( !$line1 ) { | ||
796 | 9580 | $args{stats}->{unknown_server_data}++ if $args{stats}; | ||
797 | 9581 | die "Unknown memcached data from server"; | ||
798 | 9582 | } | ||
799 | 9583 | |||
800 | 9584 | my @vals = $line1 =~ m/(\S+)/g; | ||
801 | 9585 | $session->{res} = shift @vals; | ||
802 | 9586 | PTDEBUG && _d('Result of last', $session->{cmd}, 'cmd:', $session->{res}); | ||
803 | 9587 | |||
804 | 9588 | if ( $session->{cmd} eq 'incr' || $session->{cmd} eq 'decr' ) { | ||
805 | 9589 | PTDEBUG && _d('It is an incr or decr'); | ||
806 | 9590 | if ( $session->{res} !~ m/\D/ ) { # It's an integer, not an error | ||
807 | 9591 | PTDEBUG && _d('Got a value for the incr/decr'); | ||
808 | 9592 | $session->{val} = $session->{res}; | ||
809 | 9593 | $session->{res} = ''; | ||
810 | 9594 | } | ||
811 | 9595 | } | ||
812 | 9596 | elsif ( $session->{res} eq 'VALUE' ) { | ||
813 | 9597 | PTDEBUG && _d('It is the result of a "get"'); | ||
814 | 9598 | my ($key, $flags, $bytes) = @vals; | ||
815 | 9599 | defined $session->{flags} or $session->{flags} = $flags; | ||
816 | 9600 | defined $session->{bytes} or $session->{bytes} = $bytes; | ||
817 | 9601 | |||
818 | 9602 | if ( $rest && $bytes ) { | ||
819 | 9603 | PTDEBUG && _d('There is a value'); | ||
820 | 9604 | if ( length($rest) > $bytes ) { | ||
821 | 9605 | PTDEBUG && _d('Got complete response'); | ||
822 | 9606 | $session->{val} = substr($rest, 0, $bytes); | ||
823 | 9607 | } | ||
824 | 9608 | else { | ||
825 | 9609 | PTDEBUG && _d('Got partial response, saving for later'); | ||
826 | 9610 | push @{$session->{partial}}, [ $packet->{seq}, $rest ]; | ||
827 | 9611 | $session->{gathered} += length($rest); | ||
828 | 9612 | $session->{state} = 'partial recv'; | ||
829 | 9613 | return; # Prevent firing an event. | ||
830 | 9614 | } | ||
831 | 9615 | } | ||
832 | 9616 | } | ||
833 | 9617 | elsif ( $session->{res} eq 'END' ) { | ||
834 | 9618 | PTDEBUG && _d('Got an END without any data, firing NOT_FOUND'); | ||
835 | 9619 | $session->{res} = 'NOT_FOUND'; | ||
836 | 9620 | } | ||
837 | 9621 | elsif ( $session->{res} !~ m/STORED|DELETED|NOT_FOUND/ ) { | ||
838 | 9622 | PTDEBUG && _d('Unknown result'); | ||
839 | 9623 | } | ||
840 | 9624 | else { | ||
841 | 9625 | $args{stats}->{unknown_server_response}++ if $args{stats}; | ||
842 | 9626 | } | ||
843 | 9627 | } | ||
844 | 9628 | else { # Should be 'partial recv' | ||
845 | 9629 | PTDEBUG && _d('Session state: ', $session->{state}); | ||
846 | 9630 | push @{$session->{partial}}, [ $packet->{seq}, $data ]; | ||
847 | 9631 | $session->{gathered} += length($data); | ||
848 | 9632 | PTDEBUG && _d('Gathered', $session->{gathered}, 'bytes in', | ||
849 | 9633 | scalar(@{$session->{partial}}), 'packets from server'); | ||
850 | 9634 | if ( $session->{gathered} >= $session->{bytes} + 2 ) { # Done. | ||
851 | 9635 | PTDEBUG && _d('End of partial response, preparing event'); | ||
852 | 9636 | my $val = join('', | ||
853 | 9637 | map { $_->[1] } | ||
854 | 9638 | sort { $a->[0] <=> $b->[0] } | ||
855 | 9639 | @{$session->{partial}}); | ||
856 | 9640 | $session->{val} = substr($val, 0, $session->{bytes}); | ||
857 | 9641 | } | ||
858 | 9642 | else { | ||
859 | 9643 | PTDEBUG && _d('Partial response continues, no action'); | ||
860 | 9644 | return; # Prevent firing event. | ||
861 | 9645 | } | ||
862 | 9646 | } | ||
863 | 9647 | |||
864 | 9648 | PTDEBUG && _d('Creating event, deleting session'); | ||
865 | 9649 | my $event = make_event($session, $packet); | ||
866 | 9650 | delete $self->{sessions}->{$session->{client}}; # memcached is stateless! | ||
867 | 9651 | $session->{raw_packets} = []; # Avoid keeping forever | ||
868 | 9652 | return $event; | ||
869 | 9653 | } | ||
870 | 9654 | |||
871 | 9655 | sub _packet_from_client { | ||
872 | 9656 | my ( $self, $packet, $session, %args ) = @_; | ||
873 | 9657 | die "I need a packet" unless $packet; | ||
874 | 9658 | die "I need a session" unless $session; | ||
875 | 9659 | |||
876 | 9660 | PTDEBUG && _d('Packet is from client; state:', $session->{state}); | ||
877 | 9661 | |||
878 | 9662 | my $event; | ||
879 | 9663 | if ( ($session->{state} || '') =~m/awaiting reply|partial recv/ ) { | ||
880 | 9664 | PTDEBUG && _d("Expected data from the client, looks like interrupted"); | ||
881 | 9665 | $session->{res} = 'INTERRUPTED'; | ||
882 | 9666 | $event = make_event($session, $packet); | ||
883 | 9667 | my $client = $session->{client}; | ||
884 | 9668 | delete @{$session}{keys %$session}; | ||
885 | 9669 | $session->{client} = $client; | ||
886 | 9670 | } | ||
887 | 9671 | |||
888 | 9672 | my ($line1, $val); | ||
889 | 9673 | my ($cmd, $key, $flags, $exptime, $bytes); | ||
890 | 9674 | |||
891 | 9675 | if ( !$session->{state} ) { | ||
892 | 9676 | PTDEBUG && _d('Session state: ', $session->{state}); | ||
893 | 9677 | ($line1, $val) = $packet->{data} =~ m/\A(.*?)\r\n(.+)?/s; | ||
894 | 9678 | if ( !$line1 ) { | ||
895 | 9679 | PTDEBUG && _d('Unknown memcached data from client, skipping packet'); | ||
896 | 9680 | $args{stats}->{unknown_client_data}++ if $args{stats}; | ||
897 | 9681 | return; | ||
898 | 9682 | } | ||
899 | 9683 | |||
900 | 9684 | my @vals = $line1 =~ m/(\S+)/g; | ||
901 | 9685 | $cmd = lc shift @vals; | ||
902 | 9686 | PTDEBUG && _d('$cmd is a ', $cmd); | ||
903 | 9687 | if ( $cmd eq 'set' || $cmd eq 'add' || $cmd eq 'replace' ) { | ||
904 | 9688 | ($key, $flags, $exptime, $bytes) = @vals; | ||
905 | 9689 | $session->{bytes} = $bytes; | ||
906 | 9690 | } | ||
907 | 9691 | elsif ( $cmd eq 'get' ) { | ||
908 | 9692 | ($key) = @vals; | ||
909 | 9693 | if ( $val ) { | ||
910 | 9694 | PTDEBUG && _d('Multiple cmds:', $val); | ||
911 | 9695 | $val = undef; | ||
912 | 9696 | } | ||
913 | 9697 | } | ||
914 | 9698 | elsif ( $cmd eq 'delete' ) { | ||
915 | 9699 | ($key) = @vals; # TODO: handle the <queue_time> | ||
916 | 9700 | if ( $val ) { | ||
917 | 9701 | PTDEBUG && _d('Multiple cmds:', $val); | ||
918 | 9702 | $val = undef; | ||
919 | 9703 | } | ||
920 | 9704 | } | ||
921 | 9705 | elsif ( $cmd eq 'incr' || $cmd eq 'decr' ) { | ||
922 | 9706 | ($key) = @vals; | ||
923 | 9707 | } | ||
924 | 9708 | else { | ||
925 | 9709 | PTDEBUG && _d("Don't know how to handle", $cmd, "command"); | ||
926 | 9710 | $args{stats}->{unknown_client_command}++ if $args{stats}; | ||
927 | 9711 | return; | ||
928 | 9712 | } | ||
929 | 9713 | |||
930 | 9714 | @{$session}{qw(cmd key flags exptime)} | ||
931 | 9715 | = ($cmd, $key, $flags, $exptime); | ||
932 | 9716 | $session->{host} = $packet->{src_host}; | ||
933 | 9717 | $session->{pos_in_log} = $packet->{pos_in_log}; | ||
934 | 9718 | $session->{ts} = $packet->{ts}; | ||
935 | 9719 | } | ||
936 | 9720 | else { | ||
937 | 9721 | PTDEBUG && _d('Session state: ', $session->{state}); | ||
938 | 9722 | $val = $packet->{data}; | ||
939 | 9723 | } | ||
940 | 9724 | |||
941 | 9725 | $session->{state} = 'awaiting reply'; # Assume we got the whole packet | ||
942 | 9726 | if ( $val ) { | ||
943 | 9727 | if ( $session->{bytes} + 2 == length($val) ) { # +2 for the \r\n | ||
944 | 9728 | PTDEBUG && _d('Complete send'); | ||
945 | 9729 | $val =~ s/\r\n\Z//; # We got the whole thing. | ||
946 | 9730 | $session->{val} = $val; | ||
947 | 9731 | } | ||
948 | 9732 | else { # We apparently did NOT get the whole thing. | ||
949 | 9733 | PTDEBUG && _d('Partial send, saving for later'); | ||
950 | 9734 | push @{$session->{partial}}, | ||
951 | 9735 | [ $packet->{seq}, $val ]; | ||
952 | 9736 | $session->{gathered} += length($val); | ||
953 | 9737 | PTDEBUG && _d('Gathered', $session->{gathered}, 'bytes in', | ||
954 | 9738 | scalar(@{$session->{partial}}), 'packets from client'); | ||
955 | 9739 | if ( $session->{gathered} >= $session->{bytes} + 2 ) { # Done. | ||
956 | 9740 | PTDEBUG && _d('Message looks complete now, saving value'); | ||
957 | 9741 | $val = join('', | ||
958 | 9742 | map { $_->[1] } | ||
959 | 9743 | sort { $a->[0] <=> $b->[0] } | ||
960 | 9744 | @{$session->{partial}}); | ||
961 | 9745 | $val =~ s/\r\n\Z//; | ||
962 | 9746 | $session->{val} = $val; | ||
963 | 9747 | } | ||
964 | 9748 | else { | ||
965 | 9749 | PTDEBUG && _d('Message not complete'); | ||
966 | 9750 | $val = '[INCOMPLETE]'; | ||
967 | 9751 | $session->{state} = 'partial send'; | ||
968 | 9752 | } | ||
969 | 9753 | } | ||
970 | 9754 | } | ||
971 | 9755 | |||
972 | 9756 | return $event; | ||
973 | 9757 | } | ||
974 | 9758 | |||
975 | 9759 | sub make_event { | ||
976 | 9760 | my ( $session, $packet ) = @_; | ||
977 | 9761 | my $event = { | ||
978 | 9762 | cmd => $session->{cmd}, | ||
979 | 9763 | key => $session->{key}, | ||
980 | 9764 | val => $session->{val} || '', | ||
981 | 9765 | res => $session->{res}, | ||
982 | 9766 | ts => $session->{ts}, | ||
983 | 9767 | host => $session->{host}, | ||
984 | 9768 | flags => $session->{flags} || 0, | ||
985 | 9769 | exptime => $session->{exptime} || 0, | ||
986 | 9770 | bytes => $session->{bytes} || 0, | ||
987 | 9771 | Query_time => timestamp_diff($session->{ts}, $packet->{ts}), | ||
988 | 9772 | pos_in_log => $session->{pos_in_log}, | ||
989 | 9773 | }; | ||
990 | 9774 | return $event; | ||
991 | 9775 | } | ||
992 | 9776 | |||
993 | 9777 | sub _get_errors_fh { | ||
994 | 9778 | my ( $self ) = @_; | ||
995 | 9779 | my $errors_fh = $self->{errors_fh}; | ||
996 | 9780 | return $errors_fh if $errors_fh; | ||
997 | 9781 | |||
998 | 9782 | my $o = $self->{o}; | ||
999 | 9783 | if ( $o && $o->has('tcpdump-errors') && $o->got('tcpdump-errors') ) { | ||
1000 | 9784 | my $errors_file = $o->get('tcpdump-errors'); | ||
1001 | 9785 | PTDEBUG && _d('tcpdump-errors file:', $errors_file); | ||
1002 | 9786 | open $errors_fh, '>>', $errors_file | ||
1003 | 9787 | or die "Cannot open tcpdump-errors file $errors_file: $OS_ERROR"; | ||
1004 | 9788 | } | ||
1005 | 9789 | |||
1006 | 9790 | $self->{errors_fh} = $errors_fh; | ||
1007 | 9791 | return $errors_fh; | ||
1008 | 9792 | } | ||
1009 | 9793 | |||
1010 | 9794 | sub _d { | ||
1011 | 9795 | my ($package, undef, $line) = caller 0; | ||
1012 | 9796 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | ||
1013 | 9797 | map { defined $_ ? $_ : 'undef' } | ||
1014 | 9798 | @_; | ||
1015 | 9799 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | ||
1016 | 9800 | } | ||
1017 | 9801 | |||
1018 | 9802 | sub timestamp_diff { | ||
1019 | 9803 | my ( $start, $end ) = @_; | ||
1020 | 9804 | my $sd = substr($start, 0, 11, ''); | ||
1021 | 9805 | my $ed = substr($end, 0, 11, ''); | ||
1022 | 9806 | my ( $sh, $sm, $ss ) = split(/:/, $start); | ||
1023 | 9807 | my ( $eh, $em, $es ) = split(/:/, $end); | ||
1024 | 9808 | my $esecs = ($eh * 3600 + $em * 60 + $es); | ||
1025 | 9809 | my $ssecs = ($sh * 3600 + $sm * 60 + $ss); | ||
1026 | 9810 | if ( $sd eq $ed ) { | ||
1027 | 9811 | return sprintf '%.6f', $esecs - $ssecs; | ||
1028 | 9812 | } | ||
1029 | 9813 | else { # Assume only one day boundary has been crossed, no DST, etc | ||
1030 | 9814 | return sprintf '%.6f', ( 86_400 - $ssecs ) + $esecs; | ||
1031 | 9815 | } | ||
1032 | 9816 | } | ||
1033 | 9817 | |||
1034 | 9818 | 1; | ||
1035 | 9819 | } | ||
1036 | 9820 | # ########################################################################### | ||
1037 | 9821 | # End MemcachedProtocolParser package | ||
1038 | 9822 | # ########################################################################### | ||
1039 | 9823 | |||
1040 | 9824 | # ########################################################################### | ||
1041 | 9825 | # MemcachedEvent package | ||
1042 | 9826 | # This package is a copy without comments from the original. The original | ||
1043 | 9827 | # with comments and its test file can be found in the Bazaar repository at, | ||
1044 | 9828 | # lib/MemcachedEvent.pm | ||
1045 | 9829 | # t/lib/MemcachedEvent.t | ||
1046 | 9830 | # See https://launchpad.net/percona-toolkit for more information. | ||
1047 | 9831 | # ########################################################################### | ||
1048 | 9832 | { | ||
1049 | 9833 | package MemcachedEvent; | ||
1050 | 9834 | |||
1051 | 9835 | use strict; | ||
1052 | 9836 | use warnings FATAL => 'all'; | ||
1053 | 9837 | use English qw(-no_match_vars); | ||
1054 | 9838 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
1055 | 9839 | |||
1056 | 9840 | use Data::Dumper; | ||
1057 | 9841 | $Data::Dumper::Indent = 1; | ||
1058 | 9842 | $Data::Dumper::Sortkeys = 1; | ||
1059 | 9843 | $Data::Dumper::Quotekeys = 0; | ||
1060 | 9844 | |||
1061 | 9845 | my %cmds = map { $_ => 1 } qw( | ||
1062 | 9846 | set | ||
1063 | 9847 | add | ||
1064 | 9848 | replace | ||
1065 | 9849 | append | ||
1066 | 9850 | prepend | ||
1067 | 9851 | cas | ||
1068 | 9852 | get | ||
1069 | 9853 | gets | ||
1070 | 9854 | delete | ||
1071 | 9855 | incr | ||
1072 | 9856 | decr | ||
1073 | 9857 | ); | ||
1074 | 9858 | |||
1075 | 9859 | my %cmd_handler_for = ( | ||
1076 | 9860 | set => \&handle_storage_cmd, | ||
1077 | 9861 | add => \&handle_storage_cmd, | ||
1078 | 9862 | replace => \&handle_storage_cmd, | ||
1079 | 9863 | append => \&handle_storage_cmd, | ||
1080 | 9864 | prepend => \&handle_storage_cmd, | ||
1081 | 9865 | cas => \&handle_storage_cmd, | ||
1082 | 9866 | get => \&handle_retr_cmd, | ||
1083 | 9867 | gets => \&handle_retr_cmd, | ||
1084 | 9868 | ); | ||
1085 | 9869 | |||
1086 | 9870 | sub new { | ||
1087 | 9871 | my ( $class, %args ) = @_; | ||
1088 | 9872 | my $self = {}; | ||
1089 | 9873 | return bless $self, $class; | ||
1090 | 9874 | } | ||
1091 | 9875 | |||
1092 | 9876 | sub parse_event { | ||
1093 | 9877 | my ( $self, %args ) = @_; | ||
1094 | 9878 | my $event = $args{event}; | ||
1095 | 9879 | return unless $event; | ||
1096 | 9880 | |||
1097 | 9881 | if ( !$event->{cmd} || !$event->{key} ) { | ||
1098 | 9882 | PTDEBUG && _d('Event has no cmd or key:', Dumper($event)); | ||
1099 | 9883 | return; | ||
1100 | 9884 | } | ||
1101 | 9885 | |||
1102 | 9886 | if ( !$cmds{$event->{cmd}} ) { | ||
1103 | 9887 | PTDEBUG && _d("Don't know how to handle cmd:", $event->{cmd}); | ||
1104 | 9888 | return; | ||
1105 | 9889 | } | ||
1106 | 9890 | |||
1107 | 9891 | $event->{arg} = "$event->{cmd} $event->{key}"; | ||
1108 | 9892 | $event->{fingerprint} = $self->fingerprint($event->{arg}); | ||
1109 | 9893 | $event->{key_print} = $self->fingerprint($event->{key}); | ||
1110 | 9894 | |||
1111 | 9895 | map { $event->{"Memc_$_"} = 'No' } keys %cmds; | ||
1112 | 9896 | $event->{"Memc_$event->{cmd}"} = 'Yes'; # Got this cmd. | ||
1113 | 9897 | $event->{Memc_error} = 'No'; # A handler may change this. | ||
1114 | 9898 | $event->{Memc_miss} = 'No'; | ||
1115 | 9899 | if ( $event->{res} ) { | ||
1116 | 9900 | $event->{Memc_miss} = 'Yes' if $event->{res} eq 'NOT_FOUND'; | ||
1117 | 9901 | } | ||
1118 | 9902 | else { | ||
1119 | 9903 | PTDEBUG && _d('Event has no res:', Dumper($event)); | ||
1120 | 9904 | } | ||
1121 | 9905 | |||
1122 | 9906 | if ( $cmd_handler_for{$event->{cmd}} ) { | ||
1123 | 9907 | return $cmd_handler_for{$event->{cmd}}->($event); | ||
1124 | 9908 | } | ||
1125 | 9909 | |||
1126 | 9910 | return $event; | ||
1127 | 9911 | } | ||
1128 | 9912 | |||
1129 | 9913 | sub fingerprint { | ||
1130 | 9914 | my ( $self, $val ) = @_; | ||
1131 | 9915 | $val =~ s/[0-9A-Fa-f]{16,}|\d+/?/g; | ||
1132 | 9916 | return $val; | ||
1133 | 9917 | } | ||
1134 | 9918 | |||
1135 | 9919 | sub handle_storage_cmd { | ||
1136 | 9920 | my ( $event ) = @_; | ||
1137 | 9921 | |||
1138 | 9922 | if ( !$event->{res} ) { | ||
1139 | 9923 | PTDEBUG && _d('No result for event:', Dumper($event)); | ||
1140 | 9924 | return; | ||
1141 | 9925 | } | ||
1142 | 9926 | |||
1143 | 9927 | $event->{'Memc_Not_Stored'} = $event->{res} eq 'NOT_STORED' ? 'Yes' : 'No'; | ||
1144 | 9928 | $event->{'Memc_Exists'} = $event->{res} eq 'EXISTS' ? 'Yes' : 'No'; | ||
1145 | 9929 | |||
1146 | 9930 | return $event; | ||
1147 | 9931 | } | ||
1148 | 9932 | |||
1149 | 9933 | sub handle_retr_cmd { | ||
1150 | 9934 | my ( $event ) = @_; | ||
1151 | 9935 | |||
1152 | 9936 | if ( !$event->{res} ) { | ||
1153 | 9937 | PTDEBUG && _d('No result for event:', Dumper($event)); | ||
1154 | 9938 | return; | ||
1155 | 9939 | } | ||
1156 | 9940 | |||
1157 | 9941 | $event->{'Memc_error'} = $event->{res} eq 'INTERRUPTED' ? 'Yes' : 'No'; | ||
1158 | 9942 | |||
1159 | 9943 | return $event; | ||
1160 | 9944 | } | ||
1161 | 9945 | |||
1162 | 9946 | |||
1163 | 9947 | sub handle_delete { | ||
1164 | 9948 | my ( $event ) = @_; | ||
1165 | 9949 | return $event; | ||
1166 | 9950 | } | ||
1167 | 9951 | |||
1168 | 9952 | sub handle_incr_decr_cmd { | ||
1169 | 9953 | my ( $event ) = @_; | ||
1170 | 9954 | return $event; | ||
1171 | 9955 | } | ||
1172 | 9956 | |||
1173 | 9957 | sub _d { | ||
1174 | 9958 | my ($package, undef, $line) = caller 0; | ||
1175 | 9959 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | ||
1176 | 9960 | map { defined $_ ? $_ : 'undef' } | ||
1177 | 9961 | @_; | ||
1178 | 9962 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | ||
1179 | 9963 | } | ||
1180 | 9964 | |||
1181 | 9965 | 1; | ||
1182 | 9966 | } | ||
1183 | 9967 | # ########################################################################### | ||
1184 | 9968 | # End MemcachedEvent package | ||
1185 | 9969 | # ########################################################################### | ||
1186 | 9970 | |||
1187 | 9971 | # ########################################################################### | ||
1188 | 9972 | # BinaryLogParser package | 8835 | # BinaryLogParser package |
1189 | 9973 | # This package is a copy without comments from the original. The original | 8836 | # This package is a copy without comments from the original. The original |
1190 | 9974 | # with comments and its test file can be found in the Bazaar repository at, | 8837 | # with comments and its test file can be found in the Bazaar repository at, |
1191 | @@ -10719,209 +9582,6 @@ | |||
1192 | 10719 | # ########################################################################### | 9582 | # ########################################################################### |
1193 | 10720 | 9583 | ||
1194 | 10721 | # ########################################################################### | 9584 | # ########################################################################### |
1195 | 10722 | # HTTPProtocolParser package | ||
1196 | 10723 | # This package is a copy without comments from the original. The original | ||
1197 | 10724 | # with comments and its test file can be found in the Bazaar repository at, | ||
1198 | 10725 | # lib/HTTPProtocolParser.pm | ||
1199 | 10726 | # t/lib/HTTPProtocolParser.t | ||
1200 | 10727 | # See https://launchpad.net/percona-toolkit for more information. | ||
1201 | 10728 | # ########################################################################### | ||
1202 | 10729 | { | ||
1203 | 10730 | package HTTPProtocolParser; | ||
1204 | 10731 | use base 'ProtocolParser'; | ||
1205 | 10732 | |||
1206 | 10733 | use strict; | ||
1207 | 10734 | use warnings FATAL => 'all'; | ||
1208 | 10735 | use English qw(-no_match_vars); | ||
1209 | 10736 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
1210 | 10737 | |||
1211 | 10738 | sub new { | ||
1212 | 10739 | my ( $class, %args ) = @_; | ||
1213 | 10740 | my $self = $class->SUPER::new( | ||
1214 | 10741 | %args, | ||
1215 | 10742 | port => 80, | ||
1216 | 10743 | ); | ||
1217 | 10744 | return $self; | ||
1218 | 10745 | } | ||
1219 | 10746 | |||
1220 | 10747 | sub _packet_from_server { | ||
1221 | 10748 | my ( $self, $packet, $session, $misc ) = @_; | ||
1222 | 10749 | die "I need a packet" unless $packet; | ||
1223 | 10750 | die "I need a session" unless $session; | ||
1224 | 10751 | |||
1225 | 10752 | PTDEBUG && _d('Packet is from server; client state:', $session->{state}); | ||
1226 | 10753 | |||
1227 | 10754 | if ( !$session->{state} ) { | ||
1228 | 10755 | PTDEBUG && _d('Ignoring mid-stream server response'); | ||
1229 | 10756 | return; | ||
1230 | 10757 | } | ||
1231 | 10758 | |||
1232 | 10759 | if ( $session->{out_of_order} ) { | ||
1233 | 10760 | my ($line1, $content); | ||
1234 | 10761 | if ( !$session->{have_header} ) { | ||
1235 | 10762 | ($line1, $content) = $self->_parse_header( | ||
1236 | 10763 | $session, $packet->{data}, $packet->{data_len}); | ||
1237 | 10764 | } | ||
1238 | 10765 | if ( $line1 ) { | ||
1239 | 10766 | $session->{have_header} = 1; | ||
1240 | 10767 | $packet->{content_len} = length $content; | ||
1241 | 10768 | PTDEBUG && _d('Got out of order header with', | ||
1242 | 10769 | $packet->{content_len}, 'bytes of content'); | ||
1243 | 10770 | } | ||
1244 | 10771 | my $have_len = $packet->{content_len} || $packet->{data_len}; | ||
1245 | 10772 | map { $have_len += $_->{data_len} } | ||
1246 | 10773 | @{$session->{packets}}; | ||
1247 | 10774 | $session->{have_all_packets} | ||
1248 | 10775 | = 1 if $session->{attribs}->{bytes} | ||
1249 | 10776 | && $have_len >= $session->{attribs}->{bytes}; | ||
1250 | 10777 | PTDEBUG && _d('Have', $have_len, 'of', $session->{attribs}->{bytes}); | ||
1251 | 10778 | return; | ||
1252 | 10779 | } | ||
1253 | 10780 | |||
1254 | 10781 | if ( $session->{state} eq 'awaiting reply' ) { | ||
1255 | 10782 | |||
1256 | 10783 | $session->{start_reply} = $packet->{ts} unless $session->{start_reply}; | ||
1257 | 10784 | |||
1258 | 10785 | my ($line1, $content) = $self->_parse_header($session, $packet->{data}, | ||
1259 | 10786 | $packet->{data_len}); | ||
1260 | 10787 | |||
1261 | 10788 | if ( !$line1 ) { | ||
1262 | 10789 | $session->{out_of_order} = 1; # alert parent | ||
1263 | 10790 | $session->{have_all_packets} = 0; | ||
1264 | 10791 | return; | ||
1265 | 10792 | } | ||
1266 | 10793 | |||
1267 | 10794 | my ($version, $code, $phrase) = $line1 =~ m/(\S+)/g; | ||
1268 | 10795 | $session->{attribs}->{Status_code} = $code; | ||
1269 | 10796 | PTDEBUG && _d('Status code for last', $session->{attribs}->{arg}, | ||
1270 | 10797 | 'request:', $session->{attribs}->{Status_code}); | ||
1271 | 10798 | |||
1272 | 10799 | my $content_len = $content ? length $content : 0; | ||
1273 | 10800 | PTDEBUG && _d('Got', $content_len, 'bytes of content'); | ||
1274 | 10801 | if ( $session->{attribs}->{bytes} | ||
1275 | 10802 | && $content_len < $session->{attribs}->{bytes} ) { | ||
1276 | 10803 | $session->{data_len} = $session->{attribs}->{bytes}; | ||
1277 | 10804 | $session->{buff} = $content; | ||
1278 | 10805 | $session->{buff_left} = $session->{attribs}->{bytes} - $content_len; | ||
1279 | 10806 | PTDEBUG && _d('Contents not complete,', $session->{buff_left}, | ||
1280 | 10807 | 'bytes left'); | ||
1281 | 10808 | $session->{state} = 'recving content'; | ||
1282 | 10809 | return; | ||
1283 | 10810 | } | ||
1284 | 10811 | } | ||
1285 | 10812 | elsif ( $session->{state} eq 'recving content' ) { | ||
1286 | 10813 | if ( $session->{buff} ) { | ||
1287 | 10814 | PTDEBUG && _d('Receiving content,', $session->{buff_left}, | ||
1288 | 10815 | 'bytes left'); | ||
1289 | 10816 | return; | ||
1290 | 10817 | } | ||
1291 | 10818 | PTDEBUG && _d('Contents received'); | ||
1292 | 10819 | } | ||
1293 | 10820 | else { | ||
1294 | 10821 | warn "Server response in unknown state"; | ||
1295 | 10822 | return; | ||
1296 | 10823 | } | ||
1297 | 10824 | |||
1298 | 10825 | PTDEBUG && _d('Creating event, deleting session'); | ||
1299 | 10826 | $session->{end_reply} = $session->{ts_max} || $packet->{ts}; | ||
1300 | 10827 | my $event = $self->make_event($session, $packet); | ||
1301 | 10828 | delete $self->{sessions}->{$session->{client}}; # http is stateless! | ||
1302 | 10829 | return $event; | ||
1303 | 10830 | } | ||
1304 | 10831 | |||
1305 | 10832 | sub _packet_from_client { | ||
1306 | 10833 | my ( $self, $packet, $session, $misc ) = @_; | ||
1307 | 10834 | die "I need a packet" unless $packet; | ||
1308 | 10835 | die "I need a session" unless $session; | ||
1309 | 10836 | |||
1310 | 10837 | PTDEBUG && _d('Packet is from client; state:', $session->{state}); | ||
1311 | 10838 | |||
1312 | 10839 | my $event; | ||
1313 | 10840 | if ( ($session->{state} || '') =~ m/awaiting / ) { | ||
1314 | 10841 | PTDEBUG && _d('More client headers:', $packet->{data}); | ||
1315 | 10842 | return; | ||
1316 | 10843 | } | ||
1317 | 10844 | |||
1318 | 10845 | if ( !$session->{state} ) { | ||
1319 | 10846 | $session->{state} = 'awaiting reply'; | ||
1320 | 10847 | my ($line1, undef) = $self->_parse_header($session, $packet->{data}, $packet->{data_len}); | ||
1321 | 10848 | my ($request, $page, $version) = $line1 =~ m/(\S+)/g; | ||
1322 | 10849 | if ( !$request || !$page ) { | ||
1323 | 10850 | PTDEBUG && _d("Didn't get a request or page:", $request, $page); | ||
1324 | 10851 | return; | ||
1325 | 10852 | } | ||
1326 | 10853 | $request = lc $request; | ||
1327 | 10854 | my $vh = $session->{attribs}->{Virtual_host} || ''; | ||
1328 | 10855 | my $arg = "$request $vh$page"; | ||
1329 | 10856 | PTDEBUG && _d('arg:', $arg); | ||
1330 | 10857 | |||
1331 | 10858 | if ( $request eq 'get' || $request eq 'post' ) { | ||
1332 | 10859 | @{$session->{attribs}}{qw(arg)} = ($arg); | ||
1333 | 10860 | } | ||
1334 | 10861 | else { | ||
1335 | 10862 | PTDEBUG && _d("Don't know how to handle a", $request, "request"); | ||
1336 | 10863 | return; | ||
1337 | 10864 | } | ||
1338 | 10865 | |||
1339 | 10866 | $session->{start_request} = $packet->{ts}; | ||
1340 | 10867 | $session->{attribs}->{host} = $packet->{src_host}; | ||
1341 | 10868 | $session->{attribs}->{pos_in_log} = $packet->{pos_in_log}; | ||
1342 | 10869 | $session->{attribs}->{ts} = $packet->{ts}; | ||
1343 | 10870 | } | ||
1344 | 10871 | else { | ||
1345 | 10872 | die "Probably multiple GETs from client before a server response?"; | ||
1346 | 10873 | } | ||
1347 | 10874 | |||
1348 | 10875 | return $event; | ||
1349 | 10876 | } | ||
1350 | 10877 | |||
1351 | 10878 | sub _parse_header { | ||
1352 | 10879 | my ( $self, $session, $data, $len, $no_recurse ) = @_; | ||
1353 | 10880 | die "I need data" unless $data; | ||
1354 | 10881 | my ($header, $content) = split(/\r\n\r\n/, $data); | ||
1355 | 10882 | my ($line1, $header_vals) = $header =~ m/\A(\S+ \S+ .+?)\r\n(.+)?/s; | ||
1356 | 10883 | PTDEBUG && _d('HTTP header:', $line1); | ||
1357 | 10884 | return unless $line1; | ||
1358 | 10885 | |||
1359 | 10886 | if ( !$header_vals ) { | ||
1360 | 10887 | PTDEBUG && _d('No header vals'); | ||
1361 | 10888 | return $line1, undef; | ||
1362 | 10889 | } | ||
1363 | 10890 | my @headers; | ||
1364 | 10891 | foreach my $val ( split(/\r\n/, $header_vals) ) { | ||
1365 | 10892 | last unless $val; | ||
1366 | 10893 | PTDEBUG && _d('HTTP header:', $val); | ||
1367 | 10894 | if ( $val =~ m/^Content-Length/i ) { | ||
1368 | 10895 | ($session->{attribs}->{bytes}) = $val =~ /: (\d+)/; | ||
1369 | 10896 | PTDEBUG && _d('Saved Content-Length:', $session->{attribs}->{bytes}); | ||
1370 | 10897 | } | ||
1371 | 10898 | if ( $val =~ m/Content-Encoding/i ) { | ||
1372 | 10899 | ($session->{compressed}) = $val =~ /: (\w+)/; | ||
1373 | 10900 | PTDEBUG && _d('Saved Content-Encoding:', $session->{compressed}); | ||
1374 | 10901 | } | ||
1375 | 10902 | if ( $val =~ m/^Host/i ) { | ||
1376 | 10903 | ($session->{attribs}->{Virtual_host}) = $val =~ /: (\S+)/; | ||
1377 | 10904 | PTDEBUG && _d('Saved Host:', ($session->{attribs}->{Virtual_host})); | ||
1378 | 10905 | } | ||
1379 | 10906 | } | ||
1380 | 10907 | return $line1, $content; | ||
1381 | 10908 | } | ||
1382 | 10909 | |||
1383 | 10910 | sub _d { | ||
1384 | 10911 | my ($package, undef, $line) = caller 0; | ||
1385 | 10912 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | ||
1386 | 10913 | map { defined $_ ? $_ : 'undef' } | ||
1387 | 10914 | @_; | ||
1388 | 10915 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | ||
1389 | 10916 | } | ||
1390 | 10917 | |||
1391 | 10918 | 1; | ||
1392 | 10919 | } | ||
1393 | 10920 | # ########################################################################### | ||
1394 | 10921 | # End HTTPProtocolParser package | ||
1395 | 10922 | # ########################################################################### | ||
1396 | 10923 | |||
1397 | 10924 | # ########################################################################### | ||
1398 | 10925 | # MasterSlave package | 9585 | # MasterSlave package |
1399 | 10926 | # This package is a copy without comments from the original. The original | 9586 | # This package is a copy without comments from the original. The original |
1400 | 10927 | # with comments and its test file can be found in the Bazaar repository at, | 9587 | # with comments and its test file can be found in the Bazaar repository at, |
1401 | @@ -13986,10 +12646,6 @@ | |||
1402 | 13986 | binlog => ['BinaryLogParser'], | 12646 | binlog => ['BinaryLogParser'], |
1403 | 13987 | genlog => ['GeneralLogParser'], | 12647 | genlog => ['GeneralLogParser'], |
1404 | 13988 | tcpdump => ['TcpdumpParser','MySQLProtocolParser'], | 12648 | tcpdump => ['TcpdumpParser','MySQLProtocolParser'], |
1405 | 13989 | memcached => ['TcpdumpParser','MemcachedProtocolParser', | ||
1406 | 13990 | 'MemcachedEvent'], | ||
1407 | 13991 | http => ['TcpdumpParser','HTTPProtocolParser'], | ||
1408 | 13992 | pglog => ['PgLogParser'], | ||
1409 | 13993 | rawlog => ['RawLogParser'], | 12649 | rawlog => ['RawLogParser'], |
1410 | 13994 | ); | 12650 | ); |
1411 | 13995 | my $type = $o->get('type'); | 12651 | my $type = $o->get('type'); |
1412 | @@ -14543,17 +13199,6 @@ | |||
1413 | 14543 | 13199 | ||
1414 | 14544 | { # distill | 13200 | { # distill |
1415 | 14545 | my %distill_args; | 13201 | my %distill_args; |
1416 | 14546 | if ( $o->get('type') eq 'memcached' || $o->get('type') eq 'http' ) { | ||
1417 | 14547 | $distill_args{generic} = 1; | ||
1418 | 14548 | if ( $o->get('type') eq 'http' ) { | ||
1419 | 14549 | # Remove stuff after url. | ||
1420 | 14550 | $distill_args{trf} = sub { | ||
1421 | 14551 | my ( $query ) = @_; | ||
1422 | 14552 | $query =~ s/(\S+ \S+?)(?:[?;].+)/$1/; | ||
1423 | 14553 | return $query; | ||
1424 | 14554 | }; | ||
1425 | 14555 | } | ||
1426 | 14556 | } | ||
1427 | 14557 | if ( grep { $_ eq 'distill' } @groupby ) { | 13202 | if ( grep { $_ eq 'distill' } @groupby ) { |
1428 | 14558 | $pipeline->add( | 13203 | $pipeline->add( |
1429 | 14559 | name => 'distill', | 13204 | name => 'distill', |
1430 | @@ -15282,7 +13927,7 @@ | |||
1431 | 15282 | 13927 | ||
1432 | 15283 | =head1 NAME | 13928 | =head1 NAME |
1433 | 15284 | 13929 | ||
1435 | 15285 | pt-query-digest - Analyze query execution logs and generate a query report, filter, replay, or transform queries for MySQL, PostgreSQL, memcached, and more. | 13930 | pt-query-digest - Analyze query execution logs and generate a query report, filter, replay, or transform queries for MySQL. |
1436 | 15286 | 13931 | ||
1437 | 15287 | =head1 SYNOPSIS | 13932 | =head1 SYNOPSIS |
1438 | 15288 | 13933 | ||
1439 | @@ -15387,19 +14032,6 @@ | |||
1440 | 15387 | Attributes created this way can be specified for L<"--order-by"> or any | 14032 | Attributes created this way can be specified for L<"--order-by"> or any |
1441 | 15388 | option that requires an attribute. | 14033 | option that requires an attribute. |
1442 | 15389 | 14034 | ||
1443 | 15390 | =head2 memcached | ||
1444 | 15391 | |||
1445 | 15392 | memcached events have additional attributes related to the memcached protocol: | ||
1446 | 15393 | cmd, key, res (result) and val. Also, boolean attributes are created for | ||
1447 | 15394 | the various commands, misses and errors: Memc_CMD where CMD is a memcached | ||
1448 | 15395 | command (get, set, delete, etc.), Memc_error and Memc_miss. | ||
1449 | 15396 | |||
1450 | 15397 | These attributes are no different from slow log attributes, so you can use them | ||
1451 | 15398 | with L<"--[no]report">, L<"--group-by">, in a L<"--filter">, etc. | ||
1452 | 15399 | |||
1453 | 15400 | See the memcached section of L<"ATTRIBUTES REFERENCE"> for a list of | ||
1454 | 15401 | memcached-specific attributes. | ||
1455 | 15402 | |||
1456 | 15403 | =head1 OUTPUT | 14035 | =head1 OUTPUT |
1457 | 15404 | 14036 | ||
1458 | 15405 | The default output is a query analysis report. The L<"--[no]report"> option | 14037 | The default output is a query analysis report. The L<"--[no]report"> option |
1459 | @@ -15657,12 +14289,6 @@ | |||
1460 | 15657 | You can also use the value C<distill>, which is a kind of super-fingerprint. | 14289 | You can also use the value C<distill>, which is a kind of super-fingerprint. |
1461 | 15658 | See L<"--group-by"> for more. | 14290 | See L<"--group-by"> for more. |
1462 | 15659 | 14291 | ||
1463 | 15660 | When parsing memcached input (L<"--type"> memcached), the fingerprint is an | ||
1464 | 15661 | abstracted version of the command and key, with placeholders removed. For | ||
1465 | 15662 | example, C<get user_123_preferences> fingerprints to C<get user_?_preferences>. | ||
1466 | 15663 | There is also a C<key_print> which a fingerprinted version of the key. This | ||
1467 | 15664 | example's key_print is C<user_?_preferences>. | ||
1468 | 15665 | |||
1469 | 15666 | Query fingerprinting accommodates a great many special cases, which have proven | 14292 | Query fingerprinting accommodates a great many special cases, which have proven |
1470 | 15667 | necessary in the real world. For example, an IN list with 5 literals is really | 14293 | necessary in the real world. For example, an IN list with 5 literals is really |
1471 | 15668 | equivalent to one with 4 literals, so lists of literals are collapsed to a | 14294 | equivalent to one with 4 literals, so lists of literals are collapsed to a |
1472 | @@ -16027,11 +14653,6 @@ | |||
1473 | 16027 | 14653 | ||
1474 | 16028 | =back | 14654 | =back |
1475 | 16029 | 14655 | ||
1476 | 16030 | If parsing memcached input (L<"--type"> memcached), there are other | ||
1477 | 16031 | attributes which you can group by: key_print (see memcached section in | ||
1478 | 16032 | L<"FINGERPRINTS">), cmd, key, res and val (see memcached section in | ||
1479 | 16033 | L<"ATTRIBUTES">). | ||
1480 | 16034 | |||
1481 | 16035 | =item --help | 14656 | =item --help |
1482 | 16036 | 14657 | ||
1483 | 16037 | Show help and exit. | 14658 | Show help and exit. |
1484 | @@ -16761,52 +15382,6 @@ | |||
1485 | 16761 | notably C<Query_time>. The default L<"--order-by"> for general logs | 15382 | notably C<Query_time>. The default L<"--order-by"> for general logs |
1486 | 16762 | changes to C<Query_time:cnt>. | 15383 | changes to C<Query_time:cnt>. |
1487 | 16763 | 15384 | ||
1488 | 16764 | =item http | ||
1489 | 16765 | |||
1490 | 16766 | Parse HTTP traffic from tcpdump. | ||
1491 | 16767 | |||
1492 | 16768 | =item pglog | ||
1493 | 16769 | |||
1494 | 16770 | Parse a log file in PostgreSQL format. The parser will automatically recognize | ||
1495 | 16771 | logs sent to syslog and transparently parse the syslog format, too. The | ||
1496 | 16772 | recommended configuration for logging in your postgresql.conf is as follows. | ||
1497 | 16773 | |||
1498 | 16774 | The log_destination setting can be set to either syslog or stderr. Syslog has | ||
1499 | 16775 | the added benefit of not interleaving log messages from several sessions | ||
1500 | 16776 | concurrently, which the parser cannot handle, so this might be better than | ||
1501 | 16777 | stderr. CSV-formatted logs are not supported at this time. | ||
1502 | 16778 | |||
1503 | 16779 | The log_min_duration_statement setting should be set to 0 to capture all | ||
1504 | 16780 | statements with their durations. Alternatively, the parser will also recognize | ||
1505 | 16781 | and handle various combinations of log_duration and log_statement. | ||
1506 | 16782 | |||
1507 | 16783 | You may enable log_connections and log_disconnections, but this is optional. | ||
1508 | 16784 | |||
1509 | 16785 | It is highly recommended to set your log_line_prefix to the following: | ||
1510 | 16786 | |||
1511 | 16787 | log_line_prefix = '%m c=%c,u=%u,D=%d ' | ||
1512 | 16788 | |||
1513 | 16789 | This lets the parser find timestamps with milliseconds, session IDs, users, and | ||
1514 | 16790 | databases from the log. If these items are missing, you'll simply get less | ||
1515 | 16791 | information to analyze. For compatibility with other log analysis tools such as | ||
1516 | 16792 | PQA and pgfouine, various log line prefix formats are supported. The general | ||
1517 | 16793 | format is as follows: a timestamp can be detected and extracted (the syslog | ||
1518 | 16794 | timestamp is NOT parsed), and a name=value list of properties can also. | ||
1519 | 16795 | Although the suggested format is as shown above, any name=value list will be | ||
1520 | 16796 | captured and interpreted by using the first letter of the 'name' part, | ||
1521 | 16797 | lowercased, to determine the meaning of the item. The lowercased first letter | ||
1522 | 16798 | is interpreted to mean the same thing as PostgreSQL's built-in %-codes for the | ||
1523 | 16799 | log_line_prefix format string. For example, u means user, so unicorn=fred | ||
1524 | 16800 | will be interpreted as user=fred; d means database, so D=john will be | ||
1525 | 16801 | interpreted as database=john. The pgfouine-suggested formatting is user=%u and | ||
1526 | 16802 | db=%d, so it should Just Work regardless of which format you choose. The main | ||
1527 | 16803 | thing is to add as much information as possible into the log_line_prefix to | ||
1528 | 16804 | permit richer analysis. | ||
1529 | 16805 | |||
1530 | 16806 | Currently, only English locale messages are supported, so if your server's | ||
1531 | 16807 | locale is set to something else, the log won't be parsed properly. (Log | ||
1532 | 16808 | messages with "duration:" and "statement:" won't be recognized.) | ||
1533 | 16809 | |||
1534 | 16810 | =item slowlog | 15385 | =item slowlog |
1535 | 16811 | 15386 | ||
1536 | 16812 | Parse a log file in any variation of MySQL slow-log format. | 15387 | Parse a log file in any variation of MySQL slow-log format. |
1537 | @@ -16872,17 +15447,6 @@ | |||
1538 | 16872 | Server-side prepared statements are supported. SSL-encrypted traffic cannot be | 15447 | Server-side prepared statements are supported. SSL-encrypted traffic cannot be |
1539 | 16873 | inspected and decoded. | 15448 | inspected and decoded. |
1540 | 16874 | 15449 | ||
1541 | 16875 | =item memcached | ||
1542 | 16876 | |||
1543 | 16877 | Similar to tcpdump, but the expected input is memcached packets | ||
1544 | 16878 | instead of MySQL packets. For example: | ||
1545 | 16879 | |||
1546 | 16880 | tcpdump -i any port 11211 -s 65535 -x -nn -q -tttt \ | ||
1547 | 16881 | > memcached.tcp.txt | ||
1548 | 16882 | pt-query-digest --type memcached memcached.tcp.txt | ||
1549 | 16883 | |||
1550 | 16884 | memcached uses port 11211 by default. | ||
1551 | 16885 | |||
1552 | 16886 | =back | 15450 | =back |
1553 | 16887 | 15451 | ||
1554 | 16888 | =item --until | 15452 | =item --until |
1555 | @@ -16962,8 +15526,8 @@ | |||
1556 | 16962 | type: string | 15526 | type: string |
1557 | 16963 | 15527 | ||
1558 | 16964 | This option tells pt-query-digest which server IP address and port (like | 15528 | This option tells pt-query-digest which server IP address and port (like |
1561 | 16965 | "10.0.0.1:3306") to watch when parsing tcpdump (for L<"--type"> tcpdump and | 15529 | "10.0.0.1:3306") to watch when parsing tcpdump (for L<"--type"> tcpdump); |
1562 | 16966 | memcached); all other servers are ignored. If you don't specify it, | 15530 | all other servers are ignored. If you don't specify it, |
1563 | 16967 | pt-query-digest watches all servers by looking for any IP address using port | 15531 | pt-query-digest watches all servers by looking for any IP address using port |
1564 | 16968 | 3306 or "mysql". If you're watching a server with a non-standard port, this | 15532 | 3306 or "mysql". If you're watching a server with a non-standard port, this |
1565 | 16969 | won't work, so you must specify the IP address and port to watch. | 15533 | won't work, so you must specify the IP address and port to watch. |
1566 | @@ -17156,13 +15720,12 @@ | |||
1567 | 17156 | 15720 | ||
1568 | 17157 | =item cmd | 15721 | =item cmd |
1569 | 17158 | 15722 | ||
1572 | 17159 | "Query" or "Admin" for all except memcached. For memcached it's | 15723 | "Query" or "Admin". |
1571 | 17160 | the memcached command: get, set, etc. | ||
1573 | 17161 | 15724 | ||
1574 | 17162 | =item db | 15725 | =item db |
1575 | 17163 | 15726 | ||
1578 | 17164 | The current database, except for memcached. The value comes from USE | 15727 | The current database. The value comes from USE database statements. |
1579 | 17165 | database statements. By default, C<Schema> is an alias which is automatically | 15728 | By default, C<Schema> is an alias which is automatically |
1580 | 17166 | changed to C<db>; see L<"--attribute-aliases">. | 15729 | changed to C<db>; see L<"--attribute-aliases">. |
1581 | 17167 | 15730 | ||
1582 | 17168 | =item fingerprint | 15731 | =item fingerprint |
1583 | @@ -17235,75 +15798,6 @@ | |||
1584 | 17235 | If using L<"--processlist">, an C<id> attribute is available for | 15798 | If using L<"--processlist">, an C<id> attribute is available for |
1585 | 17236 | the process ID, in addition to the common attributes. | 15799 | the process ID, in addition to the common attributes. |
1586 | 17237 | 15800 | ||
1587 | 17238 | =head2 MEMCACHED | ||
1588 | 17239 | |||
1589 | 17240 | These attributes are available when parsing L<"--type"> memcached. | ||
1590 | 17241 | |||
1591 | 17242 | =over | ||
1592 | 17243 | |||
1593 | 17244 | =item exptime | ||
1594 | 17245 | |||
1595 | 17246 | Expiration time. | ||
1596 | 17247 | |||
1597 | 17248 | =item key | ||
1598 | 17249 | |||
1599 | 17250 | The key used by cmd. | ||
1600 | 17251 | |||
1601 | 17252 | =item key_print | ||
1602 | 17253 | |||
1603 | 17254 | An abstracted form of the key. | ||
1604 | 17255 | |||
1605 | 17256 | =item Memc_add | ||
1606 | 17257 | |||
1607 | 17258 | Yes/No if the command is add. | ||
1608 | 17259 | |||
1609 | 17260 | =item Memc_append | ||
1610 | 17261 | |||
1611 | 17262 | Yes/No if the command is append. | ||
1612 | 17263 | |||
1613 | 17264 | =item Memc_cas | ||
1614 | 17265 | |||
1615 | 17266 | Yes/No if the command is cas. | ||
1616 | 17267 | |||
1617 | 17268 | =item Memc_error | ||
1618 | 17269 | |||
1619 | 17270 | Yes/No if command caused an error. Currently, the only error is when | ||
1620 | 17271 | a retrieval command is interrupted. | ||
1621 | 17272 | |||
1622 | 17273 | =item Memc_get | ||
1623 | 17274 | |||
1624 | 17275 | Yes/No if the command is get. | ||
1625 | 17276 | |||
1626 | 17277 | =item Memc_gets | ||
1627 | 17278 | |||
1628 | 17279 | Yes/No if the command is gets. | ||
1629 | 17280 | |||
1630 | 17281 | =item Memc_miss | ||
1631 | 17282 | |||
1632 | 17283 | Yes/No if the command tried to access a nonexistent key. | ||
1633 | 17284 | |||
1634 | 17285 | =item Memc_prepend | ||
1635 | 17286 | |||
1636 | 17287 | Yes/No if the command is prepend. | ||
1637 | 17288 | |||
1638 | 17289 | =item Memc_replace | ||
1639 | 17290 | |||
1640 | 17291 | Yes/No if the command is replace. | ||
1641 | 17292 | |||
1642 | 17293 | =item Memc_set | ||
1643 | 17294 | |||
1644 | 17295 | Yes/No if the command is set. | ||
1645 | 17296 | |||
1646 | 17297 | =item res | ||
1647 | 17298 | |||
1648 | 17299 | Result of cmd. | ||
1649 | 17300 | |||
1650 | 17301 | =item val | ||
1651 | 17302 | |||
1652 | 17303 | The return value of cmd, if any. | ||
1653 | 17304 | |||
1654 | 17305 | =back | ||
1655 | 17306 | |||
1656 | 17307 | =head1 AUTHORS | 15801 | =head1 AUTHORS |
1657 | 17308 | 15802 | ||
1658 | 17309 | Baron Schwartz and Daniel Nichter | 15803 | Baron Schwartz and Daniel Nichter |
1659 | 17310 | 15804 | ||
1660 | === removed file 'lib/HTTPProtocolParser.pm' | |||
1661 | --- lib/HTTPProtocolParser.pm 2013-01-03 00:19:16 +0000 | |||
1662 | +++ lib/HTTPProtocolParser.pm 1970-01-01 00:00:00 +0000 | |||
1663 | @@ -1,242 +0,0 @@ | |||
1664 | 1 | # This program is copyright 2009-2011 Percona Ireland Ltd. | ||
1665 | 2 | # Feedback and improvements are welcome. | ||
1666 | 3 | # | ||
1667 | 4 | # THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED | ||
1668 | 5 | # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF | ||
1669 | 6 | # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. | ||
1670 | 7 | # | ||
1671 | 8 | # This program is free software; you can redistribute it and/or modify it under | ||
1672 | 9 | # the terms of the GNU General Public License as published by the Free Software | ||
1673 | 10 | # Foundation, version 2; OR the Perl Artistic License. On UNIX and similar | ||
1674 | 11 | # systems, you can issue `man perlgpl' or `man perlartistic' to read these | ||
1675 | 12 | # licenses. | ||
1676 | 13 | # | ||
1677 | 14 | # You should have received a copy of the GNU General Public License along with | ||
1678 | 15 | # this program; if not, write to the Free Software Foundation, Inc., 59 Temple | ||
1679 | 16 | # Place, Suite 330, Boston, MA 02111-1307 USA. | ||
1680 | 17 | # ########################################################################### | ||
1681 | 18 | # HTTPProtocolParser package | ||
1682 | 19 | # ########################################################################### | ||
1683 | 20 | { | ||
1684 | 21 | # Package: HTTPProtocolParser | ||
1685 | 22 | # HTTPProtocolParser parses HTTP traffic from tcpdump files. | ||
1686 | 23 | package HTTPProtocolParser; | ||
1687 | 24 | use base 'ProtocolParser'; | ||
1688 | 25 | |||
1689 | 26 | use strict; | ||
1690 | 27 | use warnings FATAL => 'all'; | ||
1691 | 28 | use English qw(-no_match_vars); | ||
1692 | 29 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
1693 | 30 | |||
1694 | 31 | # server is the "host:port" of the sever being watched. It's auto-guessed if | ||
1695 | 32 | # not specified. | ||
1696 | 33 | sub new { | ||
1697 | 34 | my ( $class, %args ) = @_; | ||
1698 | 35 | my $self = $class->SUPER::new( | ||
1699 | 36 | %args, | ||
1700 | 37 | port => 80, | ||
1701 | 38 | ); | ||
1702 | 39 | return $self; | ||
1703 | 40 | } | ||
1704 | 41 | |||
1705 | 42 | # Handles a packet from the server given the state of the session. Returns an | ||
1706 | 43 | # event if one was ready to be created, otherwise returns nothing. | ||
1707 | 44 | sub _packet_from_server { | ||
1708 | 45 | my ( $self, $packet, $session, $misc ) = @_; | ||
1709 | 46 | die "I need a packet" unless $packet; | ||
1710 | 47 | die "I need a session" unless $session; | ||
1711 | 48 | |||
1712 | 49 | PTDEBUG && _d('Packet is from server; client state:', $session->{state}); | ||
1713 | 50 | |||
1714 | 51 | # If there's no session state, then we're catching a server response | ||
1715 | 52 | # mid-stream. | ||
1716 | 53 | if ( !$session->{state} ) { | ||
1717 | 54 | PTDEBUG && _d('Ignoring mid-stream server response'); | ||
1718 | 55 | return; | ||
1719 | 56 | } | ||
1720 | 57 | |||
1721 | 58 | if ( $session->{out_of_order} ) { | ||
1722 | 59 | # We're waiting for the header so we can get the content length. | ||
1723 | 60 | # Once we know this, we can determine how many out of order packets | ||
1724 | 61 | # we need to complete the request, then order them and re-process. | ||
1725 | 62 | my ($line1, $content); | ||
1726 | 63 | if ( !$session->{have_header} ) { | ||
1727 | 64 | ($line1, $content) = $self->_parse_header( | ||
1728 | 65 | $session, $packet->{data}, $packet->{data_len}); | ||
1729 | 66 | } | ||
1730 | 67 | if ( $line1 ) { | ||
1731 | 68 | $session->{have_header} = 1; | ||
1732 | 69 | $packet->{content_len} = length $content; | ||
1733 | 70 | PTDEBUG && _d('Got out of order header with', | ||
1734 | 71 | $packet->{content_len}, 'bytes of content'); | ||
1735 | 72 | } | ||
1736 | 73 | my $have_len = $packet->{content_len} || $packet->{data_len}; | ||
1737 | 74 | map { $have_len += $_->{data_len} } | ||
1738 | 75 | @{$session->{packets}}; | ||
1739 | 76 | $session->{have_all_packets} | ||
1740 | 77 | = 1 if $session->{attribs}->{bytes} | ||
1741 | 78 | && $have_len >= $session->{attribs}->{bytes}; | ||
1742 | 79 | PTDEBUG && _d('Have', $have_len, 'of', $session->{attribs}->{bytes}); | ||
1743 | 80 | return; | ||
1744 | 81 | } | ||
1745 | 82 | |||
1746 | 83 | # Assume that the server is returning only one value. | ||
1747 | 84 | # TODO: make it handle multiple. | ||
1748 | 85 | if ( $session->{state} eq 'awaiting reply' ) { | ||
1749 | 86 | |||
1750 | 87 | # Save this early because we may return early if the packets | ||
1751 | 88 | # are being received out of order. Also, save it only once | ||
1752 | 89 | # in case we re-process packets if they're out of order. | ||
1753 | 90 | $session->{start_reply} = $packet->{ts} unless $session->{start_reply}; | ||
1754 | 91 | |||
1755 | 92 | # Get first line of header and first chunk of contents/data. | ||
1756 | 93 | my ($line1, $content) = $self->_parse_header($session, $packet->{data}, | ||
1757 | 94 | $packet->{data_len}); | ||
1758 | 95 | |||
1759 | 96 | # The reponse, when in order, is text header followed by data. | ||
1760 | 97 | # If there's no line1, then we didn't get the text header first | ||
1761 | 98 | # which means we're getting the response in out of order packets. | ||
1762 | 99 | if ( !$line1 ) { | ||
1763 | 100 | $session->{out_of_order} = 1; # alert parent | ||
1764 | 101 | $session->{have_all_packets} = 0; | ||
1765 | 102 | return; | ||
1766 | 103 | } | ||
1767 | 104 | |||
1768 | 105 | # First line should be: version code phrase | ||
1769 | 106 | # E.g.: HTTP/1.1 200 OK | ||
1770 | 107 | my ($version, $code, $phrase) = $line1 =~ m/(\S+)/g; | ||
1771 | 108 | $session->{attribs}->{Status_code} = $code; | ||
1772 | 109 | PTDEBUG && _d('Status code for last', $session->{attribs}->{arg}, | ||
1773 | 110 | 'request:', $session->{attribs}->{Status_code}); | ||
1774 | 111 | |||
1775 | 112 | my $content_len = $content ? length $content : 0; | ||
1776 | 113 | PTDEBUG && _d('Got', $content_len, 'bytes of content'); | ||
1777 | 114 | if ( $session->{attribs}->{bytes} | ||
1778 | 115 | && $content_len < $session->{attribs}->{bytes} ) { | ||
1779 | 116 | $session->{data_len} = $session->{attribs}->{bytes}; | ||
1780 | 117 | $session->{buff} = $content; | ||
1781 | 118 | $session->{buff_left} = $session->{attribs}->{bytes} - $content_len; | ||
1782 | 119 | PTDEBUG && _d('Contents not complete,', $session->{buff_left}, | ||
1783 | 120 | 'bytes left'); | ||
1784 | 121 | $session->{state} = 'recving content'; | ||
1785 | 122 | return; | ||
1786 | 123 | } | ||
1787 | 124 | } | ||
1788 | 125 | elsif ( $session->{state} eq 'recving content' ) { | ||
1789 | 126 | if ( $session->{buff} ) { | ||
1790 | 127 | PTDEBUG && _d('Receiving content,', $session->{buff_left}, | ||
1791 | 128 | 'bytes left'); | ||
1792 | 129 | return; | ||
1793 | 130 | } | ||
1794 | 131 | PTDEBUG && _d('Contents received'); | ||
1795 | 132 | } | ||
1796 | 133 | else { | ||
1797 | 134 | # TODO: | ||
1798 | 135 | warn "Server response in unknown state"; | ||
1799 | 136 | return; | ||
1800 | 137 | } | ||
1801 | 138 | |||
1802 | 139 | PTDEBUG && _d('Creating event, deleting session'); | ||
1803 | 140 | $session->{end_reply} = $session->{ts_max} || $packet->{ts}; | ||
1804 | 141 | my $event = $self->make_event($session, $packet); | ||
1805 | 142 | delete $self->{sessions}->{$session->{client}}; # http is stateless! | ||
1806 | 143 | return $event; | ||
1807 | 144 | } | ||
1808 | 145 | |||
1809 | 146 | # Handles a packet from the client given the state of the session. | ||
1810 | 147 | sub _packet_from_client { | ||
1811 | 148 | my ( $self, $packet, $session, $misc ) = @_; | ||
1812 | 149 | die "I need a packet" unless $packet; | ||
1813 | 150 | die "I need a session" unless $session; | ||
1814 | 151 | |||
1815 | 152 | PTDEBUG && _d('Packet is from client; state:', $session->{state}); | ||
1816 | 153 | |||
1817 | 154 | my $event; | ||
1818 | 155 | if ( ($session->{state} || '') =~ m/awaiting / ) { | ||
1819 | 156 | PTDEBUG && _d('More client headers:', $packet->{data}); | ||
1820 | 157 | return; | ||
1821 | 158 | } | ||
1822 | 159 | |||
1823 | 160 | if ( !$session->{state} ) { | ||
1824 | 161 | $session->{state} = 'awaiting reply'; | ||
1825 | 162 | my ($line1, undef) = $self->_parse_header($session, $packet->{data}, $packet->{data_len}); | ||
1826 | 163 | # First line should be: request page version | ||
1827 | 164 | # E.g.: GET /foo.html HTTP/1.1 | ||
1828 | 165 | my ($request, $page, $version) = $line1 =~ m/(\S+)/g; | ||
1829 | 166 | if ( !$request || !$page ) { | ||
1830 | 167 | PTDEBUG && _d("Didn't get a request or page:", $request, $page); | ||
1831 | 168 | return; | ||
1832 | 169 | } | ||
1833 | 170 | $request = lc $request; | ||
1834 | 171 | my $vh = $session->{attribs}->{Virtual_host} || ''; | ||
1835 | 172 | my $arg = "$request $vh$page"; | ||
1836 | 173 | PTDEBUG && _d('arg:', $arg); | ||
1837 | 174 | |||
1838 | 175 | if ( $request eq 'get' || $request eq 'post' ) { | ||
1839 | 176 | @{$session->{attribs}}{qw(arg)} = ($arg); | ||
1840 | 177 | } | ||
1841 | 178 | else { | ||
1842 | 179 | PTDEBUG && _d("Don't know how to handle a", $request, "request"); | ||
1843 | 180 | return; | ||
1844 | 181 | } | ||
1845 | 182 | |||
1846 | 183 | $session->{start_request} = $packet->{ts}; | ||
1847 | 184 | $session->{attribs}->{host} = $packet->{src_host}; | ||
1848 | 185 | $session->{attribs}->{pos_in_log} = $packet->{pos_in_log}; | ||
1849 | 186 | $session->{attribs}->{ts} = $packet->{ts}; | ||
1850 | 187 | } | ||
1851 | 188 | else { | ||
1852 | 189 | # TODO: | ||
1853 | 190 | die "Probably multiple GETs from client before a server response?"; | ||
1854 | 191 | } | ||
1855 | 192 | |||
1856 | 193 | return $event; | ||
1857 | 194 | } | ||
1858 | 195 | |||
1859 | 196 | sub _parse_header { | ||
1860 | 197 | my ( $self, $session, $data, $len, $no_recurse ) = @_; | ||
1861 | 198 | die "I need data" unless $data; | ||
1862 | 199 | my ($header, $content) = split(/\r\n\r\n/, $data); | ||
1863 | 200 | my ($line1, $header_vals) = $header =~ m/\A(\S+ \S+ .+?)\r\n(.+)?/s; | ||
1864 | 201 | PTDEBUG && _d('HTTP header:', $line1); | ||
1865 | 202 | return unless $line1; | ||
1866 | 203 | |||
1867 | 204 | if ( !$header_vals ) { | ||
1868 | 205 | PTDEBUG && _d('No header vals'); | ||
1869 | 206 | return $line1, undef; | ||
1870 | 207 | } | ||
1871 | 208 | my @headers; | ||
1872 | 209 | foreach my $val ( split(/\r\n/, $header_vals) ) { | ||
1873 | 210 | last unless $val; | ||
1874 | 211 | # Capture and save any useful header values. | ||
1875 | 212 | PTDEBUG && _d('HTTP header:', $val); | ||
1876 | 213 | if ( $val =~ m/^Content-Length/i ) { | ||
1877 | 214 | ($session->{attribs}->{bytes}) = $val =~ /: (\d+)/; | ||
1878 | 215 | PTDEBUG && _d('Saved Content-Length:', $session->{attribs}->{bytes}); | ||
1879 | 216 | } | ||
1880 | 217 | if ( $val =~ m/Content-Encoding/i ) { | ||
1881 | 218 | ($session->{compressed}) = $val =~ /: (\w+)/; | ||
1882 | 219 | PTDEBUG && _d('Saved Content-Encoding:', $session->{compressed}); | ||
1883 | 220 | } | ||
1884 | 221 | if ( $val =~ m/^Host/i ) { | ||
1885 | 222 | # The "host" attribute is already taken, so we call this "domain". | ||
1886 | 223 | ($session->{attribs}->{Virtual_host}) = $val =~ /: (\S+)/; | ||
1887 | 224 | PTDEBUG && _d('Saved Host:', ($session->{attribs}->{Virtual_host})); | ||
1888 | 225 | } | ||
1889 | 226 | } | ||
1890 | 227 | return $line1, $content; | ||
1891 | 228 | } | ||
1892 | 229 | |||
1893 | 230 | sub _d { | ||
1894 | 231 | my ($package, undef, $line) = caller 0; | ||
1895 | 232 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | ||
1896 | 233 | map { defined $_ ? $_ : 'undef' } | ||
1897 | 234 | @_; | ||
1898 | 235 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | ||
1899 | 236 | } | ||
1900 | 237 | |||
1901 | 238 | 1; | ||
1902 | 239 | } | ||
1903 | 240 | # ########################################################################### | ||
1904 | 241 | # End HTTPProtocolParser package | ||
1905 | 242 | # ########################################################################### | ||
1906 | 243 | 0 | ||
1907 | === removed file 'lib/MemcachedEvent.pm' | |||
1908 | --- lib/MemcachedEvent.pm 2013-01-03 00:19:16 +0000 | |||
1909 | +++ lib/MemcachedEvent.pm 1970-01-01 00:00:00 +0000 | |||
1910 | @@ -1,216 +0,0 @@ | |||
1911 | 1 | # This program is copyright 2009-2011 Percona Ireland Ltd. | ||
1912 | 2 | # Feedback and improvements are welcome. | ||
1913 | 3 | # | ||
1914 | 4 | # THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED | ||
1915 | 5 | # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF | ||
1916 | 6 | # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. | ||
1917 | 7 | # | ||
1918 | 8 | # This program is free software; you can redistribute it and/or modify it under | ||
1919 | 9 | # the terms of the GNU General Public License as published by the Free Software | ||
1920 | 10 | # Foundation, version 2; OR the Perl Artistic License. On UNIX and similar | ||
1921 | 11 | # systems, you can issue `man perlgpl' or `man perlartistic' to read these | ||
1922 | 12 | # licenses. | ||
1923 | 13 | # | ||
1924 | 14 | # You should have received a copy of the GNU General Public License along with | ||
1925 | 15 | # this program; if not, write to the Free Software Foundation, Inc., 59 Temple | ||
1926 | 16 | # Place, Suite 330, Boston, MA 02111-1307 USA. | ||
1927 | 17 | # ########################################################################### | ||
1928 | 18 | # MemcachedEvent package | ||
1929 | 19 | # ########################################################################### | ||
1930 | 20 | { | ||
1931 | 21 | # Package: MemcachedEvent | ||
1932 | 22 | # MemcachedEvent creates events from <MemcachedProtocolParser> data. | ||
1933 | 23 | # Since memcached is not strictly MySQL stuff, we have to | ||
1934 | 24 | # fabricate MySQL-like query events from memcached. | ||
1935 | 25 | # | ||
1936 | 26 | # See http://code.sixapart.com/svn/memcached/trunk/server/doc/protocol.txt | ||
1937 | 27 | # for information about the memcached protocol. | ||
1938 | 28 | package MemcachedEvent; | ||
1939 | 29 | |||
1940 | 30 | use strict; | ||
1941 | 31 | use warnings FATAL => 'all'; | ||
1942 | 32 | use English qw(-no_match_vars); | ||
1943 | 33 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
1944 | 34 | |||
1945 | 35 | use Data::Dumper; | ||
1946 | 36 | $Data::Dumper::Indent = 1; | ||
1947 | 37 | $Data::Dumper::Sortkeys = 1; | ||
1948 | 38 | $Data::Dumper::Quotekeys = 0; | ||
1949 | 39 | |||
1950 | 40 | # cmds that we know how to handle. | ||
1951 | 41 | my %cmds = map { $_ => 1 } qw( | ||
1952 | 42 | set | ||
1953 | 43 | add | ||
1954 | 44 | replace | ||
1955 | 45 | append | ||
1956 | 46 | prepend | ||
1957 | 47 | cas | ||
1958 | 48 | get | ||
1959 | 49 | gets | ||
1960 | 50 | delete | ||
1961 | 51 | incr | ||
1962 | 52 | decr | ||
1963 | 53 | ); | ||
1964 | 54 | |||
1965 | 55 | my %cmd_handler_for = ( | ||
1966 | 56 | set => \&handle_storage_cmd, | ||
1967 | 57 | add => \&handle_storage_cmd, | ||
1968 | 58 | replace => \&handle_storage_cmd, | ||
1969 | 59 | append => \&handle_storage_cmd, | ||
1970 | 60 | prepend => \&handle_storage_cmd, | ||
1971 | 61 | cas => \&handle_storage_cmd, | ||
1972 | 62 | get => \&handle_retr_cmd, | ||
1973 | 63 | gets => \&handle_retr_cmd, | ||
1974 | 64 | ); | ||
1975 | 65 | |||
1976 | 66 | sub new { | ||
1977 | 67 | my ( $class, %args ) = @_; | ||
1978 | 68 | my $self = {}; | ||
1979 | 69 | return bless $self, $class; | ||
1980 | 70 | } | ||
1981 | 71 | |||
1982 | 72 | # Given an event from MemcachedProtocolParser, returns an event | ||
1983 | 73 | # more suitable for mk-query-digest. | ||
1984 | 74 | sub parse_event { | ||
1985 | 75 | my ( $self, %args ) = @_; | ||
1986 | 76 | my $event = $args{event}; | ||
1987 | 77 | return unless $event; | ||
1988 | 78 | |||
1989 | 79 | if ( !$event->{cmd} || !$event->{key} ) { | ||
1990 | 80 | PTDEBUG && _d('Event has no cmd or key:', Dumper($event)); | ||
1991 | 81 | return; | ||
1992 | 82 | } | ||
1993 | 83 | |||
1994 | 84 | if ( !$cmds{$event->{cmd}} ) { | ||
1995 | 85 | PTDEBUG && _d("Don't know how to handle cmd:", $event->{cmd}); | ||
1996 | 86 | return; | ||
1997 | 87 | } | ||
1998 | 88 | |||
1999 | 89 | # For a normal event, arg is the query. For memcached, the "query" is | ||
2000 | 90 | # essentially the cmd and key, so this becomes arg. E.g.: "set mk_key". | ||
2001 | 91 | $event->{arg} = "$event->{cmd} $event->{key}"; | ||
2002 | 92 | $event->{fingerprint} = $self->fingerprint($event->{arg}); | ||
2003 | 93 | $event->{key_print} = $self->fingerprint($event->{key}); | ||
2004 | 94 | |||
2005 | 95 | # Set every cmd so that aggregated totals will be correct. If we only | ||
2006 | 96 | # set cmd that we get, then all cmds will show as 100% in the report. | ||
2007 | 97 | # This will create a lot of 0% cmds, but --[no]zero-bool will remove them. | ||
2008 | 98 | # Think of events in a Percona-patched log: the attribs like Full_scan are | ||
2009 | 99 | # present for every event. | ||
2010 | 100 | map { $event->{"Memc_$_"} = 'No' } keys %cmds; | ||
2011 | 101 | $event->{"Memc_$event->{cmd}"} = 'Yes'; # Got this cmd. | ||
2012 | 102 | $event->{Memc_error} = 'No'; # A handler may change this. | ||
2013 | 103 | $event->{Memc_miss} = 'No'; | ||
2014 | 104 | if ( $event->{res} ) { | ||
2015 | 105 | $event->{Memc_miss} = 'Yes' if $event->{res} eq 'NOT_FOUND'; | ||
2016 | 106 | } | ||
2017 | 107 | else { | ||
2018 | 108 | # This normally happens with incr and decr cmds. | ||
2019 | 109 | PTDEBUG && _d('Event has no res:', Dumper($event)); | ||
2020 | 110 | } | ||
2021 | 111 | |||
2022 | 112 | # Handle special results, errors, etc. The handler should return the | ||
2023 | 113 | # event on success, or nothing on failure. | ||
2024 | 114 | if ( $cmd_handler_for{$event->{cmd}} ) { | ||
2025 | 115 | return $cmd_handler_for{$event->{cmd}}->($event); | ||
2026 | 116 | } | ||
2027 | 117 | |||
2028 | 118 | return $event; | ||
2029 | 119 | } | ||
2030 | 120 | |||
2031 | 121 | # Replace things that look like placeholders with a ? | ||
2032 | 122 | sub fingerprint { | ||
2033 | 123 | my ( $self, $val ) = @_; | ||
2034 | 124 | $val =~ s/[0-9A-Fa-f]{16,}|\d+/?/g; | ||
2035 | 125 | return $val; | ||
2036 | 126 | } | ||
2037 | 127 | |||
2038 | 128 | # Possible results for storage cmds: | ||
2039 | 129 | # - "STORED\r\n", to indicate success. | ||
2040 | 130 | # | ||
2041 | 131 | # - "NOT_STORED\r\n" to indicate the data was not stored, but not | ||
2042 | 132 | # because of an error. This normally means that either that the | ||
2043 | 133 | # condition for an "add" or a "replace" command wasn't met, or that the | ||
2044 | 134 | # item is in a delete queue (see the "delete" command below). | ||
2045 | 135 | # | ||
2046 | 136 | # - "EXISTS\r\n" to indicate that the item you are trying to store with | ||
2047 | 137 | # a "cas" command has been modified since you last fetched it. | ||
2048 | 138 | # | ||
2049 | 139 | # - "NOT_FOUND\r\n" to indicate that the item you are trying to store | ||
2050 | 140 | # with a "cas" command did not exist or has been deleted. | ||
2051 | 141 | sub handle_storage_cmd { | ||
2052 | 142 | my ( $event ) = @_; | ||
2053 | 143 | |||
2054 | 144 | # There should be a result for any storage cmd. | ||
2055 | 145 | if ( !$event->{res} ) { | ||
2056 | 146 | PTDEBUG && _d('No result for event:', Dumper($event)); | ||
2057 | 147 | return; | ||
2058 | 148 | } | ||
2059 | 149 | |||
2060 | 150 | $event->{'Memc_Not_Stored'} = $event->{res} eq 'NOT_STORED' ? 'Yes' : 'No'; | ||
2061 | 151 | $event->{'Memc_Exists'} = $event->{res} eq 'EXISTS' ? 'Yes' : 'No'; | ||
2062 | 152 | |||
2063 | 153 | return $event; | ||
2064 | 154 | } | ||
2065 | 155 | |||
2066 | 156 | # Technically, the only results for a retrieval cmd are the values requested. | ||
2067 | 157 | # "If some of the keys appearing in a retrieval request are not sent back | ||
2068 | 158 | # by the server in the item list this means that the server does not | ||
2069 | 159 | # hold items with such keys (because they were never stored, or stored | ||
2070 | 160 | # but deleted to make space for more items, or expired, or explicitly | ||
2071 | 161 | # deleted by a client)." | ||
2072 | 162 | # Contrary to this, MemcacedProtocolParser will set res='VALUE' on | ||
2073 | 163 | # success, res='NOT_FOUND' on failure, or res='INTERRUPTED' if the get | ||
2074 | 164 | # didn't finish. | ||
2075 | 165 | sub handle_retr_cmd { | ||
2076 | 166 | my ( $event ) = @_; | ||
2077 | 167 | |||
2078 | 168 | # There should be a result for any retr cmd. | ||
2079 | 169 | if ( !$event->{res} ) { | ||
2080 | 170 | PTDEBUG && _d('No result for event:', Dumper($event)); | ||
2081 | 171 | return; | ||
2082 | 172 | } | ||
2083 | 173 | |||
2084 | 174 | $event->{'Memc_error'} = $event->{res} eq 'INTERRUPTED' ? 'Yes' : 'No'; | ||
2085 | 175 | |||
2086 | 176 | return $event; | ||
2087 | 177 | } | ||
2088 | 178 | |||
2089 | 179 | # handle_delete() and handle_incr_decr_cmd() are stub subs in case we | ||
2090 | 180 | # need them later. | ||
2091 | 181 | |||
2092 | 182 | # Possible results for a delete cmd: | ||
2093 | 183 | # - "DELETED\r\n" to indicate success | ||
2094 | 184 | # | ||
2095 | 185 | # - "NOT_FOUND\r\n" to indicate that the item with this key was not | ||
2096 | 186 | # found. | ||
2097 | 187 | sub handle_delete { | ||
2098 | 188 | my ( $event ) = @_; | ||
2099 | 189 | return $event; | ||
2100 | 190 | } | ||
2101 | 191 | |||
2102 | 192 | # Possible results for an incr or decr cmd: | ||
2103 | 193 | # - "NOT_FOUND\r\n" to indicate the item with this value was not found | ||
2104 | 194 | # | ||
2105 | 195 | # - <value>\r\n , where <value> is the new value of the item's data, | ||
2106 | 196 | # after the increment/decrement operation was carried out. | ||
2107 | 197 | # On success, MemcachedProtocolParser sets res='' and val=the new val. | ||
2108 | 198 | # On failure, res=the result and val=''. | ||
2109 | 199 | sub handle_incr_decr_cmd { | ||
2110 | 200 | my ( $event ) = @_; | ||
2111 | 201 | return $event; | ||
2112 | 202 | } | ||
2113 | 203 | |||
2114 | 204 | sub _d { | ||
2115 | 205 | my ($package, undef, $line) = caller 0; | ||
2116 | 206 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | ||
2117 | 207 | map { defined $_ ? $_ : 'undef' } | ||
2118 | 208 | @_; | ||
2119 | 209 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | ||
2120 | 210 | } | ||
2121 | 211 | |||
2122 | 212 | 1; | ||
2123 | 213 | } | ||
2124 | 214 | # ########################################################################### | ||
2125 | 215 | # End MemcachedEvent package | ||
2126 | 216 | # ########################################################################### | ||
2127 | 217 | 0 | ||
2128 | === removed file 'lib/MemcachedProtocolParser.pm' | |||
2129 | --- lib/MemcachedProtocolParser.pm 2013-01-03 00:19:16 +0000 | |||
2130 | +++ lib/MemcachedProtocolParser.pm 1970-01-01 00:00:00 +0000 | |||
2131 | @@ -1,424 +0,0 @@ | |||
2132 | 1 | # This program is copyright 2007-2011 Percona Ireland Ltd. | ||
2133 | 2 | # Feedback and improvements are welcome. | ||
2134 | 3 | # | ||
2135 | 4 | # THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED | ||
2136 | 5 | # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF | ||
2137 | 6 | # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. | ||
2138 | 7 | # | ||
2139 | 8 | # This program is free software; you can redistribute it and/or modify it under | ||
2140 | 9 | # the terms of the GNU General Public License as published by the Free Software | ||
2141 | 10 | # Foundation, version 2; OR the Perl Artistic License. On UNIX and similar | ||
2142 | 11 | # systems, you can issue `man perlgpl' or `man perlartistic' to read these | ||
2143 | 12 | # licenses. | ||
2144 | 13 | # | ||
2145 | 14 | # You should have received a copy of the GNU General Public License along with | ||
2146 | 15 | # this program; if not, write to the Free Software Foundation, Inc., 59 Temple | ||
2147 | 16 | # Place, Suite 330, Boston, MA 02111-1307 USA. | ||
2148 | 17 | # ########################################################################### | ||
2149 | 18 | # MemcachedProtocolParser package | ||
2150 | 19 | # ########################################################################### | ||
2151 | 20 | { | ||
2152 | 21 | # Package: MemcachedProtocolParser | ||
2153 | 22 | # MemcachedProtocolParser parses memcached events from tcpdump files. | ||
2154 | 23 | package MemcachedProtocolParser; | ||
2155 | 24 | |||
2156 | 25 | use strict; | ||
2157 | 26 | use warnings FATAL => 'all'; | ||
2158 | 27 | use English qw(-no_match_vars); | ||
2159 | 28 | |||
2160 | 29 | use Data::Dumper; | ||
2161 | 30 | $Data::Dumper::Indent = 1; | ||
2162 | 31 | $Data::Dumper::Sortkeys = 1; | ||
2163 | 32 | $Data::Dumper::Quotekeys = 0; | ||
2164 | 33 | |||
2165 | 34 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
2166 | 35 | |||
2167 | 36 | sub new { | ||
2168 | 37 | my ( $class, %args ) = @_; | ||
2169 | 38 | |||
2170 | 39 | my $self = { | ||
2171 | 40 | server => $args{server}, | ||
2172 | 41 | port => $args{port} || '11211', | ||
2173 | 42 | sessions => {}, | ||
2174 | 43 | o => $args{o}, | ||
2175 | 44 | }; | ||
2176 | 45 | return bless $self, $class; | ||
2177 | 46 | } | ||
2178 | 47 | |||
2179 | 48 | # The packet arg should be a hashref from TcpdumpParser::parse_event(). | ||
2180 | 49 | # misc is a placeholder for future features. | ||
2181 | 50 | sub parse_event { | ||
2182 | 51 | my ( $self, %args ) = @_; | ||
2183 | 52 | my @required_args = qw(event); | ||
2184 | 53 | foreach my $arg ( @required_args ) { | ||
2185 | 54 | die "I need a $arg argument" unless $args{$arg}; | ||
2186 | 55 | } | ||
2187 | 56 | my $packet = @args{@required_args}; | ||
2188 | 57 | |||
2189 | 58 | # Return early if there's no TCP data. These are usually ACK packets, but | ||
2190 | 59 | # they could also be FINs in which case, we should close and delete the | ||
2191 | 60 | # client's session. | ||
2192 | 61 | # TODO: It seems we don't handle FIN here? So I moved this code block here. | ||
2193 | 62 | if ( $packet->{data_len} == 0 ) { | ||
2194 | 63 | PTDEBUG && _d('No TCP data'); | ||
2195 | 64 | $args{stats}->{no_tcp_data}++ if $args{stats}; | ||
2196 | 65 | return; | ||
2197 | 66 | } | ||
2198 | 67 | |||
2199 | 68 | my $src_host = "$packet->{src_host}:$packet->{src_port}"; | ||
2200 | 69 | my $dst_host = "$packet->{dst_host}:$packet->{dst_port}"; | ||
2201 | 70 | |||
2202 | 71 | if ( my $server = $self->{server} ) { # Watch only the given server. | ||
2203 | 72 | $server .= ":$self->{port}"; | ||
2204 | 73 | if ( $src_host ne $server && $dst_host ne $server ) { | ||
2205 | 74 | PTDEBUG && _d('Packet is not to or from', $server); | ||
2206 | 75 | $args{stats}->{not_watched_server}++ if $args{stats}; | ||
2207 | 76 | return; | ||
2208 | 77 | } | ||
2209 | 78 | } | ||
2210 | 79 | |||
2211 | 80 | # Auto-detect the server by looking for port 11211 | ||
2212 | 81 | my $packet_from; | ||
2213 | 82 | my $client; | ||
2214 | 83 | if ( $src_host =~ m/:$self->{port}$/ ) { | ||
2215 | 84 | $packet_from = 'server'; | ||
2216 | 85 | $client = $dst_host; | ||
2217 | 86 | } | ||
2218 | 87 | elsif ( $dst_host =~ m/:$self->{port}$/ ) { | ||
2219 | 88 | $packet_from = 'client'; | ||
2220 | 89 | $client = $src_host; | ||
2221 | 90 | } | ||
2222 | 91 | else { | ||
2223 | 92 | warn 'Packet is not to or from memcached server: ', Dumper($packet); | ||
2224 | 93 | return; | ||
2225 | 94 | } | ||
2226 | 95 | PTDEBUG && _d('Client:', $client); | ||
2227 | 96 | |||
2228 | 97 | # Get the client's session info or create a new session if the | ||
2229 | 98 | # client hasn't been seen before. | ||
2230 | 99 | if ( !exists $self->{sessions}->{$client} ) { | ||
2231 | 100 | PTDEBUG && _d('New session'); | ||
2232 | 101 | $self->{sessions}->{$client} = { | ||
2233 | 102 | client => $client, | ||
2234 | 103 | state => undef, | ||
2235 | 104 | raw_packets => [], | ||
2236 | 105 | # ts -- wait for ts later. | ||
2237 | 106 | }; | ||
2238 | 107 | }; | ||
2239 | 108 | my $session = $self->{sessions}->{$client}; | ||
2240 | 109 | |||
2241 | 110 | # Save raw packets to dump later in case something fails. | ||
2242 | 111 | push @{$session->{raw_packets}}, $packet->{raw_packet}; | ||
2243 | 112 | |||
2244 | 113 | # Finally, parse the packet and maybe create an event. | ||
2245 | 114 | $packet->{data} = pack('H*', $packet->{data}); | ||
2246 | 115 | my $event; | ||
2247 | 116 | if ( $packet_from eq 'server' ) { | ||
2248 | 117 | $event = $self->_packet_from_server($packet, $session, %args); | ||
2249 | 118 | } | ||
2250 | 119 | elsif ( $packet_from eq 'client' ) { | ||
2251 | 120 | $event = $self->_packet_from_client($packet, $session, %args); | ||
2252 | 121 | } | ||
2253 | 122 | else { | ||
2254 | 123 | # Should not get here. | ||
2255 | 124 | $args{stats}->{unknown_packet_origin}++ if $args{stats}; | ||
2256 | 125 | die 'Packet origin unknown'; | ||
2257 | 126 | } | ||
2258 | 127 | |||
2259 | 128 | PTDEBUG && _d('Done with packet; event:', Dumper($event)); | ||
2260 | 129 | $args{stats}->{events_parsed}++ if $args{stats}; | ||
2261 | 130 | return $event; | ||
2262 | 131 | } | ||
2263 | 132 | |||
2264 | 133 | # Handles a packet from the server given the state of the session. Returns an | ||
2265 | 134 | # event if one was ready to be created, otherwise returns nothing. | ||
2266 | 135 | sub _packet_from_server { | ||
2267 | 136 | my ( $self, $packet, $session, %args ) = @_; | ||
2268 | 137 | die "I need a packet" unless $packet; | ||
2269 | 138 | die "I need a session" unless $session; | ||
2270 | 139 | |||
2271 | 140 | PTDEBUG && _d('Packet is from server; client state:', $session->{state}); | ||
2272 | 141 | |||
2273 | 142 | my $data = $packet->{data}; | ||
2274 | 143 | |||
2275 | 144 | # If there's no session state, then we're catching a server response | ||
2276 | 145 | # mid-stream. | ||
2277 | 146 | if ( !$session->{state} ) { | ||
2278 | 147 | PTDEBUG && _d('Ignoring mid-stream server response'); | ||
2279 | 148 | $args{stats}->{ignored_midstream_server_response}++ if $args{stats}; | ||
2280 | 149 | return; | ||
2281 | 150 | } | ||
2282 | 151 | |||
2283 | 152 | # Assume that the server is returning only one value. TODO: make it | ||
2284 | 153 | # handle multi-gets. | ||
2285 | 154 | if ( $session->{state} eq 'awaiting reply' ) { | ||
2286 | 155 | PTDEBUG && _d('State is awaiting reply'); | ||
2287 | 156 | # \r\n == 0d0a | ||
2288 | 157 | my ($line1, $rest) = $packet->{data} =~ m/\A(.*?)\r\n(.*)?/s; | ||
2289 | 158 | if ( !$line1 ) { | ||
2290 | 159 | $args{stats}->{unknown_server_data}++ if $args{stats}; | ||
2291 | 160 | die "Unknown memcached data from server"; | ||
2292 | 161 | } | ||
2293 | 162 | |||
2294 | 163 | # Split up the first line into its parts. | ||
2295 | 164 | my @vals = $line1 =~ m/(\S+)/g; | ||
2296 | 165 | $session->{res} = shift @vals; | ||
2297 | 166 | PTDEBUG && _d('Result of last', $session->{cmd}, 'cmd:', $session->{res}); | ||
2298 | 167 | |||
2299 | 168 | if ( $session->{cmd} eq 'incr' || $session->{cmd} eq 'decr' ) { | ||
2300 | 169 | PTDEBUG && _d('It is an incr or decr'); | ||
2301 | 170 | if ( $session->{res} !~ m/\D/ ) { # It's an integer, not an error | ||
2302 | 171 | PTDEBUG && _d('Got a value for the incr/decr'); | ||
2303 | 172 | $session->{val} = $session->{res}; | ||
2304 | 173 | $session->{res} = ''; | ||
2305 | 174 | } | ||
2306 | 175 | } | ||
2307 | 176 | elsif ( $session->{res} eq 'VALUE' ) { | ||
2308 | 177 | PTDEBUG && _d('It is the result of a "get"'); | ||
2309 | 178 | my ($key, $flags, $bytes) = @vals; | ||
2310 | 179 | defined $session->{flags} or $session->{flags} = $flags; | ||
2311 | 180 | defined $session->{bytes} or $session->{bytes} = $bytes; | ||
2312 | 181 | |||
2313 | 182 | # Get the value from the $rest. | ||
2314 | 183 | # TODO: there might be multiple responses | ||
2315 | 184 | if ( $rest && $bytes ) { | ||
2316 | 185 | PTDEBUG && _d('There is a value'); | ||
2317 | 186 | if ( length($rest) > $bytes ) { | ||
2318 | 187 | PTDEBUG && _d('Got complete response'); | ||
2319 | 188 | $session->{val} = substr($rest, 0, $bytes); | ||
2320 | 189 | } | ||
2321 | 190 | else { | ||
2322 | 191 | PTDEBUG && _d('Got partial response, saving for later'); | ||
2323 | 192 | push @{$session->{partial}}, [ $packet->{seq}, $rest ]; | ||
2324 | 193 | $session->{gathered} += length($rest); | ||
2325 | 194 | $session->{state} = 'partial recv'; | ||
2326 | 195 | return; # Prevent firing an event. | ||
2327 | 196 | } | ||
2328 | 197 | } | ||
2329 | 198 | } | ||
2330 | 199 | elsif ( $session->{res} eq 'END' ) { | ||
2331 | 200 | # Technically NOT_FOUND is an error, and this isn't an error it's just | ||
2332 | 201 | # a NULL, but what it really means is the value isn't found. | ||
2333 | 202 | PTDEBUG && _d('Got an END without any data, firing NOT_FOUND'); | ||
2334 | 203 | $session->{res} = 'NOT_FOUND'; | ||
2335 | 204 | } | ||
2336 | 205 | elsif ( $session->{res} !~ m/STORED|DELETED|NOT_FOUND/ ) { | ||
2337 | 206 | # Not really sure what else would get us here... want to make a note | ||
2338 | 207 | # and not have an uncaught condition. | ||
2339 | 208 | PTDEBUG && _d('Unknown result'); | ||
2340 | 209 | } | ||
2341 | 210 | else { | ||
2342 | 211 | $args{stats}->{unknown_server_response}++ if $args{stats}; | ||
2343 | 212 | } | ||
2344 | 213 | } | ||
2345 | 214 | else { # Should be 'partial recv' | ||
2346 | 215 | PTDEBUG && _d('Session state: ', $session->{state}); | ||
2347 | 216 | push @{$session->{partial}}, [ $packet->{seq}, $data ]; | ||
2348 | 217 | $session->{gathered} += length($data); | ||
2349 | 218 | PTDEBUG && _d('Gathered', $session->{gathered}, 'bytes in', | ||
2350 | 219 | scalar(@{$session->{partial}}), 'packets from server'); | ||
2351 | 220 | if ( $session->{gathered} >= $session->{bytes} + 2 ) { # Done. | ||
2352 | 221 | PTDEBUG && _d('End of partial response, preparing event'); | ||
2353 | 222 | my $val = join('', | ||
2354 | 223 | map { $_->[1] } | ||
2355 | 224 | # Sort in proper sequence because TCP might reorder them. | ||
2356 | 225 | sort { $a->[0] <=> $b->[0] } | ||
2357 | 226 | @{$session->{partial}}); | ||
2358 | 227 | $session->{val} = substr($val, 0, $session->{bytes}); | ||
2359 | 228 | } | ||
2360 | 229 | else { | ||
2361 | 230 | PTDEBUG && _d('Partial response continues, no action'); | ||
2362 | 231 | return; # Prevent firing event. | ||
2363 | 232 | } | ||
2364 | 233 | } | ||
2365 | 234 | |||
2366 | 235 | PTDEBUG && _d('Creating event, deleting session'); | ||
2367 | 236 | my $event = make_event($session, $packet); | ||
2368 | 237 | delete $self->{sessions}->{$session->{client}}; # memcached is stateless! | ||
2369 | 238 | $session->{raw_packets} = []; # Avoid keeping forever | ||
2370 | 239 | return $event; | ||
2371 | 240 | } | ||
2372 | 241 | |||
2373 | 242 | # Handles a packet from the client given the state of the session. | ||
2374 | 243 | sub _packet_from_client { | ||
2375 | 244 | my ( $self, $packet, $session, %args ) = @_; | ||
2376 | 245 | die "I need a packet" unless $packet; | ||
2377 | 246 | die "I need a session" unless $session; | ||
2378 | 247 | |||
2379 | 248 | PTDEBUG && _d('Packet is from client; state:', $session->{state}); | ||
2380 | 249 | |||
2381 | 250 | my $event; | ||
2382 | 251 | if ( ($session->{state} || '') =~m/awaiting reply|partial recv/ ) { | ||
2383 | 252 | # Whoa, we expected something from the server, not the client. Fire an | ||
2384 | 253 | # INTERRUPTED with what we've got, and create a new session. | ||
2385 | 254 | PTDEBUG && _d("Expected data from the client, looks like interrupted"); | ||
2386 | 255 | $session->{res} = 'INTERRUPTED'; | ||
2387 | 256 | $event = make_event($session, $packet); | ||
2388 | 257 | my $client = $session->{client}; | ||
2389 | 258 | delete @{$session}{keys %$session}; | ||
2390 | 259 | $session->{client} = $client; | ||
2391 | 260 | } | ||
2392 | 261 | |||
2393 | 262 | my ($line1, $val); | ||
2394 | 263 | my ($cmd, $key, $flags, $exptime, $bytes); | ||
2395 | 264 | |||
2396 | 265 | if ( !$session->{state} ) { | ||
2397 | 266 | PTDEBUG && _d('Session state: ', $session->{state}); | ||
2398 | 267 | # Split up the first line into its parts. | ||
2399 | 268 | ($line1, $val) = $packet->{data} =~ m/\A(.*?)\r\n(.+)?/s; | ||
2400 | 269 | if ( !$line1 ) { | ||
2401 | 270 | PTDEBUG && _d('Unknown memcached data from client, skipping packet'); | ||
2402 | 271 | $args{stats}->{unknown_client_data}++ if $args{stats}; | ||
2403 | 272 | return; | ||
2404 | 273 | } | ||
2405 | 274 | |||
2406 | 275 | # TODO: handle <cas unique> and [noreply] | ||
2407 | 276 | my @vals = $line1 =~ m/(\S+)/g; | ||
2408 | 277 | $cmd = lc shift @vals; | ||
2409 | 278 | PTDEBUG && _d('$cmd is a ', $cmd); | ||
2410 | 279 | if ( $cmd eq 'set' || $cmd eq 'add' || $cmd eq 'replace' ) { | ||
2411 | 280 | ($key, $flags, $exptime, $bytes) = @vals; | ||
2412 | 281 | $session->{bytes} = $bytes; | ||
2413 | 282 | } | ||
2414 | 283 | elsif ( $cmd eq 'get' ) { | ||
2415 | 284 | ($key) = @vals; | ||
2416 | 285 | if ( $val ) { | ||
2417 | 286 | PTDEBUG && _d('Multiple cmds:', $val); | ||
2418 | 287 | $val = undef; | ||
2419 | 288 | } | ||
2420 | 289 | } | ||
2421 | 290 | elsif ( $cmd eq 'delete' ) { | ||
2422 | 291 | ($key) = @vals; # TODO: handle the <queue_time> | ||
2423 | 292 | if ( $val ) { | ||
2424 | 293 | PTDEBUG && _d('Multiple cmds:', $val); | ||
2425 | 294 | $val = undef; | ||
2426 | 295 | } | ||
2427 | 296 | } | ||
2428 | 297 | elsif ( $cmd eq 'incr' || $cmd eq 'decr' ) { | ||
2429 | 298 | ($key) = @vals; | ||
2430 | 299 | } | ||
2431 | 300 | else { | ||
2432 | 301 | PTDEBUG && _d("Don't know how to handle", $cmd, "command"); | ||
2433 | 302 | $args{stats}->{unknown_client_command}++ if $args{stats}; | ||
2434 | 303 | return; | ||
2435 | 304 | } | ||
2436 | 305 | |||
2437 | 306 | @{$session}{qw(cmd key flags exptime)} | ||
2438 | 307 | = ($cmd, $key, $flags, $exptime); | ||
2439 | 308 | $session->{host} = $packet->{src_host}; | ||
2440 | 309 | $session->{pos_in_log} = $packet->{pos_in_log}; | ||
2441 | 310 | $session->{ts} = $packet->{ts}; | ||
2442 | 311 | } | ||
2443 | 312 | else { | ||
2444 | 313 | PTDEBUG && _d('Session state: ', $session->{state}); | ||
2445 | 314 | $val = $packet->{data}; | ||
2446 | 315 | } | ||
2447 | 316 | |||
2448 | 317 | # Handle the rest of the packet. It might not be the whole value that was | ||
2449 | 318 | # sent, for example for a big set(). We need to look at the number of bytes | ||
2450 | 319 | # and see if we got it all. | ||
2451 | 320 | $session->{state} = 'awaiting reply'; # Assume we got the whole packet | ||
2452 | 321 | if ( $val ) { | ||
2453 | 322 | if ( $session->{bytes} + 2 == length($val) ) { # +2 for the \r\n | ||
2454 | 323 | PTDEBUG && _d('Complete send'); | ||
2455 | 324 | $val =~ s/\r\n\Z//; # We got the whole thing. | ||
2456 | 325 | $session->{val} = $val; | ||
2457 | 326 | } | ||
2458 | 327 | else { # We apparently did NOT get the whole thing. | ||
2459 | 328 | PTDEBUG && _d('Partial send, saving for later'); | ||
2460 | 329 | push @{$session->{partial}}, | ||
2461 | 330 | [ $packet->{seq}, $val ]; | ||
2462 | 331 | $session->{gathered} += length($val); | ||
2463 | 332 | PTDEBUG && _d('Gathered', $session->{gathered}, 'bytes in', | ||
2464 | 333 | scalar(@{$session->{partial}}), 'packets from client'); | ||
2465 | 334 | if ( $session->{gathered} >= $session->{bytes} + 2 ) { # Done. | ||
2466 | 335 | PTDEBUG && _d('Message looks complete now, saving value'); | ||
2467 | 336 | $val = join('', | ||
2468 | 337 | map { $_->[1] } | ||
2469 | 338 | # Sort in proper sequence because TCP might reorder them. | ||
2470 | 339 | sort { $a->[0] <=> $b->[0] } | ||
2471 | 340 | @{$session->{partial}}); | ||
2472 | 341 | $val =~ s/\r\n\Z//; | ||
2473 | 342 | $session->{val} = $val; | ||
2474 | 343 | } | ||
2475 | 344 | else { | ||
2476 | 345 | PTDEBUG && _d('Message not complete'); | ||
2477 | 346 | $val = '[INCOMPLETE]'; | ||
2478 | 347 | $session->{state} = 'partial send'; | ||
2479 | 348 | } | ||
2480 | 349 | } | ||
2481 | 350 | } | ||
2482 | 351 | |||
2483 | 352 | return $event; | ||
2484 | 353 | } | ||
2485 | 354 | |||
2486 | 355 | # The event is not yet suitable for mk-query-digest. It lacks, for example, | ||
2487 | 356 | # an arg and fingerprint attribute. The event should be passed to | ||
2488 | 357 | # MemcachedEvent::make_event() to transform it. | ||
2489 | 358 | sub make_event { | ||
2490 | 359 | my ( $session, $packet ) = @_; | ||
2491 | 360 | my $event = { | ||
2492 | 361 | cmd => $session->{cmd}, | ||
2493 | 362 | key => $session->{key}, | ||
2494 | 363 | val => $session->{val} || '', | ||
2495 | 364 | res => $session->{res}, | ||
2496 | 365 | ts => $session->{ts}, | ||
2497 | 366 | host => $session->{host}, | ||
2498 | 367 | flags => $session->{flags} || 0, | ||
2499 | 368 | exptime => $session->{exptime} || 0, | ||
2500 | 369 | bytes => $session->{bytes} || 0, | ||
2501 | 370 | Query_time => timestamp_diff($session->{ts}, $packet->{ts}), | ||
2502 | 371 | pos_in_log => $session->{pos_in_log}, | ||
2503 | 372 | }; | ||
2504 | 373 | return $event; | ||
2505 | 374 | } | ||
2506 | 375 | |||
2507 | 376 | sub _get_errors_fh { | ||
2508 | 377 | my ( $self ) = @_; | ||
2509 | 378 | my $errors_fh = $self->{errors_fh}; | ||
2510 | 379 | return $errors_fh if $errors_fh; | ||
2511 | 380 | |||
2512 | 381 | # Errors file isn't open yet; try to open it. | ||
2513 | 382 | my $o = $self->{o}; | ||
2514 | 383 | if ( $o && $o->has('tcpdump-errors') && $o->got('tcpdump-errors') ) { | ||
2515 | 384 | my $errors_file = $o->get('tcpdump-errors'); | ||
2516 | 385 | PTDEBUG && _d('tcpdump-errors file:', $errors_file); | ||
2517 | 386 | open $errors_fh, '>>', $errors_file | ||
2518 | 387 | or die "Cannot open tcpdump-errors file $errors_file: $OS_ERROR"; | ||
2519 | 388 | } | ||
2520 | 389 | |||
2521 | 390 | $self->{errors_fh} = $errors_fh; | ||
2522 | 391 | return $errors_fh; | ||
2523 | 392 | } | ||
2524 | 393 | |||
2525 | 394 | sub _d { | ||
2526 | 395 | my ($package, undef, $line) = caller 0; | ||
2527 | 396 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | ||
2528 | 397 | map { defined $_ ? $_ : 'undef' } | ||
2529 | 398 | @_; | ||
2530 | 399 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | ||
2531 | 400 | } | ||
2532 | 401 | |||
2533 | 402 | # Returns the difference between two tcpdump timestamps. TODO: this is in | ||
2534 | 403 | # MySQLProtocolParser too, best to factor it out somewhere common. | ||
2535 | 404 | sub timestamp_diff { | ||
2536 | 405 | my ( $start, $end ) = @_; | ||
2537 | 406 | my $sd = substr($start, 0, 11, ''); | ||
2538 | 407 | my $ed = substr($end, 0, 11, ''); | ||
2539 | 408 | my ( $sh, $sm, $ss ) = split(/:/, $start); | ||
2540 | 409 | my ( $eh, $em, $es ) = split(/:/, $end); | ||
2541 | 410 | my $esecs = ($eh * 3600 + $em * 60 + $es); | ||
2542 | 411 | my $ssecs = ($sh * 3600 + $sm * 60 + $ss); | ||
2543 | 412 | if ( $sd eq $ed ) { | ||
2544 | 413 | return sprintf '%.6f', $esecs - $ssecs; | ||
2545 | 414 | } | ||
2546 | 415 | else { # Assume only one day boundary has been crossed, no DST, etc | ||
2547 | 416 | return sprintf '%.6f', ( 86_400 - $ssecs ) + $esecs; | ||
2548 | 417 | } | ||
2549 | 418 | } | ||
2550 | 419 | |||
2551 | 420 | 1; | ||
2552 | 421 | } | ||
2553 | 422 | # ########################################################################### | ||
2554 | 423 | # End MemcachedProtocolParser package | ||
2555 | 424 | # ########################################################################### | ||
2556 | 425 | 0 | ||
2557 | === removed file 'lib/PgLogParser.pm' | |||
2558 | --- lib/PgLogParser.pm 2013-01-03 00:19:16 +0000 | |||
2559 | +++ lib/PgLogParser.pm 1970-01-01 00:00:00 +0000 | |||
2560 | @@ -1,669 +0,0 @@ | |||
2561 | 1 | # This program is copyright 2010-2011 Baron Schwartz, 2011 Percona Ireland Ltd. | ||
2562 | 2 | # Feedback and improvements are welcome. | ||
2563 | 3 | # | ||
2564 | 4 | # THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED | ||
2565 | 5 | # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF | ||
2566 | 6 | # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. | ||
2567 | 7 | # | ||
2568 | 8 | # This program is free software; you can redistribute it and/or modify it under | ||
2569 | 9 | # the terms of the GNU General Public License as published by the Free Software | ||
2570 | 10 | # Foundation, version 2; OR the Perl Artistic License. On UNIX and similar | ||
2571 | 11 | # systems, you can issue `man perlgpl' or `man perlartistic' to read these | ||
2572 | 12 | # licenses. | ||
2573 | 13 | # | ||
2574 | 14 | # You should have received a copy of the GNU General Public License along with | ||
2575 | 15 | # this program; if not, write to the Free Software Foundation, Inc., 59 Temple | ||
2576 | 16 | # Place, Suite 330, Boston, MA 02111-1307 USA. | ||
2577 | 17 | # ########################################################################### | ||
2578 | 18 | # PgLogParser package | ||
2579 | 19 | # ########################################################################### | ||
2580 | 20 | { | ||
2581 | 21 | # Package: PgLogParser | ||
2582 | 22 | # PgLogParser parses Postgres logs. | ||
2583 | 23 | package PgLogParser; | ||
2584 | 24 | |||
2585 | 25 | use strict; | ||
2586 | 26 | use warnings FATAL => 'all'; | ||
2587 | 27 | use English qw(-no_match_vars); | ||
2588 | 28 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
2589 | 29 | |||
2590 | 30 | use Data::Dumper; | ||
2591 | 31 | $Data::Dumper::Indent = 1; | ||
2592 | 32 | $Data::Dumper::Sortkeys = 1; | ||
2593 | 33 | $Data::Dumper::Quotekeys = 0; | ||
2594 | 34 | |||
2595 | 35 | # This regex is partially inspired by one from pgfouine. But there is no | ||
2596 | 36 | # documentation on the last capture in that regex, so I omit that. (TODO: that | ||
2597 | 37 | # actually seems to be for CSV logging.) | ||
2598 | 38 | # (?:[0-9XPFDBLA]{2}[0-9A-Z]{3}:[\s]+)? | ||
2599 | 39 | # Here I constrain to match at least two spaces after the severity level, | ||
2600 | 40 | # because the source code tells me to. I believe this is controlled in elog.c: | ||
2601 | 41 | # appendStringInfo(&buf, "%s: ", error_severity(edata->elevel)); | ||
2602 | 42 | my $log_line_regex = qr{ | ||
2603 | 43 | (LOG|DEBUG|CONTEXT|WARNING|ERROR|FATAL|PANIC|HINT | ||
2604 | 44 | |DETAIL|NOTICE|STATEMENT|INFO|LOCATION) | ||
2605 | 45 | :\s\s+ | ||
2606 | 46 | }x; | ||
2607 | 47 | |||
2608 | 48 | # The following are taken right from the comments in postgresql.conf for | ||
2609 | 49 | # log_line_prefix. | ||
2610 | 50 | my %attrib_name_for = ( | ||
2611 | 51 | u => 'user', | ||
2612 | 52 | d => 'db', | ||
2613 | 53 | r => 'host', # With port | ||
2614 | 54 | h => 'host', | ||
2615 | 55 | p => 'Process_id', | ||
2616 | 56 | t => 'ts', | ||
2617 | 57 | m => 'ts', # With milliseconds | ||
2618 | 58 | i => 'Query_type', | ||
2619 | 59 | c => 'Session_id', | ||
2620 | 60 | l => 'Line_no', | ||
2621 | 61 | s => 'Session_id', | ||
2622 | 62 | v => 'Vrt_trx_id', | ||
2623 | 63 | x => 'Trx_id', | ||
2624 | 64 | ); | ||
2625 | 65 | |||
2626 | 66 | # This class's data structure is a hashref with some statefulness: pending | ||
2627 | 67 | # lines. This is necessary because we sometimes don't know whether the event is | ||
2628 | 68 | # complete until we read the next line or even several lines, so we store these. | ||
2629 | 69 | # | ||
2630 | 70 | # Another bit of data that's stored in $self is some code to automatically | ||
2631 | 71 | # translate syslog into plain log format. | ||
2632 | 72 | sub new { | ||
2633 | 73 | my ( $class ) = @_; | ||
2634 | 74 | my $self = { | ||
2635 | 75 | pending => [], | ||
2636 | 76 | is_syslog => undef, | ||
2637 | 77 | next_event => undef, | ||
2638 | 78 | 'tell' => undef, | ||
2639 | 79 | }; | ||
2640 | 80 | return bless $self, $class; | ||
2641 | 81 | } | ||
2642 | 82 | |||
2643 | 83 | # This method accepts an iterator that contains an open log filehandle. It | ||
2644 | 84 | # reads events from the filehandle by calling the iterator, and returns the | ||
2645 | 85 | # events. | ||
2646 | 86 | # | ||
2647 | 87 | # Each event is a hashref of attribute => value pairs like: | ||
2648 | 88 | # my $event = { | ||
2649 | 89 | # ts => '', # Timestamp | ||
2650 | 90 | # arg => '', # Argument to the command | ||
2651 | 91 | # other attributes... | ||
2652 | 92 | # }; | ||
2653 | 93 | # | ||
2654 | 94 | # The log format is ideally prefixed with the following: | ||
2655 | 95 | # | ||
2656 | 96 | # * timestamp with microseconds | ||
2657 | 97 | # * session ID, user, database | ||
2658 | 98 | # | ||
2659 | 99 | # The format I'd like to see is something like this: | ||
2660 | 100 | # | ||
2661 | 101 | # 2010-02-08 15:31:48.685 EST c=4b7074b4.985,u=user,D=database LOG: | ||
2662 | 102 | # | ||
2663 | 103 | # However, pgfouine supports user=user, db=database format. And I think | ||
2664 | 104 | # it should be reasonable to grab pretty much any name=value properties out, and | ||
2665 | 105 | # handle them based on the lower-cased first character of $name, to match the | ||
2666 | 106 | # special values that are possible to give for log_line_prefix. For example, %u | ||
2667 | 107 | # = user, so anything starting with a 'u' should be interpreted as a user. | ||
2668 | 108 | # | ||
2669 | 109 | # In general the log format is rather flexible, and we don't know by looking at | ||
2670 | 110 | # any given line whether it's the last line in the event. So we often have to | ||
2671 | 111 | # read a line and then decide what to do with the previous line we saw. Thus we | ||
2672 | 112 | # use 'pending' when necessary but we try to do it as little as possible, | ||
2673 | 113 | # because it's double work to defer and re-parse lines; and we try to defer as | ||
2674 | 114 | # soon as possible so we don't have to do as much work. | ||
2675 | 115 | # | ||
2676 | 116 | # There are 3 categories of lines in a log file, referred to in the code as case | ||
2677 | 117 | # 1/2/3: | ||
2678 | 118 | # | ||
2679 | 119 | # - Those that start a possibly multi-line event | ||
2680 | 120 | # - Those that can continue one | ||
2681 | 121 | # - Those that are neither the start nor the continuation, and thus must be the | ||
2682 | 122 | # end. | ||
2683 | 123 | # | ||
2684 | 124 | # In cases 1 and 3, we have to check whether information from previous lines has | ||
2685 | 125 | # been accumulated. If it has, we defer the current line and create the event. | ||
2686 | 126 | # Otherwise we keep going, looking for more lines for the event that begins with | ||
2687 | 127 | # the current line. Processing the lines is easiest if we arrange the cases in | ||
2688 | 128 | # this order: 2, 1, 3. | ||
2689 | 129 | # | ||
2690 | 130 | # The term "line" is to be interpreted loosely here. Logs that are in syslog | ||
2691 | 131 | # format might have multi-line "lines" that are handled by the generated | ||
2692 | 132 | # $next_event closure and given back to the main while-loop with newlines in | ||
2693 | 133 | # them. Therefore, regexes that match "the rest of the line" generally need the | ||
2694 | 134 | # /s flag. | ||
2695 | 135 | sub parse_event { | ||
2696 | 136 | my ( $self, %args ) = @_; | ||
2697 | 137 | my @required_args = qw(next_event tell); | ||
2698 | 138 | foreach my $arg ( @required_args ) { | ||
2699 | 139 | die "I need a $arg argument" unless $args{$arg}; | ||
2700 | 140 | } | ||
2701 | 141 | |||
2702 | 142 | # The subroutine references that wrap the filehandle operations. | ||
2703 | 143 | my ( $next_event, $tell, $is_syslog ) = $self->generate_wrappers(%args); | ||
2704 | 144 | |||
2705 | 145 | # These are the properties for the log event, which will later be used to | ||
2706 | 146 | # create an event hash ref. | ||
2707 | 147 | my @properties = (); | ||
2708 | 148 | |||
2709 | 149 | # Holds the current line being processed, and its position in the log as a | ||
2710 | 150 | # byte offset from the beginning. In some cases we'll have to reset this | ||
2711 | 151 | # position later. We'll also have to take a wait-and-see attitude towards | ||
2712 | 152 | # the $pos_in_log, so we use $new_pos to record where we're working in the | ||
2713 | 153 | # log, and $pos_in_log to record where the beginning of the current event | ||
2714 | 154 | # started. | ||
2715 | 155 | my ($pos_in_log, $line, $was_pending) = $self->get_line(); | ||
2716 | 156 | my $new_pos; | ||
2717 | 157 | |||
2718 | 158 | # Sometimes we need to accumulate some lines and then join them together. | ||
2719 | 159 | # This is used for that. | ||
2720 | 160 | my @arg_lines; | ||
2721 | 161 | |||
2722 | 162 | # This is used to signal that an entire event has been found, and thus exit | ||
2723 | 163 | # the while loop. | ||
2724 | 164 | my $done; | ||
2725 | 165 | |||
2726 | 166 | # This is used to signal that an event's duration has already been found. | ||
2727 | 167 | # See the sample file pg-syslog-001.txt and the test for it. | ||
2728 | 168 | my $got_duration; | ||
2729 | 169 | |||
2730 | 170 | # Before we start, we read and discard lines until we get one with a header. | ||
2731 | 171 | # The only thing we can really count on is that a header line should have | ||
2732 | 172 | # the header in it. But, we only do this if we aren't in the middle of an | ||
2733 | 173 | # ongoing event, whose first line was pending. | ||
2734 | 174 | if ( !$was_pending && (!defined $line || $line !~ m/$log_line_regex/o) ) { | ||
2735 | 175 | PTDEBUG && _d('Skipping lines until I find a header'); | ||
2736 | 176 | my $found_header; | ||
2737 | 177 | LINE: | ||
2738 | 178 | while ( | ||
2739 | 179 | eval { | ||
2740 | 180 | ($new_pos, $line) = $self->get_line(); | ||
2741 | 181 | defined $line; | ||
2742 | 182 | } | ||
2743 | 183 | ) { | ||
2744 | 184 | if ( $line =~ m/$log_line_regex/o ) { | ||
2745 | 185 | $pos_in_log = $new_pos; | ||
2746 | 186 | last LINE; | ||
2747 | 187 | } | ||
2748 | 188 | else { | ||
2749 | 189 | PTDEBUG && _d('Line was not a header, will fetch another'); | ||
2750 | 190 | } | ||
2751 | 191 | } | ||
2752 | 192 | PTDEBUG && _d('Found a header line, now at pos_in_line', $pos_in_log); | ||
2753 | 193 | } | ||
2754 | 194 | |||
2755 | 195 | # We need to keep the line that begins the event we're parsing. | ||
2756 | 196 | my $first_line; | ||
2757 | 197 | |||
2758 | 198 | # This is for holding the type of the log line, which is important for | ||
2759 | 199 | # choosing the right code to run. | ||
2760 | 200 | my $line_type; | ||
2761 | 201 | |||
2762 | 202 | # Parse each line. | ||
2763 | 203 | LINE: | ||
2764 | 204 | while ( !$done && defined $line ) { | ||
2765 | 205 | |||
2766 | 206 | # Throw away the newline ending. | ||
2767 | 207 | chomp $line unless $is_syslog; | ||
2768 | 208 | |||
2769 | 209 | # This while loop works with LOG lines. Other lines, such as ERROR and | ||
2770 | 210 | # so forth, need to be handled outside this loop. The exception is when | ||
2771 | 211 | # there's nothing in progress in @arg_lines, and the non-LOG line might | ||
2772 | 212 | # just be something we can get relevant info from. | ||
2773 | 213 | if ( (($line_type) = $line =~ m/$log_line_regex/o) && $line_type ne 'LOG' ) { | ||
2774 | 214 | |||
2775 | 215 | # There's something in progress, so we abort the loop and let it be | ||
2776 | 216 | # handled specially. | ||
2777 | 217 | if ( @arg_lines ) { | ||
2778 | 218 | PTDEBUG && _d('Found a non-LOG line, exiting loop'); | ||
2779 | 219 | last LINE; | ||
2780 | 220 | } | ||
2781 | 221 | |||
2782 | 222 | # There's nothing in @arg_lines, so we save what info we can and keep | ||
2783 | 223 | # on going. | ||
2784 | 224 | else { | ||
2785 | 225 | $first_line ||= $line; | ||
2786 | 226 | |||
2787 | 227 | # Handle ERROR and STATEMENT lines... | ||
2788 | 228 | if ( my ($e) = $line =~ m/ERROR:\s+(\S.*)\Z/s ) { | ||
2789 | 229 | push @properties, 'Error_msg', $e; | ||
2790 | 230 | PTDEBUG && _d('Found an error msg, saving and continuing'); | ||
2791 | 231 | ($new_pos, $line) = $self->get_line(); | ||
2792 | 232 | next LINE; | ||
2793 | 233 | } | ||
2794 | 234 | |||
2795 | 235 | elsif ( my ($s) = $line =~ m/STATEMENT:\s+(\S.*)\Z/s ) { | ||
2796 | 236 | push @properties, 'arg', $s, 'cmd', 'Query'; | ||
2797 | 237 | PTDEBUG && _d('Found a statement, finishing up event'); | ||
2798 | 238 | $done = 1; | ||
2799 | 239 | last LINE; | ||
2800 | 240 | } | ||
2801 | 241 | |||
2802 | 242 | else { | ||
2803 | 243 | PTDEBUG && _d("I don't know what to do with this line"); | ||
2804 | 244 | } | ||
2805 | 245 | } | ||
2806 | 246 | |||
2807 | 247 | } | ||
2808 | 248 | |||
2809 | 249 | # The log isn't just queries. It also has status and informational lines | ||
2810 | 250 | # in it. We ignore these, but if we see one that's not recognized, we | ||
2811 | 251 | # warn. These types of things are better off in mk-error-log. | ||
2812 | 252 | if ( | ||
2813 | 253 | $line =~ m{ | ||
2814 | 254 | Address\sfamily\snot\ssupported\sby\sprotocol | ||
2815 | 255 | |archived\stransaction\slog\sfile | ||
2816 | 256 | |autovacuum:\sprocessing\sdatabase | ||
2817 | 257 | |checkpoint\srecord\sis\sat | ||
2818 | 258 | |checkpoints\sare\soccurring\stoo\sfrequently\s\( | ||
2819 | 259 | |could\snot\sreceive\sdata\sfrom\sclient | ||
2820 | 260 | |database\ssystem\sis\sready | ||
2821 | 261 | |database\ssystem\sis\sshut\sdown | ||
2822 | 262 | |database\ssystem\swas\sshut\sdown | ||
2823 | 263 | |incomplete\sstartup\spacket | ||
2824 | 264 | |invalid\slength\sof\sstartup\spacket | ||
2825 | 265 | |next\sMultiXactId: | ||
2826 | 266 | |next\stransaction\sID: | ||
2827 | 267 | |received\ssmart\sshutdown\srequest | ||
2828 | 268 | |recycled\stransaction\slog\sfile | ||
2829 | 269 | |redo\srecord\sis\sat | ||
2830 | 270 | |removing\sfile\s" | ||
2831 | 271 | |removing\stransaction\slog\sfile\s" | ||
2832 | 272 | |shutting\sdown | ||
2833 | 273 | |transaction\sID\swrap\slimit\sis | ||
2834 | 274 | }x | ||
2835 | 275 | ) { | ||
2836 | 276 | # We get the next line to process and skip the rest of the loop. | ||
2837 | 277 | PTDEBUG && _d('Skipping this line because it matches skip-pattern'); | ||
2838 | 278 | ($new_pos, $line) = $self->get_line(); | ||
2839 | 279 | next LINE; | ||
2840 | 280 | } | ||
2841 | 281 | |||
2842 | 282 | # Possibly reset $first_line, depending on whether it was determined to be | ||
2843 | 283 | # junk and unset. | ||
2844 | 284 | $first_line ||= $line; | ||
2845 | 285 | |||
2846 | 286 | # Case 2: non-header lines, optionally starting with a TAB, are a | ||
2847 | 287 | # continuation of the previous line. | ||
2848 | 288 | if ( $line !~ m/$log_line_regex/o && @arg_lines ) { | ||
2849 | 289 | |||
2850 | 290 | if ( !$is_syslog ) { | ||
2851 | 291 | # We need to translate tabs to newlines. Weirdly, some logs (see | ||
2852 | 292 | # samples/pg-log-005.txt) have newlines without a leading tab. | ||
2853 | 293 | # Maybe it's an older log format. | ||
2854 | 294 | $line =~ s/\A\t?/\n/; | ||
2855 | 295 | } | ||
2856 | 296 | |||
2857 | 297 | # Save the remainder. | ||
2858 | 298 | push @arg_lines, $line; | ||
2859 | 299 | PTDEBUG && _d('This was a continuation line'); | ||
2860 | 300 | } | ||
2861 | 301 | |||
2862 | 302 | # Cases 1 and 3: These lines start with some optional meta-data, and then | ||
2863 | 303 | # the $log_line_regex followed by the line's log message. The message can be | ||
2864 | 304 | # of the form "label: text....". Examples: | ||
2865 | 305 | # LOG: duration: 1.565 ms | ||
2866 | 306 | # LOG: statement: SELECT .... | ||
2867 | 307 | # LOG: duration: 1.565 ms statement: SELECT .... | ||
2868 | 308 | # In the above examples, the $label is duration, statement, and duration. | ||
2869 | 309 | elsif ( | ||
2870 | 310 | my ( $sev, $label, $rest ) | ||
2871 | 311 | = $line =~ m/$log_line_regex(.+?):\s+(.*)\Z/so | ||
2872 | 312 | ) { | ||
2873 | 313 | PTDEBUG && _d('Line is case 1 or case 3'); | ||
2874 | 314 | |||
2875 | 315 | # This is either a case 1 or case 3. If there's previously gathered | ||
2876 | 316 | # data in @arg_lines, it doesn't matter which -- we have to create an | ||
2877 | 317 | # event (a Query event), and we're $done. This is case 0xdeadbeef. | ||
2878 | 318 | if ( @arg_lines ) { | ||
2879 | 319 | $done = 1; | ||
2880 | 320 | PTDEBUG && _d('There are saved @arg_lines, we are done'); | ||
2881 | 321 | |||
2882 | 322 | # We shouldn't modify @properties based on $line, because $line | ||
2883 | 323 | # doesn't have anything to do with the stuff in @properties, which | ||
2884 | 324 | # is all related to the previous line(s). However, there is one | ||
2885 | 325 | # case in which the line could be part of the event: when it's a | ||
2886 | 326 | # plain 'duration' line. This happens when the statement is logged | ||
2887 | 327 | # on one line, and then the duration is logged afterwards. If this | ||
2888 | 328 | # is true, then we alter @properties, and we do NOT defer the current | ||
2889 | 329 | # line. | ||
2890 | 330 | if ( $label eq 'duration' && $rest =~ m/[0-9.]+\s+\S+\Z/ ) { | ||
2891 | 331 | if ( $got_duration ) { | ||
2892 | 332 | # Just discard the line. | ||
2893 | 333 | PTDEBUG && _d('Discarding line, duration already found'); | ||
2894 | 334 | } | ||
2895 | 335 | else { | ||
2896 | 336 | push @properties, 'Query_time', $self->duration_to_secs($rest); | ||
2897 | 337 | PTDEBUG && _d("Line's duration is for previous event:", $rest); | ||
2898 | 338 | } | ||
2899 | 339 | } | ||
2900 | 340 | else { | ||
2901 | 341 | # We'll come back to this line later. | ||
2902 | 342 | $self->pending($new_pos, $line); | ||
2903 | 343 | PTDEBUG && _d('Deferred line'); | ||
2904 | 344 | } | ||
2905 | 345 | } | ||
2906 | 346 | |||
2907 | 347 | # Here we test for case 1, lines that can start a multi-line event. | ||
2908 | 348 | elsif ( $label =~ m/\A(?:duration|statement|query)\Z/ ) { | ||
2909 | 349 | PTDEBUG && _d('Case 1: start a multi-line event'); | ||
2910 | 350 | |||
2911 | 351 | # If it's a duration, then there might be a statement later on the | ||
2912 | 352 | # same line and the duration applies to that. | ||
2913 | 353 | if ( $label eq 'duration' ) { | ||
2914 | 354 | |||
2915 | 355 | if ( | ||
2916 | 356 | (my ($dur, $stmt) | ||
2917 | 357 | = $rest =~ m/([0-9.]+ \S+)\s+(?:statement|query): *(.*)\Z/s) | ||
2918 | 358 | ) { | ||
2919 | 359 | # It does, so we'll pull out the Query_time etc now, rather | ||
2920 | 360 | # than doing it later, when we might end up in the case above | ||
2921 | 361 | # (case 0xdeadbeef). | ||
2922 | 362 | push @properties, 'Query_time', $self->duration_to_secs($dur); | ||
2923 | 363 | $got_duration = 1; | ||
2924 | 364 | push @arg_lines, $stmt; | ||
2925 | 365 | PTDEBUG && _d('Duration + statement'); | ||
2926 | 366 | } | ||
2927 | 367 | |||
2928 | 368 | else { | ||
2929 | 369 | # The duration line is just junk. It's the line after a | ||
2930 | 370 | # statement, but we never saw the statement (else we'd have | ||
2931 | 371 | # fallen into 0xdeadbeef above). Discard this line and adjust | ||
2932 | 372 | # pos_in_log. See t/samples/pg-log-002.txt for an example. | ||
2933 | 373 | $first_line = undef; | ||
2934 | 374 | ($pos_in_log, $line) = $self->get_line(); | ||
2935 | 375 | PTDEBUG && _d('Line applies to event we never saw, discarding'); | ||
2936 | 376 | next LINE; | ||
2937 | 377 | } | ||
2938 | 378 | } | ||
2939 | 379 | else { | ||
2940 | 380 | # This isn't a duration line, it's a statement or query. Put it | ||
2941 | 381 | # onto @arg_lines for later and keep going. | ||
2942 | 382 | push @arg_lines, $rest; | ||
2943 | 383 | PTDEBUG && _d('Putting onto @arg_lines'); | ||
2944 | 384 | } | ||
2945 | 385 | } | ||
2946 | 386 | |||
2947 | 387 | # Here is case 3, lines that can't be in case 1 or 2. These surely | ||
2948 | 388 | # terminate any event that's been accumulated, and if there isn't any | ||
2949 | 389 | # such, then we just create an event without the overhead of deferring. | ||
2950 | 390 | else { | ||
2951 | 391 | $done = 1; | ||
2952 | 392 | PTDEBUG && _d('Line is case 3, event is done'); | ||
2953 | 393 | |||
2954 | 394 | # Again, if there's previously gathered data in @arg_lines, we have | ||
2955 | 395 | # to defer the current line (not touching @properties) and revisit it. | ||
2956 | 396 | if ( @arg_lines ) { | ||
2957 | 397 | $self->pending($new_pos, $line); | ||
2958 | 398 | PTDEBUG && _d('There was @arg_lines, putting line to pending'); | ||
2959 | 399 | } | ||
2960 | 400 | |||
2961 | 401 | # Otherwise we can parse the line and put it into @properties. | ||
2962 | 402 | else { | ||
2963 | 403 | PTDEBUG && _d('No need to defer, process event from this line now'); | ||
2964 | 404 | push @properties, 'cmd', 'Admin', 'arg', $label; | ||
2965 | 405 | |||
2966 | 406 | # For some kinds of log lines, we can grab extra meta-data out of | ||
2967 | 407 | # the end of the line. | ||
2968 | 408 | # LOG: connection received: host=[local] | ||
2969 | 409 | if ( $label =~ m/\A(?:dis)?connection(?: received| authorized)?\Z/ ) { | ||
2970 | 410 | push @properties, $self->get_meta($rest); | ||
2971 | 411 | } | ||
2972 | 412 | |||
2973 | 413 | else { | ||
2974 | 414 | die "I don't understand line $line"; | ||
2975 | 415 | } | ||
2976 | 416 | |||
2977 | 417 | } | ||
2978 | 418 | } | ||
2979 | 419 | |||
2980 | 420 | } | ||
2981 | 421 | |||
2982 | 422 | # If the line isn't case 1, 2, or 3 I don't know what it is. | ||
2983 | 423 | else { | ||
2984 | 424 | die "I don't understand line $line"; | ||
2985 | 425 | } | ||
2986 | 426 | |||
2987 | 427 | # We get the next line to process. | ||
2988 | 428 | if ( !$done ) { | ||
2989 | 429 | ($new_pos, $line) = $self->get_line(); | ||
2990 | 430 | } | ||
2991 | 431 | } # LINE | ||
2992 | 432 | |||
2993 | 433 | # If we're at the end of the file, we finish and tell the caller we're done. | ||
2994 | 434 | if ( !defined $line ) { | ||
2995 | 435 | PTDEBUG && _d('Line not defined, at EOF; calling oktorun(0) if exists'); | ||
2996 | 436 | $args{oktorun}->(0) if $args{oktorun}; | ||
2997 | 437 | if ( !@arg_lines ) { | ||
2998 | 438 | PTDEBUG && _d('No saved @arg_lines either, we are all done'); | ||
2999 | 439 | return undef; | ||
3000 | 440 | } | ||
3001 | 441 | } | ||
3002 | 442 | |||
3003 | 443 | # If we got kicked out of the while loop because of a non-LOG line, we handle | ||
3004 | 444 | # that line here. | ||
3005 | 445 | if ( $line_type && $line_type ne 'LOG' ) { | ||
3006 | 446 | PTDEBUG && _d('Line is not a LOG line'); | ||
3007 | 447 | |||
3008 | 448 | # ERROR lines come in a few flavors. See t/samples/pg-log-006.txt, | ||
3009 | 449 | # t/samples/pg-syslog-002.txt, and t/samples/pg-syslog-007.txt for some | ||
3010 | 450 | # examples. The rules seem to be this: if the ERROR is followed by a | ||
3011 | 451 | # STATEMENT, and the STATEMENT's statement matches the query in | ||
3012 | 452 | # @arg_lines, then the STATEMENT message is redundant. (This can be | ||
3013 | 453 | # caused by various combos of configuration options in postgresql.conf). | ||
3014 | 454 | # However, if the ERROR's STATEMENT line doesn't match what's in | ||
3015 | 455 | # @arg_lines, then the ERROR actually starts a new event. If the ERROR is | ||
3016 | 456 | # followed by another LOG event, then the ERROR also starts a new event. | ||
3017 | 457 | if ( $line_type eq 'ERROR' ) { | ||
3018 | 458 | PTDEBUG && _d('Line is ERROR'); | ||
3019 | 459 | |||
3020 | 460 | # If there's already a statement in processing, then put aside the | ||
3021 | 461 | # current line, and peek ahead. | ||
3022 | 462 | if ( @arg_lines ) { | ||
3023 | 463 | PTDEBUG && _d('There is @arg_lines, will peek ahead one line'); | ||
3024 | 464 | my ( $temp_pos, $temp_line ) = $self->get_line(); | ||
3025 | 465 | my ( $type, $msg ); | ||
3026 | 466 | if ( | ||
3027 | 467 | defined $temp_line | ||
3028 | 468 | && ( ($type, $msg) = $temp_line =~ m/$log_line_regex(.*)/o ) | ||
3029 | 469 | && ( $type ne 'STATEMENT' || $msg eq $arg_lines[-1] ) | ||
3030 | 470 | ) { | ||
3031 | 471 | # Looks like the whole thing is pertaining to the current event | ||
3032 | 472 | # in progress. Add the error message to the event. | ||
3033 | 473 | PTDEBUG && _d('Error/statement line pertain to current event'); | ||
3034 | 474 | push @properties, 'Error_msg', $line =~ m/ERROR:\s*(\S.*)\Z/s; | ||
3035 | 475 | if ( $type ne 'STATEMENT' ) { | ||
3036 | 476 | PTDEBUG && _d('Must save peeked line, it is a', $type); | ||
3037 | 477 | $self->pending($temp_pos, $temp_line); | ||
3038 | 478 | } | ||
3039 | 479 | } | ||
3040 | 480 | elsif ( defined $temp_line && defined $type ) { | ||
3041 | 481 | # Looks like the current and next line are about a new event. | ||
3042 | 482 | # Put them into pending. | ||
3043 | 483 | PTDEBUG && _d('Error/statement line are a new event'); | ||
3044 | 484 | $self->pending($new_pos, $line); | ||
3045 | 485 | $self->pending($temp_pos, $temp_line); | ||
3046 | 486 | } | ||
3047 | 487 | else { | ||
3048 | 488 | PTDEBUG && _d("Unknown line", $line); | ||
3049 | 489 | } | ||
3050 | 490 | } | ||
3051 | 491 | } | ||
3052 | 492 | else { | ||
3053 | 493 | PTDEBUG && _d("Unknown line", $line); | ||
3054 | 494 | } | ||
3055 | 495 | } | ||
3056 | 496 | |||
3057 | 497 | # If $done is true, then some of the above code decided that the full | ||
3058 | 498 | # event has been found. If we reached the end of the file, then we might | ||
3059 | 499 | # also have something in @arg_lines, although we didn't find the "line after" | ||
3060 | 500 | # that signals the event was done. In either case we return an event. This | ||
3061 | 501 | # should be the only 'return' statement in this block of code. | ||
3062 | 502 | if ( $done || @arg_lines ) { | ||
3063 | 503 | PTDEBUG && _d('Making event'); | ||
3064 | 504 | |||
3065 | 505 | # Finish building the event. | ||
3066 | 506 | push @properties, 'pos_in_log', $pos_in_log; | ||
3067 | 507 | |||
3068 | 508 | # Statement/query lines will be in @arg_lines. | ||
3069 | 509 | if ( @arg_lines ) { | ||
3070 | 510 | PTDEBUG && _d('Assembling @arg_lines: ', scalar @arg_lines); | ||
3071 | 511 | push @properties, 'arg', join('', @arg_lines), 'cmd', 'Query'; | ||
3072 | 512 | } | ||
3073 | 513 | |||
3074 | 514 | if ( $first_line ) { | ||
3075 | 515 | # Handle some meta-data: a timestamp, with optional milliseconds. | ||
3076 | 516 | if ( my ($ts) = $first_line =~ m/([0-9-]{10} [0-9:.]{8,12})/ ) { | ||
3077 | 517 | PTDEBUG && _d('Getting timestamp', $ts); | ||
3078 | 518 | push @properties, 'ts', $ts; | ||
3079 | 519 | } | ||
3080 | 520 | |||
3081 | 521 | # Find meta-data embedded in the log line prefix, in name=value format. | ||
3082 | 522 | if ( my ($meta) = $first_line =~ m/(.*?)[A-Z]{3,}: / ) { | ||
3083 | 523 | PTDEBUG && _d('Found a meta-data chunk:', $meta); | ||
3084 | 524 | push @properties, $self->get_meta($meta); | ||
3085 | 525 | } | ||
3086 | 526 | } | ||
3087 | 527 | |||
3088 | 528 | # Dump info about what we've found, but don't dump $event; want to see | ||
3089 | 529 | # full dump of all properties, and after it's been cast into a hash, | ||
3090 | 530 | # duplicated keys will be gone. | ||
3091 | 531 | PTDEBUG && _d('Properties of event:', Dumper(\@properties)); | ||
3092 | 532 | my $event = { @properties }; | ||
3093 | 533 | $event->{bytes} = length($event->{arg} || ''); | ||
3094 | 534 | return $event; | ||
3095 | 535 | } | ||
3096 | 536 | |||
3097 | 537 | } | ||
3098 | 538 | |||
3099 | 539 | # Parses key=value meta-data from the $meta string, and returns a list of event | ||
3100 | 540 | # attribute names and values. | ||
3101 | 541 | sub get_meta { | ||
3102 | 542 | my ( $self, $meta ) = @_; | ||
3103 | 543 | my @properties; | ||
3104 | 544 | foreach my $set ( $meta =~ m/(\w+=[^, ]+)/g ) { | ||
3105 | 545 | my ($key, $val) = split(/=/, $set); | ||
3106 | 546 | if ( $key && $val ) { | ||
3107 | 547 | # The first letter of the name, lowercased, determines the | ||
3108 | 548 | # meaning of the item. | ||
3109 | 549 | if ( my $prop = $attrib_name_for{lc substr($key, 0, 1)} ) { | ||
3110 | 550 | push @properties, $prop, $val; | ||
3111 | 551 | } | ||
3112 | 552 | else { | ||
3113 | 553 | PTDEBUG && _d('Bad meta key', $set); | ||
3114 | 554 | } | ||
3115 | 555 | } | ||
3116 | 556 | else { | ||
3117 | 557 | PTDEBUG && _d("Can't figure out meta from", $set); | ||
3118 | 558 | } | ||
3119 | 559 | } | ||
3120 | 560 | return @properties; | ||
3121 | 561 | } | ||
3122 | 562 | |||
3123 | 563 | # This subroutine abstracts the process and source of getting a line of text and | ||
3124 | 564 | # its position in the log file. It might get the line of text from the log; it | ||
3125 | 565 | # might get it from the @pending array. It also does infinite loop checking | ||
3126 | 566 | # TODO. | ||
3127 | 567 | sub get_line { | ||
3128 | 568 | my ( $self ) = @_; | ||
3129 | 569 | my ($pos, $line, $was_pending) = $self->pending; | ||
3130 | 570 | if ( ! defined $line ) { | ||
3131 | 571 | PTDEBUG && _d('Got nothing from pending, trying the $fh'); | ||
3132 | 572 | my ( $next_event, $tell) = @{$self}{qw(next_event tell)}; | ||
3133 | 573 | eval { | ||
3134 | 574 | $pos = $tell->(); | ||
3135 | 575 | $line = $next_event->(); | ||
3136 | 576 | }; | ||
3137 | 577 | if ( PTDEBUG && $EVAL_ERROR ) { | ||
3138 | 578 | _d($EVAL_ERROR); | ||
3139 | 579 | } | ||
3140 | 580 | } | ||
3141 | 581 | |||
3142 | 582 | PTDEBUG && _d('Got pos/line:', $pos, $line); | ||
3143 | 583 | return ($pos, $line); | ||
3144 | 584 | } | ||
3145 | 585 | |||
3146 | 586 | # This subroutine defers and retrieves a line/pos pair. If you give it an | ||
3147 | 587 | # argument it'll set the stored value. If not, it'll get one if there is one | ||
3148 | 588 | # and return it. | ||
3149 | 589 | sub pending { | ||
3150 | 590 | my ( $self, $val, $pos_in_log ) = @_; | ||
3151 | 591 | my $was_pending; | ||
3152 | 592 | PTDEBUG && _d('In sub pending, val:', $val); | ||
3153 | 593 | if ( $val ) { | ||
3154 | 594 | push @{$self->{pending}}, [$val, $pos_in_log]; | ||
3155 | 595 | } | ||
3156 | 596 | elsif ( @{$self->{pending}} ) { | ||
3157 | 597 | ($val, $pos_in_log) = @{ shift @{$self->{pending}} }; | ||
3158 | 598 | $was_pending = 1; | ||
3159 | 599 | } | ||
3160 | 600 | PTDEBUG && _d('Return from pending:', $val, $pos_in_log); | ||
3161 | 601 | return ($val, $pos_in_log, $was_pending); | ||
3162 | 602 | } | ||
3163 | 603 | |||
3164 | 604 | # This subroutine manufactures subroutines to automatically translate incoming | ||
3165 | 605 | # syslog format into standard log format, to keep the main parse_event free from | ||
3166 | 606 | # having to think about that. For documentation on how this works, see | ||
3167 | 607 | # SysLogParser.pm. | ||
3168 | 608 | sub generate_wrappers { | ||
3169 | 609 | my ( $self, %args ) = @_; | ||
3170 | 610 | |||
3171 | 611 | # Reset everything, just in case some cruft was left over from a previous use | ||
3172 | 612 | # of this object. The object has stateful closures. If this isn't done, | ||
3173 | 613 | # then they'll keep reading from old filehandles. The sanity check is based | ||
3174 | 614 | # on the memory address of the closure! | ||
3175 | 615 | if ( ($self->{sanity} || '') ne "$args{next_event}" ){ | ||
3176 | 616 | PTDEBUG && _d("Clearing and recreating internal state"); | ||
3177 | 617 | eval { require SysLogParser; }; # Required for tests to work. | ||
3178 | 618 | my $sl = new SysLogParser(); | ||
3179 | 619 | |||
3180 | 620 | # We need a special item in %args for syslog parsing. (This might not be | ||
3181 | 621 | # a syslog log file...) See the test for t/samples/pg-syslog-002.txt for | ||
3182 | 622 | # an example of when this is needed. | ||
3183 | 623 | $args{misc}->{new_event_test} = sub { | ||
3184 | 624 | my ( $content ) = @_; | ||
3185 | 625 | return unless defined $content; | ||
3186 | 626 | return $content =~ m/$log_line_regex/o; | ||
3187 | 627 | }; | ||
3188 | 628 | |||
3189 | 629 | # The TAB at the beginning of the line indicates that there's a newline | ||
3190 | 630 | # at the end of the previous line. | ||
3191 | 631 | $args{misc}->{line_filter} = sub { | ||
3192 | 632 | my ( $content ) = @_; | ||
3193 | 633 | $content =~ s/\A\t/\n/; | ||
3194 | 634 | return $content; | ||
3195 | 635 | }; | ||
3196 | 636 | |||
3197 | 637 | @{$self}{qw(next_event tell is_syslog)} = $sl->make_closures(%args); | ||
3198 | 638 | $self->{sanity} = "$args{next_event}"; | ||
3199 | 639 | } | ||
3200 | 640 | |||
3201 | 641 | # Return the wrapper functions! | ||
3202 | 642 | return @{$self}{qw(next_event tell is_syslog)}; | ||
3203 | 643 | } | ||
3204 | 644 | |||
3205 | 645 | # This subroutine converts various formats to seconds. Examples: | ||
3206 | 646 | # 10.870 ms | ||
3207 | 647 | sub duration_to_secs { | ||
3208 | 648 | my ( $self, $str ) = @_; | ||
3209 | 649 | PTDEBUG && _d('Duration:', $str); | ||
3210 | 650 | my ( $num, $suf ) = split(/\s+/, $str); | ||
3211 | 651 | my $factor = $suf eq 'ms' ? 1000 | ||
3212 | 652 | : $suf eq 'sec' ? 1 | ||
3213 | 653 | : die("Unknown suffix '$suf'"); | ||
3214 | 654 | return $num / $factor; | ||
3215 | 655 | } | ||
3216 | 656 | |||
3217 | 657 | sub _d { | ||
3218 | 658 | my ($package, undef, $line) = caller 0; | ||
3219 | 659 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | ||
3220 | 660 | map { defined $_ ? $_ : 'undef' } | ||
3221 | 661 | @_; | ||
3222 | 662 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | ||
3223 | 663 | } | ||
3224 | 664 | |||
3225 | 665 | 1; | ||
3226 | 666 | } | ||
3227 | 667 | # ########################################################################### | ||
3228 | 668 | # End PgLogParser package | ||
3229 | 669 | # ########################################################################### | ||
3230 | 670 | 0 | ||
3231 | === modified file 'lib/QueryReportFormatter.pm' | |||
3232 | --- lib/QueryReportFormatter.pm 2013-01-31 17:52:34 +0000 | |||
3233 | +++ lib/QueryReportFormatter.pm 2013-02-01 18:19:34 +0000 | |||
3234 | @@ -481,9 +481,7 @@ | |||
3235 | 481 | } | 481 | } |
3236 | 482 | 482 | ||
3237 | 483 | my $log_type = $args{log_type} || ''; | 483 | my $log_type = $args{log_type} || ''; |
3241 | 484 | my $mark = $log_type eq 'memcached' | 484 | my $mark = '\G'; |
3239 | 485 | || $log_type eq 'http' | ||
3240 | 486 | || $log_type eq 'pglog' ? '' : '\G'; | ||
3242 | 487 | 485 | ||
3243 | 488 | if ( $item =~ m/^(?:[\(\s]*select|insert|replace)/ ) { | 486 | if ( $item =~ m/^(?:[\(\s]*select|insert|replace)/ ) { |
3244 | 489 | if ( $item =~ m/^(?:insert|replace)/ ) { # No EXPLAIN | 487 | if ( $item =~ m/^(?:insert|replace)/ ) { # No EXPLAIN |
3245 | 490 | 488 | ||
3246 | === removed file 'lib/SysLogParser.pm' | |||
3247 | --- lib/SysLogParser.pm 2013-01-03 00:19:16 +0000 | |||
3248 | +++ lib/SysLogParser.pm 1970-01-01 00:00:00 +0000 | |||
3249 | @@ -1,259 +0,0 @@ | |||
3250 | 1 | # This program is copyright 2010-2011 Baron Schwartz, 2011 Percona Ireland Ltd. | ||
3251 | 2 | # Feedback and improvements are welcome. | ||
3252 | 3 | # | ||
3253 | 4 | # THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED | ||
3254 | 5 | # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF | ||
3255 | 6 | # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. | ||
3256 | 7 | # | ||
3257 | 8 | # This program is free software; you can redistribute it and/or modify it under | ||
3258 | 9 | # the terms of the GNU General Public License as published by the Free Software | ||
3259 | 10 | # Foundation, version 2; OR the Perl Artistic License. On UNIX and similar | ||
3260 | 11 | # systems, you can issue `man perlgpl' or `man perlartistic' to read these | ||
3261 | 12 | # licenses. | ||
3262 | 13 | # | ||
3263 | 14 | # You should have received a copy of the GNU General Public License along with | ||
3264 | 15 | # this program; if not, write to the Free Software Foundation, Inc., 59 Temple | ||
3265 | 16 | # Place, Suite 330, Boston, MA 02111-1307 USA. | ||
3266 | 17 | # ########################################################################### | ||
3267 | 18 | # SysLogParser package | ||
3268 | 19 | # ########################################################################### | ||
3269 | 20 | { | ||
3270 | 21 | # Package: SysLogParser | ||
3271 | 22 | # SysLogParser parses events from syslogs. | ||
3272 | 23 | package SysLogParser; | ||
3273 | 24 | |||
3274 | 25 | use strict; | ||
3275 | 26 | use warnings FATAL => 'all'; | ||
3276 | 27 | use English qw(-no_match_vars); | ||
3277 | 28 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
3278 | 29 | |||
3279 | 30 | # This regex matches the message number, line number, and content of a syslog | ||
3280 | 31 | # message: | ||
3281 | 32 | # 2008 Jan 9 16:16:34 hostname postgres[30059]: [13-2] ...content... | ||
3282 | 33 | my $syslog_regex = qr{\A.*\w+\[\d+\]: \[(\d+)-(\d+)\] (.*)\Z}; | ||
3283 | 34 | |||
3284 | 35 | # This class generates currying functions that wrap around a standard | ||
3285 | 36 | # log-parser's next_event() and tell() function pointers. The wrappers behave | ||
3286 | 37 | # the same way, except that they'll return entire syslog events, instead of | ||
3287 | 38 | # lines at a time. To use it, do the following: | ||
3288 | 39 | # | ||
3289 | 40 | # sub parse_event { | ||
3290 | 41 | # my ($self, %args) = @_; | ||
3291 | 42 | # my ($next_event, $tell, $is_syslog) = SysLogParser::make_closures(%args); | ||
3292 | 43 | # # ... write your code to use the $next_event and $tell here... | ||
3293 | 44 | # } | ||
3294 | 45 | # | ||
3295 | 46 | # If the log isn't in syslog format, $is_syslog will be false and you'll get | ||
3296 | 47 | # back simple wrappers around the $next_event and $tell functions. (They still | ||
3297 | 48 | # have to be wrapped, because to find out whether the log is in syslog format, | ||
3298 | 49 | # the first line has to be examined.) | ||
3299 | 50 | sub new { | ||
3300 | 51 | my ( $class ) = @_; | ||
3301 | 52 | my $self = {}; | ||
3302 | 53 | return bless $self, $class; | ||
3303 | 54 | } | ||
3304 | 55 | |||
3305 | 56 | # This method is here so that SysLogParser can be used and tested in its own | ||
3306 | 57 | # right. However, its ability to generate wrapper functions probably means that | ||
3307 | 58 | # it should be used as a translation layer, not directly. You can use this code | ||
3308 | 59 | # as an example of how to integrate this into other packages. | ||
3309 | 60 | sub parse_event { | ||
3310 | 61 | my ( $self, %args ) = @_; | ||
3311 | 62 | my ( $next_event, $tell, $is_syslog ) = $self->generate_wrappers(%args); | ||
3312 | 63 | return $next_event->(); | ||
3313 | 64 | } | ||
3314 | 65 | |||
3315 | 66 | # This is an example of how a class can seamlessly put a syslog translation | ||
3316 | 67 | # layer underneath itself. | ||
3317 | 68 | sub generate_wrappers { | ||
3318 | 69 | my ( $self, %args ) = @_; | ||
3319 | 70 | |||
3320 | 71 | # Reset everything, just in case some cruft was left over from a previous use | ||
3321 | 72 | # of this object. The object has stateful closures. If this isn't done, | ||
3322 | 73 | # then they'll keep reading from old filehandles. The sanity check is based | ||
3323 | 74 | # on the memory address of the closure! | ||
3324 | 75 | if ( ($self->{sanity} || '') ne "$args{next_event}" ){ | ||
3325 | 76 | PTDEBUG && _d("Clearing and recreating internal state"); | ||
3326 | 77 | @{$self}{qw(next_event tell is_syslog)} = $self->make_closures(%args); | ||
3327 | 78 | $self->{sanity} = "$args{next_event}"; | ||
3328 | 79 | } | ||
3329 | 80 | |||
3330 | 81 | # Return the wrapper functions! | ||
3331 | 82 | return @{$self}{qw(next_event tell is_syslog)}; | ||
3332 | 83 | } | ||
3333 | 84 | |||
3334 | 85 | # Make the closures! The $args{misc}->{new_event_test} is an optional | ||
3335 | 86 | # subroutine reference, which tells the wrapper when to consider a line part of | ||
3336 | 87 | # a new event, in syslog format, even when it's technically the same syslog | ||
3337 | 88 | # event. See the test for samples/pg-syslog-002.txt for an example. This | ||
3338 | 89 | # argument should be passed in via the call to parse_event(). Ditto for | ||
3339 | 90 | # 'line_filter', which is some processing code to run on every line of content | ||
3340 | 91 | # in an event. | ||
3341 | 92 | sub make_closures { | ||
3342 | 93 | my ( $self, %args ) = @_; | ||
3343 | 94 | |||
3344 | 95 | # The following variables will be referred to in the manufactured | ||
3345 | 96 | # subroutines, making them proper closures. | ||
3346 | 97 | my $next_event = $args{'next_event'}; | ||
3347 | 98 | my $tell = $args{'tell'}; | ||
3348 | 99 | my $new_event_test = $args{'misc'}->{'new_event_test'}; | ||
3349 | 100 | my $line_filter = $args{'misc'}->{'line_filter'}; | ||
3350 | 101 | |||
3351 | 102 | # The first thing to do is get a line from the log and see if it's from | ||
3352 | 103 | # syslog. | ||
3353 | 104 | my $test_line = $next_event->(); | ||
3354 | 105 | PTDEBUG && _d('Read first sample/test line:', $test_line); | ||
3355 | 106 | |||
3356 | 107 | # If it's syslog, we have to generate a moderately elaborate wrapper | ||
3357 | 108 | # function. | ||
3358 | 109 | if ( defined $test_line && $test_line =~ m/$syslog_regex/o ) { | ||
3359 | 110 | |||
3360 | 111 | # Within syslog-parsing subroutines, we'll use LLSP (low-level syslog | ||
3361 | 112 | # parser) as a PTDEBUG line prefix. | ||
3362 | 113 | PTDEBUG && _d('This looks like a syslog line, PTDEBUG prefix=LLSP'); | ||
3363 | 114 | |||
3364 | 115 | # Grab the interesting bits out of the test line, and save the result. | ||
3365 | 116 | my ($msg_nr, $line_nr, $content) = $test_line =~ m/$syslog_regex/o; | ||
3366 | 117 | my @pending = ($test_line); | ||
3367 | 118 | my $last_msg_nr = $msg_nr; | ||
3368 | 119 | my $pos_in_log = 0; | ||
3369 | 120 | |||
3370 | 121 | # Generate the subroutine for getting a full log message without syslog | ||
3371 | 122 | # breaking it across multiple lines. | ||
3372 | 123 | my $new_next_event = sub { | ||
3373 | 124 | PTDEBUG && _d('LLSP: next_event()'); | ||
3374 | 125 | |||
3375 | 126 | # Keeping the pos_in_log variable right is a bit tricky! In general, | ||
3376 | 127 | # we have to tell() the filehandle before trying to read from it, | ||
3377 | 128 | # getting the position before the data we've just read. The simple | ||
3378 | 129 | # rule is that when we push something onto @pending, which we almost | ||
3379 | 130 | # always do, then $pos_in_log should point to the beginning of that | ||
3380 | 131 | # saved content in the file. | ||
3381 | 132 | PTDEBUG && _d('LLSP: Current virtual $fh position:', $pos_in_log); | ||
3382 | 133 | my $new_pos = 0; | ||
3383 | 134 | |||
3384 | 135 | # @arg_lines is where we store up the content we're about to return. | ||
3385 | 136 | # It contains $content; @pending contains a single saved $line. | ||
3386 | 137 | my @arg_lines; | ||
3387 | 138 | |||
3388 | 139 | # Here we actually examine lines until we have found a complete event. | ||
3389 | 140 | my $line; | ||
3390 | 141 | LINE: | ||
3391 | 142 | while ( | ||
3392 | 143 | defined($line = shift @pending) | ||
3393 | 144 | || do { | ||
3394 | 145 | # Save $new_pos, because when we hit EOF we can't $tell->() | ||
3395 | 146 | # anymore. | ||
3396 | 147 | eval { $new_pos = -1; $new_pos = $tell->() }; | ||
3397 | 148 | defined($line = $next_event->()); | ||
3398 | 149 | } | ||
3399 | 150 | ) { | ||
3400 | 151 | PTDEBUG && _d('LLSP: Line:', $line); | ||
3401 | 152 | |||
3402 | 153 | # Parse the line. | ||
3403 | 154 | ($msg_nr, $line_nr, $content) = $line =~ m/$syslog_regex/o; | ||
3404 | 155 | if ( !$msg_nr ) { | ||
3405 | 156 | die "Can't parse line: $line"; | ||
3406 | 157 | } | ||
3407 | 158 | |||
3408 | 159 | # The message number has changed -- thus, new message. | ||
3409 | 160 | elsif ( $msg_nr != $last_msg_nr ) { | ||
3410 | 161 | PTDEBUG && _d('LLSP: $msg_nr', $last_msg_nr, '=>', $msg_nr); | ||
3411 | 162 | $last_msg_nr = $msg_nr; | ||
3412 | 163 | last LINE; | ||
3413 | 164 | } | ||
3414 | 165 | |||
3415 | 166 | # Or, the caller gave us a custom new_event_test and it is true -- | ||
3416 | 167 | # thus, also new message. | ||
3417 | 168 | elsif ( @arg_lines && $new_event_test && $new_event_test->($content) ) { | ||
3418 | 169 | PTDEBUG && _d('LLSP: $new_event_test matches'); | ||
3419 | 170 | last LINE; | ||
3420 | 171 | } | ||
3421 | 172 | |||
3422 | 173 | # Otherwise it's part of the current message; put it onto the list | ||
3423 | 174 | # of lines pending. We have to translate characters that syslog has | ||
3424 | 175 | # munged. Some translate TAB into the literal characters '^I' and | ||
3425 | 176 | # some, rsyslog on Debian anyway, seem to translate all whitespace | ||
3426 | 177 | # control characters into an octal string representing the character | ||
3427 | 178 | # code. | ||
3428 | 179 | # Example: #011FROM pg_catalog.pg_class c | ||
3429 | 180 | $content =~ s/#(\d{3})/chr(oct($1))/ge; | ||
3430 | 181 | $content =~ s/\^I/\t/g; | ||
3431 | 182 | if ( $line_filter ) { | ||
3432 | 183 | PTDEBUG && _d('LLSP: applying $line_filter'); | ||
3433 | 184 | $content = $line_filter->($content); | ||
3434 | 185 | } | ||
3435 | 186 | |||
3436 | 187 | push @arg_lines, $content; | ||
3437 | 188 | } | ||
3438 | 189 | PTDEBUG && _d('LLSP: Exited while-loop after finding a complete entry'); | ||
3439 | 190 | |||
3440 | 191 | # Mash the pending stuff together to return it. | ||
3441 | 192 | my $psql_log_event = @arg_lines ? join('', @arg_lines) : undef; | ||
3442 | 193 | PTDEBUG && _d('LLSP: Final log entry:', $psql_log_event); | ||
3443 | 194 | |||
3444 | 195 | # Save the new content into @pending for the next time. $pos_in_log | ||
3445 | 196 | # must also be updated to whatever $new_pos is. | ||
3446 | 197 | if ( defined $line ) { | ||
3447 | 198 | PTDEBUG && _d('LLSP: Saving $line:', $line); | ||
3448 | 199 | @pending = $line; | ||
3449 | 200 | PTDEBUG && _d('LLSP: $pos_in_log:', $pos_in_log, '=>', $new_pos); | ||
3450 | 201 | $pos_in_log = $new_pos; | ||
3451 | 202 | } | ||
3452 | 203 | else { | ||
3453 | 204 | # We hit the end of the file. | ||
3454 | 205 | PTDEBUG && _d('LLSP: EOF reached'); | ||
3455 | 206 | @pending = (); | ||
3456 | 207 | $last_msg_nr = 0; | ||
3457 | 208 | } | ||
3458 | 209 | |||
3459 | 210 | return $psql_log_event; | ||
3460 | 211 | }; | ||
3461 | 212 | |||
3462 | 213 | # Create the closure for $tell->(); | ||
3463 | 214 | my $new_tell = sub { | ||
3464 | 215 | PTDEBUG && _d('LLSP: tell()', $pos_in_log); | ||
3465 | 216 | return $pos_in_log; | ||
3466 | 217 | }; | ||
3467 | 218 | |||
3468 | 219 | return ($new_next_event, $new_tell, 1); | ||
3469 | 220 | } | ||
3470 | 221 | |||
3471 | 222 | # This is either at EOF already, or it's not syslog format. | ||
3472 | 223 | else { | ||
3473 | 224 | |||
3474 | 225 | # Within plain-log-parsing subroutines, we'll use PLAIN as a PTDEBUG | ||
3475 | 226 | # line prefix. | ||
3476 | 227 | PTDEBUG && _d('Plain log, or we are at EOF; PTDEBUG prefix=PLAIN'); | ||
3477 | 228 | |||
3478 | 229 | # The @pending array is really only needed to return the one line we | ||
3479 | 230 | # already read as a test. Too bad we can't just push it back onto the | ||
3480 | 231 | # log. TODO: maybe we can test whether the filehandle is seekable and | ||
3481 | 232 | # seek back to the start, then just return the unwrapped functions? | ||
3482 | 233 | my @pending = defined $test_line ? ($test_line) : (); | ||
3483 | 234 | |||
3484 | 235 | my $new_next_event = sub { | ||
3485 | 236 | PTDEBUG && _d('PLAIN: next_event(); @pending:', scalar @pending); | ||
3486 | 237 | return @pending ? shift @pending : $next_event->(); | ||
3487 | 238 | }; | ||
3488 | 239 | my $new_tell = sub { | ||
3489 | 240 | PTDEBUG && _d('PLAIN: tell(); @pending:', scalar @pending); | ||
3490 | 241 | return @pending ? 0 : $tell->(); | ||
3491 | 242 | }; | ||
3492 | 243 | return ($new_next_event, $new_tell, 0); | ||
3493 | 244 | } | ||
3494 | 245 | } | ||
3495 | 246 | |||
3496 | 247 | sub _d { | ||
3497 | 248 | my ($package, undef, $line) = caller 0; | ||
3498 | 249 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | ||
3499 | 250 | map { defined $_ ? $_ : 'undef' } | ||
3500 | 251 | @_; | ||
3501 | 252 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | ||
3502 | 253 | } | ||
3503 | 254 | |||
3504 | 255 | 1; | ||
3505 | 256 | } | ||
3506 | 257 | # ########################################################################### | ||
3507 | 258 | # End SysLogParser package | ||
3508 | 259 | # ########################################################################### | ||
3509 | 260 | 0 | ||
3510 | === modified file 'lib/TcpdumpParser.pm' | |||
3511 | --- lib/TcpdumpParser.pm 2013-01-03 00:19:16 +0000 | |||
3512 | +++ lib/TcpdumpParser.pm 2013-02-01 18:19:34 +0000 | |||
3513 | @@ -172,10 +172,7 @@ | |||
3514 | 172 | sub port_number { | 172 | sub port_number { |
3515 | 173 | my ( $self, $port ) = @_; | 173 | my ( $self, $port ) = @_; |
3516 | 174 | return unless $port; | 174 | return unless $port; |
3521 | 175 | return $port eq 'memcached' ? 11211 | 175 | return $port eq 'mysql' ? 3306 : $port; |
3518 | 176 | : $port eq 'http' ? 80 | ||
3519 | 177 | : $port eq 'mysql' ? 3306 | ||
3520 | 178 | : $port; | ||
3522 | 179 | } | 176 | } |
3523 | 180 | 177 | ||
3524 | 181 | sub _d { | 178 | sub _d { |
3525 | 182 | 179 | ||
3526 | === removed file 't/lib/HTTPProtocolParser.t' | |||
3527 | --- t/lib/HTTPProtocolParser.t 2012-03-06 13:56:08 +0000 | |||
3528 | +++ t/lib/HTTPProtocolParser.t 1970-01-01 00:00:00 +0000 | |||
3529 | @@ -1,286 +0,0 @@ | |||
3530 | 1 | #!/usr/bin/perl | ||
3531 | 2 | |||
3532 | 3 | BEGIN { | ||
3533 | 4 | die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n" | ||
3534 | 5 | unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH}; | ||
3535 | 6 | unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib"; | ||
3536 | 7 | }; | ||
3537 | 8 | |||
3538 | 9 | use strict; | ||
3539 | 10 | use warnings FATAL => 'all'; | ||
3540 | 11 | use English qw(-no_match_vars); | ||
3541 | 12 | use Test::More tests => 16; | ||
3542 | 13 | |||
3543 | 14 | use TcpdumpParser; | ||
3544 | 15 | use ProtocolParser; | ||
3545 | 16 | use HTTPProtocolParser; | ||
3546 | 17 | use PerconaTest; | ||
3547 | 18 | |||
3548 | 19 | my $tcpdump = new TcpdumpParser(); | ||
3549 | 20 | my $protocol; # Create a new HTTPProtocolParser for each test. | ||
3550 | 21 | |||
3551 | 22 | # GET a very simple page. | ||
3552 | 23 | $protocol = new HTTPProtocolParser(); | ||
3553 | 24 | test_protocol_parser( | ||
3554 | 25 | parser => $tcpdump, | ||
3555 | 26 | protocol => $protocol, | ||
3556 | 27 | file => 't/lib/samples/http/http_tcpdump001.txt', | ||
3557 | 28 | result => [ | ||
3558 | 29 | { ts => '2009-11-09 11:31:52.341907', | ||
3559 | 30 | bytes => '715', | ||
3560 | 31 | host => '10.112.2.144', | ||
3561 | 32 | pos_in_log => 0, | ||
3562 | 33 | Virtual_host => 'hackmysql.com', | ||
3563 | 34 | arg => 'get hackmysql.com/contact', | ||
3564 | 35 | Status_code => '200', | ||
3565 | 36 | Query_time => '0.651419', | ||
3566 | 37 | Transmit_time => '0.000000', | ||
3567 | 38 | }, | ||
3568 | 39 | ], | ||
3569 | 40 | ); | ||
3570 | 41 | |||
3571 | 42 | # Get http://www.percona.com/about-us.html | ||
3572 | 43 | $protocol = new HTTPProtocolParser(); | ||
3573 | 44 | test_protocol_parser( | ||
3574 | 45 | parser => $tcpdump, | ||
3575 | 46 | protocol => $protocol, | ||
3576 | 47 | file => 't/lib/samples/http/http_tcpdump002.txt', | ||
3577 | 48 | result => [ | ||
3578 | 49 | { | ||
3579 | 50 | ts => '2009-11-09 15:31:09.074855', | ||
3580 | 51 | Query_time => '0.070097', | ||
3581 | 52 | Status_code => '200', | ||
3582 | 53 | Transmit_time => '0.000720', | ||
3583 | 54 | Virtual_host => 'www.percona.com', | ||
3584 | 55 | arg => 'get www.percona.com/about-us.html', | ||
3585 | 56 | bytes => 3832, | ||
3586 | 57 | host => '10.112.2.144', | ||
3587 | 58 | pos_in_log => 206, | ||
3588 | 59 | }, | ||
3589 | 60 | { | ||
3590 | 61 | ts => '2009-11-09 15:31:09.157215', | ||
3591 | 62 | Query_time => '0.068558', | ||
3592 | 63 | Status_code => '200', | ||
3593 | 64 | Transmit_time => '0.066490', | ||
3594 | 65 | Virtual_host => 'www.percona.com', | ||
3595 | 66 | arg => 'get www.percona.com/js/jquery.js', | ||
3596 | 67 | bytes => 9921, | ||
3597 | 68 | host => '10.112.2.144', | ||
3598 | 69 | pos_in_log => 16362, | ||
3599 | 70 | }, | ||
3600 | 71 | { | ||
3601 | 72 | ts => '2009-11-09 15:31:09.346763', | ||
3602 | 73 | Query_time => '0.066506', | ||
3603 | 74 | Status_code => '200', | ||
3604 | 75 | Transmit_time => '0.000000', | ||
3605 | 76 | Virtual_host => 'www.percona.com', | ||
3606 | 77 | arg => 'get www.percona.com/images/menu_team.gif', | ||
3607 | 78 | bytes => 344, | ||
3608 | 79 | host => '10.112.2.144', | ||
3609 | 80 | pos_in_log => 53100, | ||
3610 | 81 | }, | ||
3611 | 82 | { | ||
3612 | 83 | ts => '2009-11-09 15:31:09.373800', | ||
3613 | 84 | Query_time => '0.045442', | ||
3614 | 85 | Status_code => '200', | ||
3615 | 86 | Transmit_time => '0.000000', | ||
3616 | 87 | Virtual_host => 'www.google-analytics.com', | ||
3617 | 88 | arg => 'get www.google-analytics.com/__utm.gif?utmwv=1.3&utmn=1710381507&utmcs=UTF-8&utmsr=1280x800&utmsc=24-bit&utmul=en-us&utmje=1&utmfl=10.0%20r22&utmdt=About%20Percona&utmhn=www.percona.com&utmhid=1947703805&utmr=0&utmp=/about-us.html&utmac=UA-343802-3&utmcc=__utma%3D154442809.1969570579.1256593671.1256825719.1257805869.3%3B%2B__utmz%3D154442809.1256593671.1.1.utmccn%3D(direct)%7Cutmcsr%3D(direct)%7Cutmcmd%3D(none)%3B%2B', | ||
3618 | 89 | bytes => 35, | ||
3619 | 90 | host => '10.112.2.144', | ||
3620 | 91 | pos_in_log => 55942, | ||
3621 | 92 | }, | ||
3622 | 93 | { | ||
3623 | 94 | ts => '2009-11-09 15:31:09.411349', | ||
3624 | 95 | Query_time => '0.073882', | ||
3625 | 96 | Status_code => '200', | ||
3626 | 97 | Transmit_time => '0.000000', | ||
3627 | 98 | Virtual_host => 'www.percona.com', | ||
3628 | 99 | arg => 'get www.percona.com/images/menu_our-vision.gif', | ||
3629 | 100 | bytes => 414, | ||
3630 | 101 | host => '10.112.2.144', | ||
3631 | 102 | pos_in_log => 59213, | ||
3632 | 103 | }, | ||
3633 | 104 | { | ||
3634 | 105 | ts => '2009-11-09 15:31:09.420851', | ||
3635 | 106 | Query_time => '0.067669', | ||
3636 | 107 | Status_code => '200', | ||
3637 | 108 | Transmit_time => '0.000000', | ||
3638 | 109 | Virtual_host => 'www.percona.com', | ||
3639 | 110 | arg => 'get www.percona.com/images/bg-gray-corner-top.gif', | ||
3640 | 111 | bytes => 170, | ||
3641 | 112 | host => '10.112.2.144', | ||
3642 | 113 | pos_in_log => 65644, | ||
3643 | 114 | }, | ||
3644 | 115 | { | ||
3645 | 116 | ts => '2009-11-09 15:31:09.420996', | ||
3646 | 117 | Query_time => '0.067345', | ||
3647 | 118 | Status_code => '200', | ||
3648 | 119 | Transmit_time => '0.134909', | ||
3649 | 120 | Virtual_host => 'www.percona.com', | ||
3650 | 121 | arg => 'get www.percona.com/images/handshake.jpg', | ||
3651 | 122 | bytes => 20017, | ||
3652 | 123 | host => '10.112.2.144', | ||
3653 | 124 | pos_in_log => 67956, | ||
3654 | 125 | }, | ||
3655 | 126 | { | ||
3656 | 127 | ts => '2009-11-09 15:31:14.536149', | ||
3657 | 128 | Query_time => '0.061528', | ||
3658 | 129 | Status_code => '200', | ||
3659 | 130 | Transmit_time => '0.059577', | ||
3660 | 131 | Virtual_host => 'hit.clickaider.com', | ||
3661 | 132 | arg => 'get hit.clickaider.com/clickaider.js', | ||
3662 | 133 | bytes => 4009, | ||
3663 | 134 | host => '10.112.2.144', | ||
3664 | 135 | pos_in_log => 147447, | ||
3665 | 136 | }, | ||
3666 | 137 | { | ||
3667 | 138 | ts => '2009-11-09 15:31:14.678713', | ||
3668 | 139 | Query_time => '0.060436', | ||
3669 | 140 | Status_code => '200', | ||
3670 | 141 | Transmit_time => '0.000000', | ||
3671 | 142 | Virtual_host => 'hit.clickaider.com', | ||
3672 | 143 | arg => 'get hit.clickaider.com/pv?lng=140&&lnks=&t=About%20Percona&c=73a41b95-2926&r=http%3A%2F%2Fwww.percona.com%2F&tz=-420&loc=http%3A%2F%2Fwww.percona.com%2Fabout-us.html&rnd=3688', | ||
3673 | 144 | bytes => 43, | ||
3674 | 145 | host => '10.112.2.144', | ||
3675 | 146 | pos_in_log => 167245, | ||
3676 | 147 | }, | ||
3677 | 148 | { | ||
3678 | 149 | ts => '2009-11-09 15:31:14.737890', | ||
3679 | 150 | Query_time => '0.061937', | ||
3680 | 151 | Status_code => '200', | ||
3681 | 152 | Transmit_time => '0.000000', | ||
3682 | 153 | Virtual_host => 'hit.clickaider.com', | ||
3683 | 154 | arg => 'get hit.clickaider.com/s/forms.js', | ||
3684 | 155 | bytes => 822, | ||
3685 | 156 | host => '10.112.2.144', | ||
3686 | 157 | pos_in_log => 170117, | ||
3687 | 158 | }, | ||
3688 | 159 | ], | ||
3689 | 160 | ); | ||
3690 | 161 | |||
3691 | 162 | # A reponse received in out of order packet. | ||
3692 | 163 | $protocol = new HTTPProtocolParser(); | ||
3693 | 164 | test_protocol_parser( | ||
3694 | 165 | parser => $tcpdump, | ||
3695 | 166 | protocol => $protocol, | ||
3696 | 167 | file => 't/lib/samples/http/http_tcpdump004.txt', | ||
3697 | 168 | result => [ | ||
3698 | 169 | { ts => '2009-11-12 11:27:10.757573', | ||
3699 | 170 | Query_time => '0.327356', | ||
3700 | 171 | Status_code => '200', | ||
3701 | 172 | Transmit_time => '0.549501', | ||
3702 | 173 | Virtual_host => 'dev.mysql.com', | ||
3703 | 174 | arg => 'get dev.mysql.com/common/css/mysql.css', | ||
3704 | 175 | bytes => 11283, | ||
3705 | 176 | host => '10.67.237.92', | ||
3706 | 177 | pos_in_log => 776, | ||
3707 | 178 | }, | ||
3708 | 179 | ], | ||
3709 | 180 | ); | ||
3710 | 181 | |||
3711 | 182 | # A client request broken over 2 packets. | ||
3712 | 183 | $protocol = new HTTPProtocolParser(); | ||
3713 | 184 | test_protocol_parser( | ||
3714 | 185 | parser => $tcpdump, | ||
3715 | 186 | protocol => $protocol, | ||
3716 | 187 | file => 't/lib/samples/http/http_tcpdump005.txt', | ||
3717 | 188 | result => [ | ||
3718 | 189 | { ts => '2009-11-13 09:20:31.041924', | ||
3719 | 190 | Query_time => '0.342166', | ||
3720 | 191 | Status_code => '200', | ||
3721 | 192 | Transmit_time => '0.012780', | ||
3722 | 193 | Virtual_host => 'dev.mysql.com', | ||
3723 | 194 | arg => 'get dev.mysql.com/doc/refman/5.0/fr/retrieving-data.html', | ||
3724 | 195 | bytes => 4382, | ||
3725 | 196 | host => '192.168.200.110', | ||
3726 | 197 | pos_in_log => 785, | ||
3727 | 198 | }, | ||
3728 | 199 | ], | ||
3729 | 200 | ); | ||
3730 | 201 | |||
3731 | 202 | # Out of order header that might look like the text header | ||
3732 | 203 | # but is really data; text header arrives last. | ||
3733 | 204 | $protocol = new HTTPProtocolParser(); | ||
3734 | 205 | test_protocol_parser( | ||
3735 | 206 | parser => $tcpdump, | ||
3736 | 207 | protocol => $protocol, | ||
3737 | 208 | file => 't/lib/samples/http/http_tcpdump006.txt', | ||
3738 | 209 | result => [ | ||
3739 | 210 | { ts => '2009-11-13 09:50:44.432099', | ||
3740 | 211 | Query_time => '0.140878', | ||
3741 | 212 | Status_code => '200', | ||
3742 | 213 | Transmit_time => '0.237153', | ||
3743 | 214 | Virtual_host => '247wallst.files.wordpress.com', | ||
3744 | 215 | arg => 'get 247wallst.files.wordpress.com/2009/11/airplane4.jpg?w=139&h=93', | ||
3745 | 216 | bytes => 3391, | ||
3746 | 217 | host => '192.168.200.110', | ||
3747 | 218 | pos_in_log => 782, | ||
3748 | 219 | }, | ||
3749 | 220 | ], | ||
3750 | 221 | ); | ||
3751 | 222 | |||
3752 | 223 | # One 2.6M image that took almost a minute to load (very slow wifi). | ||
3753 | 224 | $protocol = new HTTPProtocolParser(); | ||
3754 | 225 | test_protocol_parser( | ||
3755 | 226 | parser => $tcpdump, | ||
3756 | 227 | protocol => $protocol, | ||
3757 | 228 | file => 't/lib/samples/http/http_tcpdump007.txt', | ||
3758 | 229 | result => [ | ||
3759 | 230 | { ts => '2009-11-13 10:09:53.251620', | ||
3760 | 231 | Query_time => '0.121971', | ||
3761 | 232 | Status_code => '200', | ||
3762 | 233 | Transmit_time => '40.311228', | ||
3763 | 234 | Virtual_host => 'apod.nasa.gov', | ||
3764 | 235 | arg => 'get apod.nasa.gov/apod/image/0911/Ophcloud_spitzer.jpg', | ||
3765 | 236 | bytes => 2706737, | ||
3766 | 237 | host => '192.168.200.110', | ||
3767 | 238 | pos_in_log => 640, | ||
3768 | 239 | } | ||
3769 | 240 | ], | ||
3770 | 241 | ); | ||
3771 | 242 | |||
3772 | 243 | # A simple POST. | ||
3773 | 244 | $protocol = new HTTPProtocolParser(); | ||
3774 | 245 | test_protocol_parser( | ||
3775 | 246 | parser => $tcpdump, | ||
3776 | 247 | protocol => $protocol, | ||
3777 | 248 | file => 't/lib/samples/http/http_tcpdump008.txt', | ||
3778 | 249 | result => [ | ||
3779 | 250 | { ts => '2009-11-13 10:53:48.349465', | ||
3780 | 251 | Query_time => '0.030740', | ||
3781 | 252 | Status_code => '200', | ||
3782 | 253 | Transmit_time => '0.000000', | ||
3783 | 254 | Virtual_host => 'www.google.com', | ||
3784 | 255 | arg => 'post www.google.com/finance/qs/channel?VER=6&RID=481&CVER=1&zx=5xccsz-eg9chk&t=1', | ||
3785 | 256 | bytes => 54, | ||
3786 | 257 | host => '192.168.200.110', | ||
3787 | 258 | pos_in_log => 0, | ||
3788 | 259 | } | ||
3789 | 260 | ], | ||
3790 | 261 | ); | ||
3791 | 262 | |||
3792 | 263 | # .http instead of .80 | ||
3793 | 264 | $protocol = new HTTPProtocolParser(); | ||
3794 | 265 | test_protocol_parser( | ||
3795 | 266 | parser => $tcpdump, | ||
3796 | 267 | protocol => $protocol, | ||
3797 | 268 | file => 't/lib/samples/http/http_tcpdump009.txt', | ||
3798 | 269 | result => [ | ||
3799 | 270 | { ts => '2009-11-09 11:31:52.341907', | ||
3800 | 271 | bytes => '715', | ||
3801 | 272 | host => '10.112.2.144', | ||
3802 | 273 | pos_in_log => 0, | ||
3803 | 274 | Virtual_host => 'hackmysql.com', | ||
3804 | 275 | arg => 'get hackmysql.com/contact', | ||
3805 | 276 | Status_code => '200', | ||
3806 | 277 | Query_time => '0.651419', | ||
3807 | 278 | Transmit_time => '0.000000', | ||
3808 | 279 | }, | ||
3809 | 280 | ], | ||
3810 | 281 | ); | ||
3811 | 282 | |||
3812 | 283 | # ############################################################################# | ||
3813 | 284 | # Done. | ||
3814 | 285 | # ############################################################################# | ||
3815 | 286 | exit; | ||
3816 | 287 | 0 | ||
3817 | === removed file 't/lib/MemcachedEvent.t' | |||
3818 | --- t/lib/MemcachedEvent.t 2012-03-06 13:56:08 +0000 | |||
3819 | +++ t/lib/MemcachedEvent.t 1970-01-01 00:00:00 +0000 | |||
3820 | @@ -1,766 +0,0 @@ | |||
3821 | 1 | #!/usr/bin/perl | ||
3822 | 2 | |||
3823 | 3 | BEGIN { | ||
3824 | 4 | die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n" | ||
3825 | 5 | unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH}; | ||
3826 | 6 | unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib"; | ||
3827 | 7 | }; | ||
3828 | 8 | |||
3829 | 9 | use strict; | ||
3830 | 10 | use warnings FATAL => 'all'; | ||
3831 | 11 | use English qw(-no_match_vars); | ||
3832 | 12 | use Test::More tests => 15; | ||
3833 | 13 | |||
3834 | 14 | use MemcachedEvent; | ||
3835 | 15 | use PerconaTest; | ||
3836 | 16 | |||
3837 | 17 | my $memce = new MemcachedEvent(); | ||
3838 | 18 | isa_ok($memce, 'MemcachedEvent'); | ||
3839 | 19 | |||
3840 | 20 | sub make_events { | ||
3841 | 21 | my ( @memc_events ) = @_; | ||
3842 | 22 | my @events; | ||
3843 | 23 | push @events, map { $memce->parse_event(event=>$_) } @memc_events; | ||
3844 | 24 | return \@events; | ||
3845 | 25 | } | ||
3846 | 26 | |||
3847 | 27 | # ############################################################################# | ||
3848 | 28 | # Sanity tests. | ||
3849 | 29 | # ############################################################################# | ||
3850 | 30 | my $events = make_events( | ||
3851 | 31 | { | ||
3852 | 32 | key => 'my_key', | ||
3853 | 33 | val => 'Some value', | ||
3854 | 34 | res => 'STORED', | ||
3855 | 35 | Query_time => 1, | ||
3856 | 36 | }, | ||
3857 | 37 | ); | ||
3858 | 38 | is_deeply( | ||
3859 | 39 | $events, | ||
3860 | 40 | [], | ||
3861 | 41 | "Doesn't die when there's no cmd" | ||
3862 | 42 | ); | ||
3863 | 43 | |||
3864 | 44 | $events = make_events( | ||
3865 | 45 | { | ||
3866 | 46 | cmd => 'unknown_cmd', | ||
3867 | 47 | val => 'Some value', | ||
3868 | 48 | res => 'STORED', | ||
3869 | 49 | Query_time => 1, | ||
3870 | 50 | }, | ||
3871 | 51 | ); | ||
3872 | 52 | is_deeply( | ||
3873 | 53 | $events, | ||
3874 | 54 | [], | ||
3875 | 55 | "Doesn't die when there's no key" | ||
3876 | 56 | ); | ||
3877 | 57 | |||
3878 | 58 | $events = make_events( | ||
3879 | 59 | { | ||
3880 | 60 | val => 'Some value', | ||
3881 | 61 | res => 'STORED', | ||
3882 | 62 | Query_time => 1, | ||
3883 | 63 | }, | ||
3884 | 64 | ); | ||
3885 | 65 | is_deeply( | ||
3886 | 66 | $events, | ||
3887 | 67 | [], | ||
3888 | 68 | "Doesn't die when there's no cmd or key" | ||
3889 | 69 | ); | ||
3890 | 70 | |||
3891 | 71 | $events = make_events( | ||
3892 | 72 | { | ||
3893 | 73 | cmd => 'unknown_cmd', | ||
3894 | 74 | key => 'my_key', | ||
3895 | 75 | val => 'Some value', | ||
3896 | 76 | res => 'STORED', | ||
3897 | 77 | Query_time => 1, | ||
3898 | 78 | }, | ||
3899 | 79 | ); | ||
3900 | 80 | is_deeply( | ||
3901 | 81 | $events, | ||
3902 | 82 | [], | ||
3903 | 83 | "Doesn't handle unknown cmd" | ||
3904 | 84 | ); | ||
3905 | 85 | |||
3906 | 86 | # ############################################################################# | ||
3907 | 87 | # These events are copied straight from the expected results in | ||
3908 | 88 | # MemcachedProtocolParser.t. | ||
3909 | 89 | # ############################################################################# | ||
3910 | 90 | |||
3911 | 91 | # A session with a simple set(). | ||
3912 | 92 | $events = make_events( | ||
3913 | 93 | { ts => '2009-07-04 21:33:39.229179', | ||
3914 | 94 | host => '127.0.0.1', | ||
3915 | 95 | cmd => 'set', | ||
3916 | 96 | key => 'my_key', | ||
3917 | 97 | val => 'Some value', | ||
3918 | 98 | flags => '0', | ||
3919 | 99 | exptime => '0', | ||
3920 | 100 | bytes => '10', | ||
3921 | 101 | res => 'STORED', | ||
3922 | 102 | Query_time => sprintf('%.6f', .229299 - .229179), | ||
3923 | 103 | pos_in_log => 0, | ||
3924 | 104 | }, | ||
3925 | 105 | ); | ||
3926 | 106 | is_deeply( | ||
3927 | 107 | $events, | ||
3928 | 108 | [ | ||
3929 | 109 | { | ||
3930 | 110 | arg => 'set my_key', | ||
3931 | 111 | fingerprint => 'set my_key', | ||
3932 | 112 | key_print => 'my_key', | ||
3933 | 113 | cmd => 'set', | ||
3934 | 114 | key => 'my_key', | ||
3935 | 115 | res => 'STORED', | ||
3936 | 116 | Memc_add => 'No', | ||
3937 | 117 | Memc_append => 'No', | ||
3938 | 118 | Memc_cas => 'No', | ||
3939 | 119 | Memc_decr => 'No', | ||
3940 | 120 | Memc_delete => 'No', | ||
3941 | 121 | Memc_error => 'No', | ||
3942 | 122 | Memc_get => 'No', | ||
3943 | 123 | Memc_gets => 'No', | ||
3944 | 124 | Memc_incr => 'No', | ||
3945 | 125 | Memc_miss => 'No', | ||
3946 | 126 | Memc_prepend => 'No', | ||
3947 | 127 | Memc_replace => 'No', | ||
3948 | 128 | Memc_set => 'Yes', | ||
3949 | 129 | Memc_miss => 'No', | ||
3950 | 130 | Memc_error => 'No', | ||
3951 | 131 | Memc_Not_Stored => 'No', | ||
3952 | 132 | Memc_Exists => 'No', | ||
3953 | 133 | Query_time => '0.000120', | ||
3954 | 134 | bytes => '10', | ||
3955 | 135 | exptime => '0', | ||
3956 | 136 | fingerprint => 'set my_key', | ||
3957 | 137 | flags => '0', | ||
3958 | 138 | host => '127.0.0.1', | ||
3959 | 139 | pos_in_log => 0, | ||
3960 | 140 | ts => '2009-07-04 21:33:39.229179', | ||
3961 | 141 | val => 'Some value' | ||
3962 | 142 | }, | ||
3963 | 143 | ], | ||
3964 | 144 | 'samples/memc_tcpdump001.txt: simple set' | ||
3965 | 145 | ); | ||
3966 | 146 | |||
3967 | 147 | # A session with a simple get(). | ||
3968 | 148 | $events = make_events( | ||
3969 | 149 | { Query_time => '0.000067', | ||
3970 | 150 | cmd => 'get', | ||
3971 | 151 | key => 'my_key', | ||
3972 | 152 | val => 'Some value', | ||
3973 | 153 | bytes => 10, | ||
3974 | 154 | exptime => undef, | ||
3975 | 155 | flags => 0, | ||
3976 | 156 | host => '127.0.0.1', | ||
3977 | 157 | pos_in_log => '0', | ||
3978 | 158 | res => 'VALUE', | ||
3979 | 159 | ts => '2009-07-04 22:12:06.174390' | ||
3980 | 160 | } | ||
3981 | 161 | ); | ||
3982 | 162 | is_deeply( | ||
3983 | 163 | $events, | ||
3984 | 164 | [ | ||
3985 | 165 | { | ||
3986 | 166 | arg => 'get my_key', | ||
3987 | 167 | fingerprint => 'get my_key', | ||
3988 | 168 | key_print => 'my_key', | ||
3989 | 169 | cmd => 'get', | ||
3990 | 170 | key => 'my_key', | ||
3991 | 171 | res => 'VALUE', | ||
3992 | 172 | Memc_add => 'No', | ||
3993 | 173 | Memc_append => 'No', | ||
3994 | 174 | Memc_cas => 'No', | ||
3995 | 175 | Memc_decr => 'No', | ||
3996 | 176 | Memc_delete => 'No', | ||
3997 | 177 | Memc_error => 'No', | ||
3998 | 178 | Memc_get => 'Yes', | ||
3999 | 179 | Memc_gets => 'No', | ||
4000 | 180 | Memc_incr => 'No', | ||
4001 | 181 | Memc_miss => 'No', | ||
4002 | 182 | Memc_prepend => 'No', | ||
4003 | 183 | Memc_replace => 'No', | ||
4004 | 184 | Memc_set => 'No', | ||
4005 | 185 | Memc_miss => 'No', | ||
4006 | 186 | Memc_error => 'No', | ||
4007 | 187 | Query_time => '0.000067', | ||
4008 | 188 | val => 'Some value', | ||
4009 | 189 | bytes => 10, | ||
4010 | 190 | exptime => undef, | ||
4011 | 191 | flags => 0, | ||
4012 | 192 | host => '127.0.0.1', | ||
4013 | 193 | pos_in_log => '0', | ||
4014 | 194 | ts => '2009-07-04 22:12:06.174390' | ||
4015 | 195 | }, | ||
4016 | 196 | ], | ||
4017 | 197 | 'samples/memc_tcpdump002.txt: simple get', | ||
4018 | 198 | ); | ||
4019 | 199 | |||
4020 | 200 | # A session with a simple incr() and decr(). | ||
4021 | 201 | $events = make_events( | ||
4022 | 202 | { Query_time => '0.000073', | ||
4023 | 203 | cmd => 'incr', | ||
4024 | 204 | key => 'key', | ||
4025 | 205 | val => '8', | ||
4026 | 206 | bytes => undef, | ||
4027 | 207 | exptime => undef, | ||
4028 | 208 | flags => undef, | ||
4029 | 209 | host => '127.0.0.1', | ||
4030 | 210 | pos_in_log => '0', | ||
4031 | 211 | res => '', | ||
4032 | 212 | ts => '2009-07-04 22:12:06.175734', | ||
4033 | 213 | }, | ||
4034 | 214 | { Query_time => '0.000068', | ||
4035 | 215 | cmd => 'decr', | ||
4036 | 216 | bytes => undef, | ||
4037 | 217 | exptime => undef, | ||
4038 | 218 | flags => undef, | ||
4039 | 219 | host => '127.0.0.1', | ||
4040 | 220 | key => 'key', | ||
4041 | 221 | pos_in_log => 522, | ||
4042 | 222 | res => '', | ||
4043 | 223 | ts => '2009-07-04 22:12:06.176181', | ||
4044 | 224 | val => '7', | ||
4045 | 225 | }, | ||
4046 | 226 | ); | ||
4047 | 227 | is_deeply( | ||
4048 | 228 | $events, | ||
4049 | 229 | [ | ||
4050 | 230 | { | ||
4051 | 231 | arg => 'incr key', | ||
4052 | 232 | fingerprint => 'incr key', | ||
4053 | 233 | key_print => 'key', | ||
4054 | 234 | cmd => 'incr', | ||
4055 | 235 | key => 'key', | ||
4056 | 236 | res => '', | ||
4057 | 237 | Memc_add => 'No', | ||
4058 | 238 | Memc_append => 'No', | ||
4059 | 239 | Memc_cas => 'No', | ||
4060 | 240 | Memc_decr => 'No', | ||
4061 | 241 | Memc_delete => 'No', | ||
4062 | 242 | Memc_error => 'No', | ||
4063 | 243 | Memc_get => 'No', | ||
4064 | 244 | Memc_gets => 'No', | ||
4065 | 245 | Memc_incr => 'Yes', | ||
4066 | 246 | Memc_miss => 'No', | ||
4067 | 247 | Memc_prepend => 'No', | ||
4068 | 248 | Memc_replace => 'No', | ||
4069 | 249 | Memc_set => 'No', | ||
4070 | 250 | Memc_miss => 'No', | ||
4071 | 251 | Memc_error => 'No', | ||
4072 | 252 | Query_time => '0.000073', | ||
4073 | 253 | val => '8', | ||
4074 | 254 | bytes => undef, | ||
4075 | 255 | exptime => undef, | ||
4076 | 256 | flags => undef, | ||
4077 | 257 | host => '127.0.0.1', | ||
4078 | 258 | pos_in_log => '0', | ||
4079 | 259 | ts => '2009-07-04 22:12:06.175734', | ||
4080 | 260 | }, | ||
4081 | 261 | { | ||
4082 | 262 | arg => 'decr key', | ||
4083 | 263 | fingerprint => 'decr key', | ||
4084 | 264 | key_print => 'key', | ||
4085 | 265 | cmd => 'decr', | ||
4086 | 266 | key => 'key', | ||
4087 | 267 | res => '', | ||
4088 | 268 | Memc_add => 'No', | ||
4089 | 269 | Memc_append => 'No', | ||
4090 | 270 | Memc_cas => 'No', | ||
4091 | 271 | Memc_decr => 'Yes', | ||
4092 | 272 | Memc_delete => 'No', | ||
4093 | 273 | Memc_error => 'No', | ||
4094 | 274 | Memc_get => 'No', | ||
4095 | 275 | Memc_gets => 'No', | ||
4096 | 276 | Memc_incr => 'No', | ||
4097 | 277 | Memc_miss => 'No', | ||
4098 | 278 | Memc_prepend => 'No', | ||
4099 | 279 | Memc_replace => 'No', | ||
4100 | 280 | Memc_set => 'No', | ||
4101 | 281 | Memc_miss => 'No', | ||
4102 | 282 | Memc_error => 'No', | ||
4103 | 283 | Query_time => '0.000068', | ||
4104 | 284 | bytes => undef, | ||
4105 | 285 | exptime => undef, | ||
4106 | 286 | flags => undef, | ||
4107 | 287 | host => '127.0.0.1', | ||
4108 | 288 | pos_in_log => 522, | ||
4109 | 289 | ts => '2009-07-04 22:12:06.176181', | ||
4110 | 290 | val => '7', | ||
4111 | 291 | }, | ||
4112 | 292 | ], | ||
4113 | 293 | 'samples/memc_tcpdump003.txt: incr and decr' | ||
4114 | 294 | ); | ||
4115 | 295 | |||
4116 | 296 | # A session with a simple incr() and decr(), but the value doesn't exist. | ||
4117 | 297 | $events = make_events( | ||
4118 | 298 | { Query_time => '0.000131', | ||
4119 | 299 | bytes => undef, | ||
4120 | 300 | cmd => 'incr', | ||
4121 | 301 | exptime => undef, | ||
4122 | 302 | flags => undef, | ||
4123 | 303 | host => '127.0.0.1', | ||
4124 | 304 | key => 'key', | ||
4125 | 305 | pos_in_log => 764, | ||
4126 | 306 | res => 'NOT_FOUND', | ||
4127 | 307 | ts => '2009-07-06 10:37:21.668469', | ||
4128 | 308 | val => '', | ||
4129 | 309 | }, | ||
4130 | 310 | { | ||
4131 | 311 | Query_time => '0.000055', | ||
4132 | 312 | bytes => undef, | ||
4133 | 313 | cmd => 'decr', | ||
4134 | 314 | exptime => undef, | ||
4135 | 315 | flags => undef, | ||
4136 | 316 | host => '127.0.0.1', | ||
4137 | 317 | key => 'key', | ||
4138 | 318 | pos_in_log => 1788, | ||
4139 | 319 | res => 'NOT_FOUND', | ||
4140 | 320 | ts => '2009-07-06 10:37:21.668851', | ||
4141 | 321 | val => '', | ||
4142 | 322 | }, | ||
4143 | 323 | ); | ||
4144 | 324 | is_deeply( | ||
4145 | 325 | $events, | ||
4146 | 326 | [ | ||
4147 | 327 | { | ||
4148 | 328 | arg => 'incr key', | ||
4149 | 329 | fingerprint => 'incr key', | ||
4150 | 330 | key_print => 'key', | ||
4151 | 331 | cmd => 'incr', | ||
4152 | 332 | key => 'key', | ||
4153 | 333 | res => 'NOT_FOUND', | ||
4154 | 334 | Memc_add => 'No', | ||
4155 | 335 | Memc_append => 'No', | ||
4156 | 336 | Memc_cas => 'No', | ||
4157 | 337 | Memc_decr => 'No', | ||
4158 | 338 | Memc_delete => 'No', | ||
4159 | 339 | Memc_error => 'No', | ||
4160 | 340 | Memc_get => 'No', | ||
4161 | 341 | Memc_gets => 'No', | ||
4162 | 342 | Memc_incr => 'Yes', | ||
4163 | 343 | Memc_miss => 'No', | ||
4164 | 344 | Memc_prepend => 'No', | ||
4165 | 345 | Memc_replace => 'No', | ||
4166 | 346 | Memc_set => 'No', | ||
4167 | 347 | Memc_miss => 'Yes', | ||
4168 | 348 | Memc_error => 'No', | ||
4169 | 349 | Query_time => '0.000131', | ||
4170 | 350 | bytes => undef, | ||
4171 | 351 | exptime => undef, | ||
4172 | 352 | flags => undef, | ||
4173 | 353 | host => '127.0.0.1', | ||
4174 | 354 | pos_in_log => 764, | ||
4175 | 355 | ts => '2009-07-06 10:37:21.668469', | ||
4176 | 356 | val => '', | ||
4177 | 357 | }, | ||
4178 | 358 | { | ||
4179 | 359 | arg => 'decr key', | ||
4180 | 360 | fingerprint => 'decr key', | ||
4181 | 361 | key_print => 'key', | ||
4182 | 362 | cmd => 'decr', | ||
4183 | 363 | key => 'key', | ||
4184 | 364 | res => 'NOT_FOUND', | ||
4185 | 365 | Memc_add => 'No', | ||
4186 | 366 | Memc_append => 'No', | ||
4187 | 367 | Memc_cas => 'No', | ||
4188 | 368 | Memc_decr => 'Yes', | ||
4189 | 369 | Memc_delete => 'No', | ||
4190 | 370 | Memc_error => 'No', | ||
4191 | 371 | Memc_get => 'No', | ||
4192 | 372 | Memc_gets => 'No', | ||
4193 | 373 | Memc_incr => 'No', | ||
4194 | 374 | Memc_miss => 'No', | ||
4195 | 375 | Memc_prepend => 'No', | ||
4196 | 376 | Memc_replace => 'No', | ||
4197 | 377 | Memc_set => 'No', | ||
4198 | 378 | Memc_miss => 'Yes', | ||
4199 | 379 | Memc_error => 'No', | ||
4200 | 380 | Query_time => '0.000055', | ||
4201 | 381 | bytes => undef, | ||
4202 | 382 | exptime => undef, | ||
4203 | 383 | flags => undef, | ||
4204 | 384 | host => '127.0.0.1', | ||
4205 | 385 | pos_in_log => 1788, | ||
4206 | 386 | ts => '2009-07-06 10:37:21.668851', | ||
4207 | 387 | val => '', | ||
4208 | 388 | }, | ||
4209 | 389 | ], | ||
4210 | 390 | 'samples/memc_tcpdump004.txt: incr and decr nonexistent key' | ||
4211 | 391 | ); | ||
4212 | 392 | |||
4213 | 393 | # A session with a huge set() that will not fit into a single TCP packet. | ||
4214 | 394 | $events = make_events( | ||
4215 | 395 | { Query_time => '0.003928', | ||
4216 | 396 | bytes => 17946, | ||
4217 | 397 | cmd => 'set', | ||
4218 | 398 | exptime => 0, | ||
4219 | 399 | flags => 0, | ||
4220 | 400 | host => '127.0.0.1', | ||
4221 | 401 | key => 'my_key', | ||
4222 | 402 | pos_in_log => 764, | ||
4223 | 403 | res => 'STORED', | ||
4224 | 404 | ts => '2009-07-06 22:07:14.406827', | ||
4225 | 405 | val => ('lorem ipsum dolor sit amet' x 690) . ' fini!', | ||
4226 | 406 | }, | ||
4227 | 407 | ); | ||
4228 | 408 | is_deeply( | ||
4229 | 409 | $events, | ||
4230 | 410 | [ | ||
4231 | 411 | { | ||
4232 | 412 | arg => 'set my_key', | ||
4233 | 413 | fingerprint => 'set my_key', | ||
4234 | 414 | key_print => 'my_key', | ||
4235 | 415 | cmd => 'set', | ||
4236 | 416 | key => 'my_key', | ||
4237 | 417 | res => 'STORED', | ||
4238 | 418 | Memc_add => 'No', | ||
4239 | 419 | Memc_append => 'No', | ||
4240 | 420 | Memc_cas => 'No', | ||
4241 | 421 | Memc_decr => 'No', | ||
4242 | 422 | Memc_delete => 'No', | ||
4243 | 423 | Memc_error => 'No', | ||
4244 | 424 | Memc_get => 'No', | ||
4245 | 425 | Memc_gets => 'No', | ||
4246 | 426 | Memc_incr => 'No', | ||
4247 | 427 | Memc_miss => 'No', | ||
4248 | 428 | Memc_prepend => 'No', | ||
4249 | 429 | Memc_replace => 'No', | ||
4250 | 430 | Memc_set => 'Yes', | ||
4251 | 431 | Memc_miss => 'No', | ||
4252 | 432 | Memc_error => 'No', | ||
4253 | 433 | Memc_Not_Stored => 'No', | ||
4254 | 434 | Memc_Exists => 'No', | ||
4255 | 435 | Query_time => '0.003928', | ||
4256 | 436 | bytes => 17946, | ||
4257 | 437 | exptime => 0, | ||
4258 | 438 | flags => 0, | ||
4259 | 439 | host => '127.0.0.1', | ||
4260 | 440 | pos_in_log => 764, | ||
4261 | 441 | ts => '2009-07-06 22:07:14.406827', | ||
4262 | 442 | val => ('lorem ipsum dolor sit amet' x 690) . ' fini!', | ||
4263 | 443 | }, | ||
4264 | 444 | ], | ||
4265 | 445 | 'samples/memc_tcpdump005.txt: huge set' | ||
4266 | 446 | ); | ||
4267 | 447 | |||
4268 | 448 | # A session with a huge get() that will not fit into a single TCP packet. | ||
4269 | 449 | $events = make_events( | ||
4270 | 450 | { | ||
4271 | 451 | Query_time => '0.000196', | ||
4272 | 452 | bytes => 17946, | ||
4273 | 453 | cmd => 'get', | ||
4274 | 454 | exptime => undef, | ||
4275 | 455 | flags => 0, | ||
4276 | 456 | host => '127.0.0.1', | ||
4277 | 457 | key => 'my_key', | ||
4278 | 458 | pos_in_log => 0, | ||
4279 | 459 | res => 'VALUE', | ||
4280 | 460 | ts => '2009-07-06 22:07:14.411331', | ||
4281 | 461 | val => ('lorem ipsum dolor sit amet' x 690) . ' fini!', | ||
4282 | 462 | }, | ||
4283 | 463 | ); | ||
4284 | 464 | is_deeply( | ||
4285 | 465 | $events, | ||
4286 | 466 | [ | ||
4287 | 467 | { | ||
4288 | 468 | arg => 'get my_key', | ||
4289 | 469 | fingerprint => 'get my_key', | ||
4290 | 470 | key_print => 'my_key', | ||
4291 | 471 | cmd => 'get', | ||
4292 | 472 | key => 'my_key', | ||
4293 | 473 | res => 'VALUE', | ||
4294 | 474 | Memc_add => 'No', | ||
4295 | 475 | Memc_append => 'No', | ||
4296 | 476 | Memc_cas => 'No', | ||
4297 | 477 | Memc_decr => 'No', | ||
4298 | 478 | Memc_delete => 'No', | ||
4299 | 479 | Memc_error => 'No', | ||
4300 | 480 | Memc_get => 'Yes', | ||
4301 | 481 | Memc_gets => 'No', | ||
4302 | 482 | Memc_incr => 'No', | ||
4303 | 483 | Memc_miss => 'No', | ||
4304 | 484 | Memc_prepend => 'No', | ||
4305 | 485 | Memc_replace => 'No', | ||
4306 | 486 | Memc_set => 'No', | ||
4307 | 487 | Memc_miss => 'No', | ||
4308 | 488 | Memc_error => 'No', | ||
4309 | 489 | Query_time => '0.000196', | ||
4310 | 490 | bytes => 17946, | ||
4311 | 491 | exptime => undef, | ||
4312 | 492 | flags => 0, | ||
4313 | 493 | host => '127.0.0.1', | ||
4314 | 494 | pos_in_log => 0, | ||
4315 | 495 | ts => '2009-07-06 22:07:14.411331', | ||
4316 | 496 | val => ('lorem ipsum dolor sit amet' x 690) . ' fini!', | ||
4317 | 497 | }, | ||
4318 | 498 | ], | ||
4319 | 499 | 'samples/memc_tcpdump006.txt: huge get' | ||
4320 | 500 | ); | ||
4321 | 501 | |||
4322 | 502 | # A session with a get() that doesn't exist. | ||
4323 | 503 | $events = make_events( | ||
4324 | 504 | { | ||
4325 | 505 | Query_time => '0.000016', | ||
4326 | 506 | bytes => undef, | ||
4327 | 507 | cmd => 'get', | ||
4328 | 508 | exptime => undef, | ||
4329 | 509 | flags => undef, | ||
4330 | 510 | host => '127.0.0.1', | ||
4331 | 511 | key => 'comment_v3_482685', | ||
4332 | 512 | pos_in_log => 0, | ||
4333 | 513 | res => 'NOT_FOUND', | ||
4334 | 514 | ts => '2009-06-11 21:54:49.059144', | ||
4335 | 515 | val => '', | ||
4336 | 516 | }, | ||
4337 | 517 | ); | ||
4338 | 518 | is_deeply( | ||
4339 | 519 | $events, | ||
4340 | 520 | [ | ||
4341 | 521 | { | ||
4342 | 522 | arg => 'get comment_v3_482685', | ||
4343 | 523 | fingerprint => 'get comment_v?_?', | ||
4344 | 524 | key_print => 'comment_v?_?', | ||
4345 | 525 | cmd => 'get', | ||
4346 | 526 | key => 'comment_v3_482685', | ||
4347 | 527 | res => 'NOT_FOUND', | ||
4348 | 528 | Memc_add => 'No', | ||
4349 | 529 | Memc_append => 'No', | ||
4350 | 530 | Memc_cas => 'No', | ||
4351 | 531 | Memc_decr => 'No', | ||
4352 | 532 | Memc_delete => 'No', | ||
4353 | 533 | Memc_error => 'No', | ||
4354 | 534 | Memc_get => 'Yes', | ||
4355 | 535 | Memc_gets => 'No', | ||
4356 | 536 | Memc_incr => 'No', | ||
4357 | 537 | Memc_miss => 'No', | ||
4358 | 538 | Memc_prepend => 'No', | ||
4359 | 539 | Memc_replace => 'No', | ||
4360 | 540 | Memc_set => 'No', | ||
4361 | 541 | Memc_miss => 'Yes', | ||
4362 | 542 | Memc_error => 'No', | ||
4363 | 543 | Query_time => '0.000016', | ||
4364 | 544 | bytes => undef, | ||
4365 | 545 | exptime => undef, | ||
4366 | 546 | flags => undef, | ||
4367 | 547 | host => '127.0.0.1', | ||
4368 | 548 | pos_in_log => 0, | ||
4369 | 549 | ts => '2009-06-11 21:54:49.059144', | ||
4370 | 550 | val => '', | ||
4371 | 551 | }, | ||
4372 | 552 | ], | ||
4373 | 553 | 'samples/memc_tcpdump007.txt: get nonexistent key' | ||
4374 | 554 | ); | ||
4375 | 555 | |||
4376 | 556 | # A session with a huge get() that will not fit into a single TCP packet, but | ||
4377 | 557 | # the connection seems to be broken in the middle of the receive and then the | ||
4378 | 558 | # new client picks up and asks for something different. | ||
4379 | 559 | $events = make_events( | ||
4380 | 560 | { | ||
4381 | 561 | Query_time => '0.000003', | ||
4382 | 562 | bytes => 17946, | ||
4383 | 563 | cmd => 'get', | ||
4384 | 564 | exptime => undef, | ||
4385 | 565 | flags => 0, | ||
4386 | 566 | host => '127.0.0.1', | ||
4387 | 567 | key => 'my_key', | ||
4388 | 568 | pos_in_log => 0, | ||
4389 | 569 | res => 'INTERRUPTED', | ||
4390 | 570 | ts => '2009-07-06 22:07:14.411331', | ||
4391 | 571 | val => '', | ||
4392 | 572 | }, | ||
4393 | 573 | { Query_time => '0.000001', | ||
4394 | 574 | cmd => 'get', | ||
4395 | 575 | key => 'my_key', | ||
4396 | 576 | val => 'Some value', | ||
4397 | 577 | bytes => 10, | ||
4398 | 578 | exptime => undef, | ||
4399 | 579 | flags => 0, | ||
4400 | 580 | host => '127.0.0.1', | ||
4401 | 581 | pos_in_log => 5382, | ||
4402 | 582 | res => 'VALUE', | ||
4403 | 583 | ts => '2009-07-06 22:07:14.411334', | ||
4404 | 584 | }, | ||
4405 | 585 | ); | ||
4406 | 586 | is_deeply( | ||
4407 | 587 | $events, | ||
4408 | 588 | [ | ||
4409 | 589 | { | ||
4410 | 590 | arg => 'get my_key', | ||
4411 | 591 | fingerprint => 'get my_key', | ||
4412 | 592 | key_print => 'my_key', | ||
4413 | 593 | cmd => 'get', | ||
4414 | 594 | key => 'my_key', | ||
4415 | 595 | res => 'INTERRUPTED', | ||
4416 | 596 | Memc_add => 'No', | ||
4417 | 597 | Memc_append => 'No', | ||
4418 | 598 | Memc_cas => 'No', | ||
4419 | 599 | Memc_decr => 'No', | ||
4420 | 600 | Memc_delete => 'No', | ||
4421 | 601 | Memc_error => 'No', | ||
4422 | 602 | Memc_get => 'Yes', | ||
4423 | 603 | Memc_gets => 'No', | ||
4424 | 604 | Memc_incr => 'No', | ||
4425 | 605 | Memc_miss => 'No', | ||
4426 | 606 | Memc_prepend => 'No', | ||
4427 | 607 | Memc_replace => 'No', | ||
4428 | 608 | Memc_set => 'No', | ||
4429 | 609 | Memc_miss => 'No', | ||
4430 | 610 | Memc_error => 'Yes', | ||
4431 | 611 | Query_time => '0.000003', | ||
4432 | 612 | bytes => 17946, | ||
4433 | 613 | exptime => undef, | ||
4434 | 614 | flags => 0, | ||
4435 | 615 | host => '127.0.0.1', | ||
4436 | 616 | pos_in_log => 0, | ||
4437 | 617 | ts => '2009-07-06 22:07:14.411331', | ||
4438 | 618 | val => '', | ||
4439 | 619 | }, | ||
4440 | 620 | { | ||
4441 | 621 | arg => 'get my_key', | ||
4442 | 622 | fingerprint => 'get my_key', | ||
4443 | 623 | key_print => 'my_key', | ||
4444 | 624 | cmd => 'get', | ||
4445 | 625 | key => 'my_key', | ||
4446 | 626 | res => 'VALUE', | ||
4447 | 627 | Memc_add => 'No', | ||
4448 | 628 | Memc_append => 'No', | ||
4449 | 629 | Memc_cas => 'No', | ||
4450 | 630 | Memc_decr => 'No', | ||
4451 | 631 | Memc_delete => 'No', | ||
4452 | 632 | Memc_error => 'No', | ||
4453 | 633 | Memc_get => 'Yes', | ||
4454 | 634 | Memc_gets => 'No', | ||
4455 | 635 | Memc_incr => 'No', | ||
4456 | 636 | Memc_miss => 'No', | ||
4457 | 637 | Memc_prepend => 'No', | ||
4458 | 638 | Memc_replace => 'No', | ||
4459 | 639 | Memc_set => 'No', | ||
4460 | 640 | Memc_miss => 'No', | ||
4461 | 641 | Memc_error => 'No', | ||
4462 | 642 | Query_time => '0.000001', | ||
4463 | 643 | val => 'Some value', | ||
4464 | 644 | bytes => 10, | ||
4465 | 645 | exptime => undef, | ||
4466 | 646 | flags => 0, | ||
4467 | 647 | host => '127.0.0.1', | ||
4468 | 648 | pos_in_log => 5382, | ||
4469 | 649 | ts => '2009-07-06 22:07:14.411334', | ||
4470 | 650 | }, | ||
4471 | 651 | ], | ||
4472 | 652 | 'samples/memc_tcpdump008.txt: interrupted huge get' | ||
4473 | 653 | ); | ||
4474 | 654 | |||
4475 | 655 | # A session with a delete() that doesn't exist. TODO: delete takes a queue_time. | ||
4476 | 656 | $events = make_events( | ||
4477 | 657 | { | ||
4478 | 658 | Query_time => '0.000022', | ||
4479 | 659 | bytes => undef, | ||
4480 | 660 | cmd => 'delete', | ||
4481 | 661 | exptime => undef, | ||
4482 | 662 | flags => undef, | ||
4483 | 663 | host => '127.0.0.1', | ||
4484 | 664 | key => 'comment_1873527', | ||
4485 | 665 | pos_in_log => 0, | ||
4486 | 666 | res => 'NOT_FOUND', | ||
4487 | 667 | ts => '2009-06-11 21:54:52.244534', | ||
4488 | 668 | val => '', | ||
4489 | 669 | }, | ||
4490 | 670 | ); | ||
4491 | 671 | is_deeply( | ||
4492 | 672 | $events, | ||
4493 | 673 | [ | ||
4494 | 674 | { | ||
4495 | 675 | arg => 'delete comment_1873527', | ||
4496 | 676 | fingerprint => 'delete comment_?', | ||
4497 | 677 | key_print => 'comment_?', | ||
4498 | 678 | cmd => 'delete', | ||
4499 | 679 | key => 'comment_1873527', | ||
4500 | 680 | res => 'NOT_FOUND', | ||
4501 | 681 | Memc_add => 'No', | ||
4502 | 682 | Memc_append => 'No', | ||
4503 | 683 | Memc_cas => 'No', | ||
4504 | 684 | Memc_decr => 'No', | ||
4505 | 685 | Memc_delete => 'Yes', | ||
4506 | 686 | Memc_error => 'No', | ||
4507 | 687 | Memc_get => 'No', | ||
4508 | 688 | Memc_gets => 'No', | ||
4509 | 689 | Memc_incr => 'No', | ||
4510 | 690 | Memc_miss => 'No', | ||
4511 | 691 | Memc_prepend => 'No', | ||
4512 | 692 | Memc_replace => 'No', | ||
4513 | 693 | Memc_set => 'No', | ||
4514 | 694 | Memc_miss => 'Yes', | ||
4515 | 695 | Memc_error => 'No', | ||
4516 | 696 | Query_time => '0.000022', | ||
4517 | 697 | bytes => undef, | ||
4518 | 698 | exptime => undef, | ||
4519 | 699 | flags => undef, | ||
4520 | 700 | host => '127.0.0.1', | ||
4521 | 701 | pos_in_log => 0, | ||
4522 | 702 | ts => '2009-06-11 21:54:52.244534', | ||
4523 | 703 | val => '', | ||
4524 | 704 | }, | ||
4525 | 705 | ], | ||
4526 | 706 | 'samples/memc_tcpdump009.txt: delete nonexistent key' | ||
4527 | 707 | ); | ||
4528 | 708 | |||
4529 | 709 | # A session with a delete() that does exist. | ||
4530 | 710 | $events = make_events( | ||
4531 | 711 | { | ||
4532 | 712 | Query_time => '0.000120', | ||
4533 | 713 | bytes => undef, | ||
4534 | 714 | cmd => 'delete', | ||
4535 | 715 | exptime => undef, | ||
4536 | 716 | flags => undef, | ||
4537 | 717 | host => '127.0.0.1', | ||
4538 | 718 | key => 'my_key', | ||
4539 | 719 | pos_in_log => 0, | ||
4540 | 720 | res => 'DELETED', | ||
4541 | 721 | ts => '2009-07-09 22:00:29.066476', | ||
4542 | 722 | val => '', | ||
4543 | 723 | }, | ||
4544 | 724 | ); | ||
4545 | 725 | is_deeply( | ||
4546 | 726 | $events, | ||
4547 | 727 | [ | ||
4548 | 728 | { | ||
4549 | 729 | arg => 'delete my_key', | ||
4550 | 730 | fingerprint => 'delete my_key', | ||
4551 | 731 | key_print => 'my_key', | ||
4552 | 732 | cmd => 'delete', | ||
4553 | 733 | key => 'my_key', | ||
4554 | 734 | res => 'DELETED', | ||
4555 | 735 | Memc_add => 'No', | ||
4556 | 736 | Memc_append => 'No', | ||
4557 | 737 | Memc_cas => 'No', | ||
4558 | 738 | Memc_decr => 'No', | ||
4559 | 739 | Memc_delete => 'Yes', | ||
4560 | 740 | Memc_error => 'No', | ||
4561 | 741 | Memc_get => 'No', | ||
4562 | 742 | Memc_gets => 'No', | ||
4563 | 743 | Memc_incr => 'No', | ||
4564 | 744 | Memc_miss => 'No', | ||
4565 | 745 | Memc_prepend => 'No', | ||
4566 | 746 | Memc_replace => 'No', | ||
4567 | 747 | Memc_set => 'No', | ||
4568 | 748 | Memc_miss => 'No', | ||
4569 | 749 | Memc_error => 'No', | ||
4570 | 750 | Query_time => '0.000120', | ||
4571 | 751 | bytes => undef, | ||
4572 | 752 | exptime => undef, | ||
4573 | 753 | flags => undef, | ||
4574 | 754 | host => '127.0.0.1', | ||
4575 | 755 | pos_in_log => 0, | ||
4576 | 756 | ts => '2009-07-09 22:00:29.066476', | ||
4577 | 757 | val => '', | ||
4578 | 758 | }, | ||
4579 | 759 | ], | ||
4580 | 760 | 'samples/memc_tcpdump010.txt: simple delete' | ||
4581 | 761 | ); | ||
4582 | 762 | |||
4583 | 763 | # ############################################################################# | ||
4584 | 764 | # Done. | ||
4585 | 765 | # ############################################################################# | ||
4586 | 766 | exit; | ||
4587 | 767 | 0 | ||
4588 | === removed file 't/lib/MemcachedProtocolParser.t' | |||
4589 | --- t/lib/MemcachedProtocolParser.t 2012-03-06 13:56:08 +0000 | |||
4590 | +++ t/lib/MemcachedProtocolParser.t 1970-01-01 00:00:00 +0000 | |||
4591 | @@ -1,414 +0,0 @@ | |||
4592 | 1 | #!/usr/bin/perl | ||
4593 | 2 | |||
4594 | 3 | BEGIN { | ||
4595 | 4 | die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n" | ||
4596 | 5 | unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH}; | ||
4597 | 6 | unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib"; | ||
4598 | 7 | }; | ||
4599 | 8 | |||
4600 | 9 | use strict; | ||
4601 | 10 | use warnings FATAL => 'all'; | ||
4602 | 11 | use English qw(-no_match_vars); | ||
4603 | 12 | use Test::More tests => 28; | ||
4604 | 13 | |||
4605 | 14 | use MemcachedProtocolParser; | ||
4606 | 15 | use TcpdumpParser; | ||
4607 | 16 | use PerconaTest; | ||
4608 | 17 | |||
4609 | 18 | my $tcpdump = new TcpdumpParser(); | ||
4610 | 19 | my $protocol; # Create a new MemcachedProtocolParser for each test. | ||
4611 | 20 | |||
4612 | 21 | # A session with a simple set(). | ||
4613 | 22 | $protocol = new MemcachedProtocolParser(); | ||
4614 | 23 | test_protocol_parser( | ||
4615 | 24 | parser => $tcpdump, | ||
4616 | 25 | protocol => $protocol, | ||
4617 | 26 | file => 't/lib/samples/memcached/memc_tcpdump001.txt', | ||
4618 | 27 | result => [ | ||
4619 | 28 | { ts => '2009-07-04 21:33:39.229179', | ||
4620 | 29 | host => '127.0.0.1', | ||
4621 | 30 | cmd => 'set', | ||
4622 | 31 | key => 'my_key', | ||
4623 | 32 | val => 'Some value', | ||
4624 | 33 | flags => '0', | ||
4625 | 34 | exptime => '0', | ||
4626 | 35 | bytes => '10', | ||
4627 | 36 | res => 'STORED', | ||
4628 | 37 | Query_time => sprintf('%.6f', .229299 - .229179), | ||
4629 | 38 | pos_in_log => 0, | ||
4630 | 39 | }, | ||
4631 | 40 | ], | ||
4632 | 41 | ); | ||
4633 | 42 | |||
4634 | 43 | # A session with a simple get(). | ||
4635 | 44 | $protocol = new MemcachedProtocolParser(); | ||
4636 | 45 | test_protocol_parser( | ||
4637 | 46 | parser => $tcpdump, | ||
4638 | 47 | protocol => $protocol, | ||
4639 | 48 | file => 't/lib/samples/memcached/memc_tcpdump002.txt', | ||
4640 | 49 | result => [ | ||
4641 | 50 | { Query_time => '0.000067', | ||
4642 | 51 | cmd => 'get', | ||
4643 | 52 | key => 'my_key', | ||
4644 | 53 | val => 'Some value', | ||
4645 | 54 | bytes => 10, | ||
4646 | 55 | exptime => 0, | ||
4647 | 56 | flags => 0, | ||
4648 | 57 | host => '127.0.0.1', | ||
4649 | 58 | pos_in_log => '0', | ||
4650 | 59 | res => 'VALUE', | ||
4651 | 60 | ts => '2009-07-04 22:12:06.174390' | ||
4652 | 61 | }, | ||
4653 | 62 | ], | ||
4654 | 63 | ); | ||
4655 | 64 | |||
4656 | 65 | # A session with a simple incr() and decr(). | ||
4657 | 66 | $protocol = new MemcachedProtocolParser(); | ||
4658 | 67 | test_protocol_parser( | ||
4659 | 68 | parser => $tcpdump, | ||
4660 | 69 | protocol => $protocol, | ||
4661 | 70 | file => 't/lib/samples/memcached/memc_tcpdump003.txt', | ||
4662 | 71 | result => [ | ||
4663 | 72 | { Query_time => '0.000073', | ||
4664 | 73 | cmd => 'incr', | ||
4665 | 74 | key => 'key', | ||
4666 | 75 | val => '8', | ||
4667 | 76 | bytes => 0, | ||
4668 | 77 | exptime => 0, | ||
4669 | 78 | flags => 0, | ||
4670 | 79 | host => '127.0.0.1', | ||
4671 | 80 | pos_in_log => '0', | ||
4672 | 81 | res => '', | ||
4673 | 82 | ts => '2009-07-04 22:12:06.175734', | ||
4674 | 83 | }, | ||
4675 | 84 | { Query_time => '0.000068', | ||
4676 | 85 | cmd => 'decr', | ||
4677 | 86 | bytes => 0, | ||
4678 | 87 | exptime => 0, | ||
4679 | 88 | flags => 0, | ||
4680 | 89 | host => '127.0.0.1', | ||
4681 | 90 | key => 'key', | ||
4682 | 91 | pos_in_log => 522, | ||
4683 | 92 | res => '', | ||
4684 | 93 | ts => '2009-07-04 22:12:06.176181', | ||
4685 | 94 | val => '7', | ||
4686 | 95 | }, | ||
4687 | 96 | ], | ||
4688 | 97 | ); | ||
4689 | 98 | |||
4690 | 99 | # A session with a simple incr() and decr(), but the value doesn't exist. | ||
4691 | 100 | $protocol = new MemcachedProtocolParser(); | ||
4692 | 101 | test_protocol_parser( | ||
4693 | 102 | parser => $tcpdump, | ||
4694 | 103 | protocol => $protocol, | ||
4695 | 104 | file => 't/lib/samples/memcached/memc_tcpdump004.txt', | ||
4696 | 105 | result => [ | ||
4697 | 106 | { Query_time => '0.000131', | ||
4698 | 107 | bytes => 0, | ||
4699 | 108 | cmd => 'incr', | ||
4700 | 109 | exptime => 0, | ||
4701 | 110 | flags => 0, | ||
4702 | 111 | host => '127.0.0.1', | ||
4703 | 112 | key => 'key', | ||
4704 | 113 | pos_in_log => 764, | ||
4705 | 114 | res => 'NOT_FOUND', | ||
4706 | 115 | ts => '2009-07-06 10:37:21.668469', | ||
4707 | 116 | val => '', | ||
4708 | 117 | }, | ||
4709 | 118 | { | ||
4710 | 119 | Query_time => '0.000055', | ||
4711 | 120 | bytes => 0, | ||
4712 | 121 | cmd => 'decr', | ||
4713 | 122 | exptime => 0, | ||
4714 | 123 | flags => 0, | ||
4715 | 124 | host => '127.0.0.1', | ||
4716 | 125 | key => 'key', | ||
4717 | 126 | pos_in_log => 1788, | ||
4718 | 127 | res => 'NOT_FOUND', | ||
4719 | 128 | ts => '2009-07-06 10:37:21.668851', | ||
4720 | 129 | val => '', | ||
4721 | 130 | }, | ||
4722 | 131 | ], | ||
4723 | 132 | ); | ||
4724 | 133 | |||
4725 | 134 | # A session with a huge set() that will not fit into a single TCP packet. | ||
4726 | 135 | $protocol = new MemcachedProtocolParser(); | ||
4727 | 136 | test_protocol_parser( | ||
4728 | 137 | parser => $tcpdump, | ||
4729 | 138 | protocol => $protocol, | ||
4730 | 139 | file => 't/lib/samples/memcached/memc_tcpdump005.txt', | ||
4731 | 140 | result => [ | ||
4732 | 141 | { Query_time => '0.003928', | ||
4733 | 142 | bytes => 17946, | ||
4734 | 143 | cmd => 'set', | ||
4735 | 144 | exptime => 0, | ||
4736 | 145 | flags => 0, | ||
4737 | 146 | host => '127.0.0.1', | ||
4738 | 147 | key => 'my_key', | ||
4739 | 148 | pos_in_log => 764, | ||
4740 | 149 | res => 'STORED', | ||
4741 | 150 | ts => '2009-07-06 22:07:14.406827', | ||
4742 | 151 | val => ('lorem ipsum dolor sit amet' x 690) . ' fini!', | ||
4743 | 152 | }, | ||
4744 | 153 | ], | ||
4745 | 154 | ); | ||
4746 | 155 | |||
4747 | 156 | # A session with a huge get() that will not fit into a single TCP packet. | ||
4748 | 157 | $protocol = new MemcachedProtocolParser(); | ||
4749 | 158 | test_protocol_parser( | ||
4750 | 159 | parser => $tcpdump, | ||
4751 | 160 | protocol => $protocol, | ||
4752 | 161 | file => 't/lib/samples/memcached/memc_tcpdump006.txt', | ||
4753 | 162 | result => [ | ||
4754 | 163 | { | ||
4755 | 164 | Query_time => '0.000196', | ||
4756 | 165 | bytes => 17946, | ||
4757 | 166 | cmd => 'get', | ||
4758 | 167 | exptime => 0, | ||
4759 | 168 | flags => 0, | ||
4760 | 169 | host => '127.0.0.1', | ||
4761 | 170 | key => 'my_key', | ||
4762 | 171 | pos_in_log => 0, | ||
4763 | 172 | res => 'VALUE', | ||
4764 | 173 | ts => '2009-07-06 22:07:14.411331', | ||
4765 | 174 | val => ('lorem ipsum dolor sit amet' x 690) . ' fini!', | ||
4766 | 175 | }, | ||
4767 | 176 | ], | ||
4768 | 177 | ); | ||
4769 | 178 | |||
4770 | 179 | # A session with a get() that doesn't exist. | ||
4771 | 180 | $protocol = new MemcachedProtocolParser(); | ||
4772 | 181 | test_protocol_parser( | ||
4773 | 182 | parser => $tcpdump, | ||
4774 | 183 | protocol => $protocol, | ||
4775 | 184 | file => 't/lib/samples/memcached/memc_tcpdump007.txt', | ||
4776 | 185 | result => [ | ||
4777 | 186 | { | ||
4778 | 187 | Query_time => '0.000016', | ||
4779 | 188 | bytes => 0, | ||
4780 | 189 | cmd => 'get', | ||
4781 | 190 | exptime => 0, | ||
4782 | 191 | flags => 0, | ||
4783 | 192 | host => '127.0.0.1', | ||
4784 | 193 | key => 'comment_v3_482685', | ||
4785 | 194 | pos_in_log => 0, | ||
4786 | 195 | res => 'NOT_FOUND', | ||
4787 | 196 | ts => '2009-06-11 21:54:49.059144', | ||
4788 | 197 | val => '', | ||
4789 | 198 | }, | ||
4790 | 199 | ], | ||
4791 | 200 | ); | ||
4792 | 201 | |||
4793 | 202 | # A session with a huge get() that will not fit into a single TCP packet, but | ||
4794 | 203 | # the connection seems to be broken in the middle of the receive and then the | ||
4795 | 204 | # new client picks up and asks for something different. | ||
4796 | 205 | $protocol = new MemcachedProtocolParser(); | ||
4797 | 206 | test_protocol_parser( | ||
4798 | 207 | parser => $tcpdump, | ||
4799 | 208 | protocol => $protocol, | ||
4800 | 209 | file => 't/lib/samples/memcached/memc_tcpdump008.txt', | ||
4801 | 210 | result => [ | ||
4802 | 211 | { | ||
4803 | 212 | Query_time => '0.000003', | ||
4804 | 213 | bytes => 17946, | ||
4805 | 214 | cmd => 'get', | ||
4806 | 215 | exptime => 0, | ||
4807 | 216 | flags => 0, | ||
4808 | 217 | host => '127.0.0.1', | ||
4809 | 218 | key => 'my_key', | ||
4810 | 219 | pos_in_log => 0, | ||
4811 | 220 | res => 'INTERRUPTED', | ||
4812 | 221 | ts => '2009-07-06 22:07:14.411331', | ||
4813 | 222 | val => '', | ||
4814 | 223 | }, | ||
4815 | 224 | { Query_time => '0.000001', | ||
4816 | 225 | cmd => 'get', | ||
4817 | 226 | key => 'my_key', | ||
4818 | 227 | val => 'Some value', | ||
4819 | 228 | bytes => 10, | ||
4820 | 229 | exptime => 0, | ||
4821 | 230 | flags => 0, | ||
4822 | 231 | host => '127.0.0.1', | ||
4823 | 232 | pos_in_log => 5382, | ||
4824 | 233 | res => 'VALUE', | ||
4825 | 234 | ts => '2009-07-06 22:07:14.411334', | ||
4826 | 235 | }, | ||
4827 | 236 | ], | ||
4828 | 237 | ); | ||
4829 | 238 | |||
4830 | 239 | # A session with a delete() that doesn't exist. TODO: delete takes a queue_time. | ||
4831 | 240 | $protocol = new MemcachedProtocolParser(); | ||
4832 | 241 | test_protocol_parser( | ||
4833 | 242 | parser => $tcpdump, | ||
4834 | 243 | protocol => $protocol, | ||
4835 | 244 | file => 't/lib/samples/memcached/memc_tcpdump009.txt', | ||
4836 | 245 | result => [ | ||
4837 | 246 | { | ||
4838 | 247 | Query_time => '0.000022', | ||
4839 | 248 | bytes => 0, | ||
4840 | 249 | cmd => 'delete', | ||
4841 | 250 | exptime => 0, | ||
4842 | 251 | flags => 0, | ||
4843 | 252 | host => '127.0.0.1', | ||
4844 | 253 | key => 'comment_1873527', | ||
4845 | 254 | pos_in_log => 0, | ||
4846 | 255 | res => 'NOT_FOUND', | ||
4847 | 256 | ts => '2009-06-11 21:54:52.244534', | ||
4848 | 257 | val => '', | ||
4849 | 258 | }, | ||
4850 | 259 | ], | ||
4851 | 260 | ); | ||
4852 | 261 | |||
4853 | 262 | # A session with a delete() that does exist. | ||
4854 | 263 | $protocol = new MemcachedProtocolParser(); | ||
4855 | 264 | test_protocol_parser( | ||
4856 | 265 | parser => $tcpdump, | ||
4857 | 266 | protocol => $protocol, | ||
4858 | 267 | file => 't/lib/samples/memcached/memc_tcpdump010.txt', | ||
4859 | 268 | result => [ | ||
4860 | 269 | { | ||
4861 | 270 | Query_time => '0.000120', | ||
4862 | 271 | bytes => 0, | ||
4863 | 272 | cmd => 'delete', | ||
4864 | 273 | exptime => 0, | ||
4865 | 274 | flags => 0, | ||
4866 | 275 | host => '127.0.0.1', | ||
4867 | 276 | key => 'my_key', | ||
4868 | 277 | pos_in_log => 0, | ||
4869 | 278 | res => 'DELETED', | ||
4870 | 279 | ts => '2009-07-09 22:00:29.066476', | ||
4871 | 280 | val => '', | ||
4872 | 281 | }, | ||
4873 | 282 | ], | ||
4874 | 283 | ); | ||
4875 | 284 | |||
4876 | 285 | # ############################################################################# | ||
4877 | 286 | # Issue 537: MySQLProtocolParser and MemcachedProtocolParser do not handle | ||
4878 | 287 | # multiple servers. | ||
4879 | 288 | # ############################################################################# | ||
4880 | 289 | $protocol = new MemcachedProtocolParser(); | ||
4881 | 290 | test_protocol_parser( | ||
4882 | 291 | parser => $tcpdump, | ||
4883 | 292 | protocol => $protocol, | ||
4884 | 293 | file => 't/lib/samples/memcached/memc_tcpdump011.txt', | ||
4885 | 294 | result => [ | ||
4886 | 295 | { Query_time => '0.000067', | ||
4887 | 296 | cmd => 'get', | ||
4888 | 297 | key => 'my_key', | ||
4889 | 298 | val => 'Some value', | ||
4890 | 299 | bytes => 10, | ||
4891 | 300 | exptime => 0, | ||
4892 | 301 | flags => 0, | ||
4893 | 302 | host => '127.0.0.8', | ||
4894 | 303 | pos_in_log => '0', | ||
4895 | 304 | res => 'VALUE', | ||
4896 | 305 | ts => '2009-07-04 22:12:06.174390' | ||
4897 | 306 | }, | ||
4898 | 307 | { ts => '2009-07-04 21:33:39.229179', | ||
4899 | 308 | host => '127.0.0.9', | ||
4900 | 309 | cmd => 'set', | ||
4901 | 310 | key => 'my_key', | ||
4902 | 311 | val => 'Some value', | ||
4903 | 312 | flags => '0', | ||
4904 | 313 | exptime => '0', | ||
4905 | 314 | bytes => '10', | ||
4906 | 315 | res => 'STORED', | ||
4907 | 316 | Query_time => sprintf('%.6f', .229299 - .229179), | ||
4908 | 317 | pos_in_log => 638, | ||
4909 | 318 | }, | ||
4910 | 319 | ], | ||
4911 | 320 | ); | ||
4912 | 321 | |||
4913 | 322 | # ############################################################################# | ||
4914 | 323 | # Issue 544: memcached parse error | ||
4915 | 324 | # ############################################################################# | ||
4916 | 325 | |||
4917 | 326 | # Multiple delete in one packet. | ||
4918 | 327 | $protocol = new MemcachedProtocolParser(); | ||
4919 | 328 | test_protocol_parser( | ||
4920 | 329 | parser => $tcpdump, | ||
4921 | 330 | protocol => $protocol, | ||
4922 | 331 | file => 't/lib/samples/memcached/memc_tcpdump014.txt', | ||
4923 | 332 | result => [ | ||
4924 | 333 | { ts => '2009-10-06 10:31:56.323538', | ||
4925 | 334 | Query_time => '0.000024', | ||
4926 | 335 | bytes => 0, | ||
4927 | 336 | cmd => 'delete', | ||
4928 | 337 | exptime => 0, | ||
4929 | 338 | flags => 0, | ||
4930 | 339 | host => '10.0.0.5', | ||
4931 | 340 | key => 'ABBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBC', | ||
4932 | 341 | pos_in_log => 0, | ||
4933 | 342 | res => 'NOT_FOUND', | ||
4934 | 343 | val => '' | ||
4935 | 344 | }, | ||
4936 | 345 | ], | ||
4937 | 346 | ); | ||
4938 | 347 | |||
4939 | 348 | # Multiple mixed commands: get delete delete | ||
4940 | 349 | $protocol = new MemcachedProtocolParser(); | ||
4941 | 350 | test_protocol_parser( | ||
4942 | 351 | parser => $tcpdump, | ||
4943 | 352 | protocol => $protocol, | ||
4944 | 353 | file => 't/lib/samples/memcached/memc_tcpdump015.txt', | ||
4945 | 354 | result => [ | ||
4946 | 355 | { ts => '2009-10-06 10:31:56.330709', | ||
4947 | 356 | Query_time => '0.000013', | ||
4948 | 357 | bytes => 0, | ||
4949 | 358 | cmd => 'get', | ||
4950 | 359 | exptime => 0, | ||
4951 | 360 | flags => 0, | ||
4952 | 361 | host => '10.0.0.5', | ||
4953 | 362 | key => 'ABBBBBBBBBBBBBBBBBBBBBC', | ||
4954 | 363 | pos_in_log => 0, | ||
4955 | 364 | res => 'NOT_FOUND', | ||
4956 | 365 | |||
4957 | 366 | val => '' | ||
4958 | 367 | }, | ||
4959 | 368 | ], | ||
4960 | 369 | ); | ||
4961 | 370 | |||
4962 | 371 | |||
4963 | 372 | # ############################################################################# | ||
4964 | 373 | # Issue 818: mk-query-digest: error parsing memcached dump - use of | ||
4965 | 374 | # uninitialized value in addition | ||
4966 | 375 | # ############################################################################# | ||
4967 | 376 | |||
4968 | 377 | # A replace command. | ||
4969 | 378 | $protocol = new MemcachedProtocolParser(); | ||
4970 | 379 | test_protocol_parser( | ||
4971 | 380 | parser => $tcpdump, | ||
4972 | 381 | protocol => $protocol, | ||
4973 | 382 | file => 't/lib/samples/memcached/memc_tcpdump016.txt', | ||
4974 | 383 | result => [ | ||
4975 | 384 | { ts => '2010-01-20 10:27:18.510727', | ||
4976 | 385 | Query_time => '0.000030', | ||
4977 | 386 | bytes => 56, | ||
4978 | 387 | cmd => 'replace', | ||
4979 | 388 | exptime => '43200', | ||
4980 | 389 | flags => '1', | ||
4981 | 390 | host => '192.168.0.3', | ||
4982 | 391 | key => 'BD_Uk_cms__20100120_095702tab_containerId_410', | ||
4983 | 392 | pos_in_log => 0, | ||
4984 | 393 | res => 'STORED', | ||
4985 | 394 | val => 'a:3:{i:0;s:6:"a:0:{}";i:1;i:1263983238;i:2;s:5:"43200";}' | ||
4986 | 395 | }, | ||
4987 | 396 | { ts => '2010-01-20 10:27:18.510876', | ||
4988 | 397 | Query_time => '0.000066', | ||
4989 | 398 | bytes => '56', | ||
4990 | 399 | cmd => 'get', | ||
4991 | 400 | exptime => 0, | ||
4992 | 401 | flags => '1', | ||
4993 | 402 | host => '192.168.0.3', | ||
4994 | 403 | key => 'BD_Uk_cms__20100120_095702tab_containerId_410', | ||
4995 | 404 | pos_in_log => 893, | ||
4996 | 405 | res => 'VALUE', | ||
4997 | 406 | val => 'a:3:{i:0;s:6:"a:0:{}";i:1;i:1263983238;i:2;s:5:"43200";}' | ||
4998 | 407 | } | ||
4999 | 408 | ], | ||
5000 | 409 | ); |
The diff has been truncated for viewing.
The changes will be/are so extensive as to be beyond the point of pointed review. Just test on all platforms, and when tests are passing, merge.