Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 246 lines (218 sloc) 9.038 kb
74a067b First incarnation of HTTPProtocolParser.
daniel@percona.com authored
1 # This program is copyright 2009 Percona Inc.
2 # Feedback and improvements are welcome.
3 #
4 # THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
5 # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
6 # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
7 #
8 # This program is free software; you can redistribute it and/or modify it under
9 # the terms of the GNU General Public License as published by the Free Software
10 # Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
11 # systems, you can issue `man perlgpl' or `man perlartistic' to read these
12 # licenses.
13 #
14 # You should have received a copy of the GNU General Public License along with
15 # this program; if not, write to the Free Software Foundation, Inc., 59 Temple
16 # Place, Suite 330, Boston, MA 02111-1307 USA.
17 # ###########################################################################
18 # HTTPProtocolParser package $Revision$
19 # ###########################################################################
20 package HTTPProtocolParser;
df7d2fa use base again
daniel@percona.com authored
21 use base 'ProtocolParser';
74a067b First incarnation of HTTPProtocolParser.
daniel@percona.com authored
22
23 use strict;
24 use warnings FATAL => 'all';
25 use English qw(-no_match_vars);
26
27 use Data::Dumper;
28 $Data::Dumper::Indent = 1;
29 $Data::Dumper::Sortkeys = 1;
30 $Data::Dumper::Quotekeys = 0;
31
889fd94 Fix MKDEBUG in all modules (issue 733).
daniel@percona.com authored
32 use constant MKDEBUG => $ENV{MKDEBUG} || 0;
74a067b First incarnation of HTTPProtocolParser.
daniel@percona.com authored
33
34 # server is the "host:port" of the sever being watched. It's auto-guessed if
35 # not specified.
36 sub new {
37 my ( $class, %args ) = @_;
67c8eb1 Add parent class ProtocolParser and subclass HTTPProtocolParser.
daniel@percona.com authored
38 my $self = $class->SUPER::new(
39 %args,
68d6a13 Update issue 824. HTTPProtocolParser use server and port args.
daniel@percona.com authored
40 port => 80,
67c8eb1 Add parent class ProtocolParser and subclass HTTPProtocolParser.
daniel@percona.com authored
41 );
42 return $self;
74a067b First incarnation of HTTPProtocolParser.
daniel@percona.com authored
43 }
44
45 # Handles a packet from the server given the state of the session. Returns an
46 # event if one was ready to be created, otherwise returns nothing.
47 sub _packet_from_server {
48 my ( $self, $packet, $session, $misc ) = @_;
49 die "I need a packet" unless $packet;
50 die "I need a session" unless $session;
51
52 MKDEBUG && _d('Packet is from server; client state:', $session->{state});
53
54 # If there's no session state, then we're catching a server response
55 # mid-stream.
56 if ( !$session->{state} ) {
57 MKDEBUG && _d('Ignoring mid-stream server response');
58 return;
59 }
60
61f4bb6 Work on HTTPProtocolParser; handle out of order packets. Implement expe...
daniel@percona.com authored
61 if ( $session->{out_of_order} ) {
62 # We're waiting for the header so we can get the content length.
63 # Once we know this, we can determine how many out of order packets
64 # we need to complete the request, then order them and re-process.
65 my ($line1, $content);
66 if ( !$session->{have_header} ) {
67 ($line1, $content) = $self->_parse_header(
68 $session, $packet->{data}, $packet->{data_len});
69 }
70 if ( $line1 ) {
71 $session->{have_header} = 1;
72 $packet->{content_len} = length $content;
73 MKDEBUG && _d('Got out of order header with',
74 $packet->{content_len}, 'bytes of content');
75 }
76 my $have_len = $packet->{content_len} || $packet->{data_len};
77 map { $have_len += $_->{data_len} }
78 @{$session->{packets}};
79 $session->{have_all_packets}
80 = 1 if $session->{attribs}->{bytes}
81 && $have_len >= $session->{attribs}->{bytes};
82 MKDEBUG && _d('Have', $have_len, 'of', $session->{attribs}->{bytes});
83 return;
84 }
85
74a067b First incarnation of HTTPProtocolParser.
daniel@percona.com authored
86 # Assume that the server is returning only one value.
87 # TODO: make it handle multiple.
6226f1b Work on HTTPProtocolParser and ProtocolParser.
daniel@percona.com authored
88 if ( $session->{state} eq 'awaiting reply' ) {
f2c2a61 Test with correct values for out of order packet.
daniel@percona.com authored
89
90 # Save this early because we may return early if the packets
91 # are being received out of order. Also, save it only once
92 # in case we re-process packets if they're out of order.
93 $session->{start_reply} = $packet->{ts} unless $session->{start_reply};
94
95 # Get first line of header and first chunk of contents/data.
96 my ($line1, $content) = $self->_parse_header($session, $packet->{data},
97 $packet->{data_len});
98
99 # The reponse, when in order, is text header followed by data.
100 # If there's no line1, then we didn't get the text header first
101 # which means we're getting the response in out of order packets.
61f4bb6 Work on HTTPProtocolParser; handle out of order packets. Implement expe...
daniel@percona.com authored
102 if ( !$line1 ) {
f2c2a61 Test with correct values for out of order packet.
daniel@percona.com authored
103 $session->{out_of_order} = 1; # alert parent
61f4bb6 Work on HTTPProtocolParser; handle out of order packets. Implement expe...
daniel@percona.com authored
104 $session->{have_all_packets} = 0;
105 return;
106 }
f2c2a61 Test with correct values for out of order packet.
daniel@percona.com authored
107
6226f1b Work on HTTPProtocolParser and ProtocolParser.
daniel@percona.com authored
108 # First line should be: version code phrase
109 # E.g.: HTTP/1.1 200 OK
74a067b First incarnation of HTTPProtocolParser.
daniel@percona.com authored
110 my ($version, $code, $phrase) = $line1 =~ m/(\S+)/g;
a5faba5 Update HTTPProtocolParser and ProtocolParser (re issue 679).
daniel@percona.com authored
111 $session->{attribs}->{Status_code} = $code;
112 MKDEBUG && _d('Status code for last', $session->{attribs}->{arg},
113 'request:', $session->{attribs}->{Status_code});
6226f1b Work on HTTPProtocolParser and ProtocolParser.
daniel@percona.com authored
114
115 my $content_len = $content ? length $content : 0;
116 MKDEBUG && _d('Got', $content_len, 'bytes of content');
117 if ( $session->{attribs}->{bytes}
118 && $content_len < $session->{attribs}->{bytes} ) {
119 $session->{data_len} = $session->{attribs}->{bytes};
120 $session->{buff} = $content;
121 $session->{buff_left} = $session->{attribs}->{bytes} - $content_len;
122 MKDEBUG && _d('Contents not complete,', $session->{buff_left},
123 'bytes left');
124 $session->{state} = 'recving content';
125 return;
126 }
127 }
128 elsif ( $session->{state} eq 'recving content' ) {
129 if ( $session->{buff} ) {
130 MKDEBUG && _d('Receiving content,', $session->{buff_left},
131 'bytes left');
132 return;
74a067b First incarnation of HTTPProtocolParser.
daniel@percona.com authored
133 }
61f4bb6 Work on HTTPProtocolParser; handle out of order packets. Implement expe...
daniel@percona.com authored
134 MKDEBUG && _d('Contents received');
74a067b First incarnation of HTTPProtocolParser.
daniel@percona.com authored
135 }
136 else {
6226f1b Work on HTTPProtocolParser and ProtocolParser.
daniel@percona.com authored
137 # TODO:
138 warn "Server response in unknown state";
139 return;
74a067b First incarnation of HTTPProtocolParser.
daniel@percona.com authored
140 }
141
142 MKDEBUG && _d('Creating event, deleting session');
f2c2a61 Test with correct values for out of order packet.
daniel@percona.com authored
143 $session->{end_reply} = $session->{ts_max} || $packet->{ts};
67c8eb1 Add parent class ProtocolParser and subclass HTTPProtocolParser.
daniel@percona.com authored
144 my $event = $self->make_event($session, $packet);
74a067b First incarnation of HTTPProtocolParser.
daniel@percona.com authored
145 delete $self->{sessions}->{$session->{client}}; # http is stateless!
146 return $event;
147 }
148
149 # Handles a packet from the client given the state of the session.
150 sub _packet_from_client {
151 my ( $self, $packet, $session, $misc ) = @_;
152 die "I need a packet" unless $packet;
153 die "I need a session" unless $session;
154
155 MKDEBUG && _d('Packet is from client; state:', $session->{state});
156
157 my $event;
158 if ( ($session->{state} || '') =~ m/awaiting / ) {
a91b69a Handle multi-packet client requests.
daniel@percona.com authored
159 MKDEBUG && _d('More client headers:', $packet->{data});
160 return;
74a067b First incarnation of HTTPProtocolParser.
daniel@percona.com authored
161 }
162
163 if ( !$session->{state} ) {
6226f1b Work on HTTPProtocolParser and ProtocolParser.
daniel@percona.com authored
164 $session->{state} = 'awaiting reply';
61f4bb6 Work on HTTPProtocolParser; handle out of order packets. Implement expe...
daniel@percona.com authored
165 my ($line1, undef) = $self->_parse_header($session, $packet->{data}, $packet->{data_len});
6226f1b Work on HTTPProtocolParser and ProtocolParser.
daniel@percona.com authored
166 # First line should be: request page version
167 # E.g.: GET /foo.html HTTP/1.1
168 my ($request, $page, $version) = $line1 =~ m/(\S+)/g;
a5faba5 Update HTTPProtocolParser and ProtocolParser (re issue 679).
daniel@percona.com authored
169 if ( !$request || !$page ) {
170 MKDEBUG && _d("Didn't get a request or page:", $request, $page);
171 return;
172 }
6226f1b Work on HTTPProtocolParser and ProtocolParser.
daniel@percona.com authored
173 $request = lc $request;
69fdf50 Add vhost to arg. Fix better header line1 match. Add big sample 007.
daniel@percona.com authored
174 my $vh = $session->{attribs}->{Virtual_host} || '';
175 my $arg = "$request $vh$page";
a5faba5 Update HTTPProtocolParser and ProtocolParser (re issue 679).
daniel@percona.com authored
176 MKDEBUG && _d('arg:', $arg);
177
a3fb9c2 Allow and test POST.
daniel@percona.com authored
178 if ( $request eq 'get' || $request eq 'post' ) {
a5faba5 Update HTTPProtocolParser and ProtocolParser (re issue 679).
daniel@percona.com authored
179 @{$session->{attribs}}{qw(arg)} = ($arg);
74a067b First incarnation of HTTPProtocolParser.
daniel@percona.com authored
180 }
181 else {
6226f1b Work on HTTPProtocolParser and ProtocolParser.
daniel@percona.com authored
182 MKDEBUG && _d("Don't know how to handle a", $request, "request");
183 return;
74a067b First incarnation of HTTPProtocolParser.
daniel@percona.com authored
184 }
185
a5faba5 Update HTTPProtocolParser and ProtocolParser (re issue 679).
daniel@percona.com authored
186 $session->{start_request} = $packet->{ts};
67c8eb1 Add parent class ProtocolParser and subclass HTTPProtocolParser.
daniel@percona.com authored
187 $session->{attribs}->{host} = $packet->{src_host};
188 $session->{attribs}->{pos_in_log} = $packet->{pos_in_log};
189 $session->{attribs}->{ts} = $packet->{ts};
74a067b First incarnation of HTTPProtocolParser.
daniel@percona.com authored
190 }
191 else {
6226f1b Work on HTTPProtocolParser and ProtocolParser.
daniel@percona.com authored
192 # TODO:
193 die "Probably multiple GETs from client before a server response?";
74a067b First incarnation of HTTPProtocolParser.
daniel@percona.com authored
194 }
195
196 return $event;
197 }
198
6226f1b Work on HTTPProtocolParser and ProtocolParser.
daniel@percona.com authored
199 sub _parse_header {
61f4bb6 Work on HTTPProtocolParser; handle out of order packets. Implement expe...
daniel@percona.com authored
200 my ( $self, $session, $data, $len, $no_recurse ) = @_;
6226f1b Work on HTTPProtocolParser and ProtocolParser.
daniel@percona.com authored
201 die "I need data" unless $data;
202 my ($header, $content) = split(/\r\n\r\n/, $data);
69fdf50 Add vhost to arg. Fix better header line1 match. Add big sample 007.
daniel@percona.com authored
203 my ($line1, $header_vals) = $header =~ m/\A(\S+ \S+ .+?)\r\n(.+)?/s;
6226f1b Work on HTTPProtocolParser and ProtocolParser.
daniel@percona.com authored
204 MKDEBUG && _d('HTTP header:', $line1);
61f4bb6 Work on HTTPProtocolParser; handle out of order packets. Implement expe...
daniel@percona.com authored
205 return unless $line1;
206
9911a37 Don't die on no header vals.
daniel@percona.com authored
207 if ( !$header_vals ) {
208 MKDEBUG && _d('No header vals');
209 return $line1, undef;
210 }
6226f1b Work on HTTPProtocolParser and ProtocolParser.
daniel@percona.com authored
211 my @headers;
212 foreach my $val ( split(/\r\n/, $header_vals) ) {
213 last unless $val;
214 # Capture and save any useful header values.
215 MKDEBUG && _d('HTTP header:', $val);
216 if ( $val =~ m/^Content-Length/i ) {
217 ($session->{attribs}->{bytes}) = $val =~ /: (\d+)/;
218 MKDEBUG && _d('Saved Content-Length:', $session->{attribs}->{bytes});
219 }
61f4bb6 Work on HTTPProtocolParser; handle out of order packets. Implement expe...
daniel@percona.com authored
220 if ( $val =~ m/Content-Encoding/i ) {
221 ($session->{compressed}) = $val =~ /: (\w+)/;
222 MKDEBUG && _d('Saved Content-Encoding:', $session->{compressed});
223 }
6226f1b Work on HTTPProtocolParser and ProtocolParser.
daniel@percona.com authored
224 if ( $val =~ m/^Host/i ) {
225 # The "host" attribute is already taken, so we call this "domain".
a5faba5 Update HTTPProtocolParser and ProtocolParser (re issue 679).
daniel@percona.com authored
226 ($session->{attribs}->{Virtual_host}) = $val =~ /: (\S+)/;
227 MKDEBUG && _d('Saved Host:', ($session->{attribs}->{Virtual_host}));
6226f1b Work on HTTPProtocolParser and ProtocolParser.
daniel@percona.com authored
228 }
229 }
230 return $line1, $content;
231 }
232
233 sub _d {
234 my ($package, undef, $line) = caller 0;
235 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
236 map { defined $_ ? $_ : 'undef' }
237 @_;
238 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
239 }
240
74a067b First incarnation of HTTPProtocolParser.
daniel@percona.com authored
241 1;
242
243 # ###########################################################################
244 # End HTTPProtocolParser package
245 # ###########################################################################
Something went wrong with that request. Please try again.