root/trunk/lib/Mungo/Request.pm

Revision 44, 8.6 kB (checked in by clinton, 5 years ago)

Fix to allow multi-valued query-string parameters

Line 
1 package Mungo::Request;
2
3 # Copyright (c) 2007 OmniTI Computer Consulting, Inc. All rights reserved.
4 # For information on licensing see:
5 #   https://labs.omniti.com/zetaback/trunk/LICENSE
6
7 use strict;
8 use Mungo::Cookie;
9 use Mungo::MultipartFormData;
10 eval "use APR::Table;";
11 our $AUTOLOAD;
12
13 =head1 NAME
14
15 Mungo::Request - represent an HTTP request context
16
17 =head1 SYNOPSIS
18
19   <!-- Within your HTML, you get a Request object for free -->
20   <% if (defined $Request) { ... } %>
21
22   <!-- Get params -->
23   <%
24      my $value = $Request->Params('param_name');
25      my %params = $Request->Params();
26   %>
27
28   <!-- Get Request Info -->
29   <%
30      my $refer = $Request->ServerVariables('REFERER');
31      my $refer = $Request->ServerVariables('REFERRER'); # Same
32      my $server_hostname = $Request->ServerVariables('HTTP_HOST');
33      my $client_ip = $Request->ServerVariables('REMOTE_IP'); # If proxied, uses HTTP_X_FORWARDED_FOR.
34
35      my $header = $Request->Header('HeaderName');
36
37   %>
38
39   <!-- Get cookies -->
40   <%
41      # for single-valued cookies
42      my $value = $Request->Cookies($cookie_name);
43
44      # for multi-valued cookies
45      my $hashref = $Request->Cookies($cookie_name);
46
47      # for multi-valued cookies
48      my $value = $Request->Cookies($cookie_name, $key);
49
50   %>
51
52 =head1 DESCRIPTION
53
54 Represents the request side of a Mungo request cycle.
55
56 See Mungo, and Mungo::Request.
57
58 =cut
59
60
61 sub new {
62   my $class = shift;
63   my $parent = shift;
64   my $r = $parent->{'Apache::Request'};
65   my $singleton = $r->pnotes(__PACKAGE__);
66   return $singleton if ($singleton);
67   my %core_data = (
68     'Apache::Request' => $r,
69     'Method' => $r->method,
70     'Mungo' => $parent,
71   );
72   my $cl = $r->can('headers_in') ? $r->headers_in->get('Content-length') :
73                                    $r->header_in('Content-length');
74   my $ct = $r->can('headers_in') ? $r->headers_in->get('Content-Type') :
75                                    $r->header_in('Content-Type');
76   if($r->method eq 'POST' && $cl) {
77     $core_data{TotalBytes} = $cl;
78     if($ct =~ /^multipart\/form-data             # multipart form data
79                \s*;\s*                           # followed by a
80                boundary=\"?([^\";,]+)\"?/x) {    # boundary phrase
81       my $boundary = $1;
82       $core_data{multipart_form} =
83         Mungo::MultipartFormData->new($r, $cl, $boundary);
84     }
85     elsif($ct =~ /^application\/x-www-form-urlencoded\s*(?:;.*)?/) {
86       $r->read($core_data{'form_content'}, $core_data{TotalBytes});
87     }
88   }
89   my %data;
90   $singleton = bless \%data, $class;
91   tie %data, 'Mungo::Arbiter::Response', $singleton, \%core_data;
92   $singleton->{Buffer} = $r->dir_config('MungoBuffer') || 0;
93   $r->pnotes(__PACKAGE__, $singleton);
94   return $singleton;
95 }
96
97 sub DESTROY {
98   my $self = shift;
99   $self->cleanse();
100 }
101
102 sub cleanse {
103   my $self = shift;
104   delete $self->{$_} for keys %$self;
105   untie %$self if tied %$self;
106 }
107
108 =head2 $value = $Request->Cookies($cookie_name);
109
110 =head2 $hashref = $Request->Cookies($cookie_name);
111
112 =head2 $value = $Request->Cookies($cookie_name, $key);
113
114 Reads and parses incoming cookie data.  Behavior depends on whether
115 the cookie contained name-value pairs.
116
117 If not, the first form simply returns the value set in the given cookie name, or undef.
118
119 If name-value pairs are present, the second form returns a hashref of all the name-value pairs.
120
121 If name-value pairs are present, the third form returns the value for the given key.
122
123 If no such cookie with the given name exists, returns undef.
124
125 =cut
126
127 sub Cookies {
128   my $self = shift;
129   my $cookie_class = 'Mungo::Cookie';
130   my $cookie = $self->{$cookie_class} ||= $cookie_class->new($self->{'Apache::Request'});
131   return $cookie->__get(@_);
132 }
133
134 =head2 $value = $Request->QueryString($name);
135
136 =head2 %params = $Request->QueryString();
137
138 =head2 $params_hashref = $Request->QueryString();
139
140 Returns one value (first form) or all values (second and third forms)
141 from the submitted query string.
142
143 Params() is preferred.
144
145 =cut
146
147 sub QueryString {
148   my $self = shift;
149   my $qs_string = $self->{'Mungo'}->{'Apache::Request'}->args;
150
151   my %params;
152   foreach my $kv_pair (split /&/, $qs_string) {
153       my ($k, $v) = split(/=/, $kv_pair, 2);
154
155       # $v = uri_unescape($v); # If CPAN dep on URI::Escape were allowed
156       $v =~ s/%([0-9a-f]{2})/chr(hex($1))/ige;
157       $v =~ s/\+/ /g;
158
159       if (exists($params{$k}) && ref($params{$k})) {
160           push @{$params{$k}}, $v;
161       } elsif (exists($params{$k})) {
162           $params{$k} = [ $params{$k}, $v];
163       } else {
164           $params{$k} = $v;
165       }
166   }
167   if (@_) {
168       return exists($params{$_[0]}) ? $params{$_[0]} : undef;
169   }
170   return %params if wantarray;
171   return \%params;
172 }
173
174 sub decode_form {
175   my $class = ref $_[0] ? ref $_[0] : $_[0];
176   my $form_content = $_[1];
177   my $form = {};
178   return $form unless($form_content);
179   foreach my $kv (split /[&;]/, $form_content) {
180     my($k, $v) = map { s/\+/ /g;
181                        s/%([0-9a-f]{2})/chr(hex($1))/ige;
182                        $_;
183                      } split(/=/, $kv, 2);
184     if(ref $form->{$k}) {
185       push @{$form->{$k}}, $v;
186     }
187     else {
188       $form->{$k} = exists($form->{$k}) ? [$form->{$k}, $v] : $v;
189     }
190   }
191   return $form;
192 }
193
194 =head2 $value = $Request->Form($name);
195
196 =head2 %params = $Request->Form();
197
198 =head2 $params_hashref = $Request->Form();
199
200 Returns one value (first form) or all values (second and third forms)
201 from the submitted POST data.
202
203 Params() is preferred.
204
205 =cut
206
207 sub Form {
208   my $self = shift;
209   my $form;
210   if(!$self->{form_content} && !$self->{multipart_form}) {
211     return undef if(@_);
212     return () if wantarray;
213     return {};
214   }
215   unless(exists $self->{Form}) {
216     $self->{Form} = $self->decode_form($self->{form_content})
217       if($self->{form_content});
218     $self->{Form} = $self->{multipart_form} if($self->{multipart_form});
219   }
220   $form = $self->{Form};
221   return exists($form->{$_[0]})?$form->{$_[0]}:undef if(@_);
222   return %$form if wantarray;
223   return $form;
224 }
225
226 =head2 $value = $Request->Params($name);
227
228 =head2 %params = $Request->Params();
229
230 =head2 $params_hashref = $Request->Params();
231
232 Returns one value (first form) or all values (second and third forms)
233 from the submitted CGI parameters, whether that was via the query string or via POST data.
234
235 This method is recommended over Form and QueryString, because it is independent
236 of how the data was submitted.
237
238 If both methods provide data, Form overrides QueryString.
239
240 =cut
241
242 sub Params {
243   my $self = shift;
244   return $self->Form($_[0]) || $self->QueryString($_[0]) if(@_);
245   my %base = $self->QueryString();
246   my $overlay = $self->Form();
247   while(my ($k, $v) = each %$overlay) {
248     $base{$k} = $v;
249   }
250   return %base if wantarray;
251   return \%base;
252 }
253
254 =head2 $value = $Request->ServerVariables($variable_name);
255
256 Returns information about the request or the server.  Only certain
257 variables are supported:
258
259   REFERER, REFERRER, DOCUMENT_ROOT, HTTP_HOST
260
261 =cut
262
263 sub ServerVariables {
264     my $self = shift;
265     my $var = shift;
266     if ($var eq 'DOCUMENT_ROOT') {
267         return $self->{'Mungo'}->{'Apache::Request'}->document_root;
268     }
269     elsif($var eq 'HTTP_HOST') {
270         return $self->{'Mungo'}->{'Apache::Request'}->hostname;
271     }
272     elsif( ($var eq 'REFERER') || ($var eq 'REFERRER') ) {
273         my $r = $self->{'Mungo'}->{'Apache::Request'};
274         return $r->can('headers_in') ? $r->headers_in->get('Referer') :
275                                        $r->header_in('Referer');
276     }
277     elsif ($var eq 'REMOTE_IP') {
278         # May be proxied, and we assume our local IP is a private IP if so.
279         # So look for the first non-private IP among the possible IPs.
280         my @possible_ips = @ENV{qw(HTTP_X_X_FORWARDED_FOR HTTP_X_FORWARDED_FOR REMOTE_ADDR)};
281
282         # May be a comma-separareted list, so break down into individual IPs if so.
283         my @single_ips = map { split(/,\s*/, $_) } @possible_ips;
284
285         # Eliminate private network IPs, which we assume to be the backside of a proxy server
286         my @not_private_ips = grep { $_ && $_ !~ /^127\.0\.0\.1|^192\.168\.|^10\./ } @single_ips;
287
288         # Return the first remaining address
289         return $not_private_ips[0];
290
291     }
292     return undef;
293 }
294
295 =head2 $value = $Request->Header('User-Agent');
296
297 Returns raw header information from the request header.
298
299 =cut
300
301 sub Header {
302     my $self = shift;
303     my $hname = shift;
304     my $r = $self->{'Mungo'}->{'Apache::Request'};
305     return $r->can('headers_in')
306       ? $r->headers_in->get($hname)
307         : $r->header_in($hname);
308 }
309
310 sub AUTOLOAD {
311   my $self = shift;
312   die unless(ref $self);
313   my $name = $AUTOLOAD;
314   $name =~ s/.*://;   # strip fully-qualified portion
315   die __PACKAGE__." does not implement $name";
316 }
317
318 =head1 AUTHOR
319
320 Theo Schlossnagle (code)
321
322 Clinton Wolfe (docs)
323
324
325 =cut
326
327 1;
Note: See TracBrowser for help on using the browser.