File Coverage

blib/lib/Plack/Middleware/PeriAHS/ParseRequest.pm
Criterion Covered Total %
statement 196 235 83.4
branch 75 134 55.9
condition 76 135 56.3
subroutine 18 20 90.0
pod 2 3 66.6
total 367 527 69.6


line stmt bran cond sub pod time code
1             package Plack::Middleware::PeriAHS::ParseRequest;
2              
3             our $DATE = '2017-07-10'; # DATE
4             our $VERSION = '0.61'; # VERSION
5              
6 2     2   1495 use 5.010;
  2         6  
7 2     2   10 use strict;
  2         4  
  2         34  
8 2     2   8 use warnings;
  2         4  
  2         48  
9 2     2   5888 use Log::ger;
  2         194  
  2         13  
10              
11 2     2   2845 use Perinci::AccessUtil qw(insert_riap_stuffs_to_res decode_args_in_riap_req);
  2         3164  
  2         120  
12 2     2   745 use Perinci::Access::Base::Patch::PeriAHS;
  2         7  
  2         22  
13              
14 2     2   8081 use parent qw(Plack::Middleware);
  2         5  
  2         15  
15 2     2   982 use Plack::Request;
  2         97362  
  2         94  
16 2         22 use Plack::Util::Accessor qw(
17             riap_uri_prefix
18             server_host
19             server_port
20             server_path
21              
22             match_uri
23             match_uri_errmsg
24             parse_form
25             parse_reform
26             parse_path_info
27             accept_yaml
28              
29             riap_client
30             use_tx
31             custom_tx_manager
32              
33             php_clients_ua_re
34             deconfuse_php_clients
35 2     2   18 );
  2         5  
36              
37 2     2   1372 use Perinci::Access::Schemeless;
  2         37554  
  2         89  
38 2     2   1224 use Perinci::Sub::GetArgs::Array qw(get_args_from_array);
  2         1281  
  2         133  
39 2     2   800 use Plack::Util::PeriAHS qw(errpage);
  2         6  
  2         105  
40 2     2   14 use Scalar::Util qw(blessed);
  2         6  
  2         74  
41 2     2   12 use URI::Escape;
  2         4  
  2         4656  
42              
43             # retun ($success?, $errmsg, $res)
44             sub __parse_json {
45 22     22   2517 require Data::Clean::FromJSON;
46 22         3702 require JSON::MaybeXS;
47              
48 22         74 my $str = shift;
49              
50 22         68 state $json = JSON::MaybeXS->new->allow_nonref;
51              
52             # to rid of those JSON::XS::Boolean objects which currently choke
53             # Data::Sah-generated validator code. in the future Data::Sah can be
54             # modified to handle those, or we use a fork of JSON::XS which doesn't
55             # produce those in the first place (probably only when performance is
56             # critical).
57 22         92 state $cleanser = Data::Clean::FromJSON->get_cleanser;
58              
59 22         1797 my $res;
60 22         61 eval { $res = $json->decode($str); $cleanser->clean_in_place($res) };
  22         292  
  19         141  
61 22         1576 my $e = $@;
62 22         126 return (!$e, $e, $res);
63             }
64              
65             sub __parse_yaml {
66 1     1   900 require YAML::Syck;
67              
68 1         1738 my $str = shift;
69              
70 1         3 local $YAML::Syck::ImplicitTyping = 1;
71 1         2 my $res;
72 1         3 eval { $res = YAML::Syck::Load($str) };
  1         4  
73 1         87 my $e = $@;
74 1         8 return (!$e, $e, $res);
75             }
76              
77             sub get_server_url {
78 0     0 0 0 my ($self, $env) = @_;
79 0         0 my $host = $self->{server_host};
80 0 0       0 unless (defined $host) {
81 0 0       0 $host = $env->{HTTP_HOST} =~ /(.+):(.+)/ ? $1 : $env->{HTTP_HOST};
82             }
83 0         0 my $port = $self->{server_port};
84 0 0       0 unless (defined $port) {
85             $port = $env->{HTTP_HOST} =~ /(.+):(.+)/ ? $2 :
86 0 0       0 ($env->{HTTPS} ? 443 : 80);
    0          
87             }
88             join("",
89             ($env->{HTTPS} ? "https" : "http"), "://",
90             $host,
91             $port == ($env->{HTTPS} ? 443:80) ? "" : ":$port",
92             $self->{server_path},
93 0 0       0 "/",
    0          
    0          
94             );
95             }
96              
97             sub prepare_app {
98 8     8 1 53831 my $self = shift;
99              
100 8   50     93 $self->{riap_uri_prefix} //= '';
101 8   50     45 $self->{server_host} //= undef;
102 8   50     40 $self->{server_port} //= undef;
103 8   50     52 $self->{server_path} //= '/api';
104 8         24 $self->{server_path} =~ s!/\z!!;
105             $self->{get_http_request_url} //= sub {
106 0     0   0 my ($self, $env, $rreq) = @_;
107 0         0 my $uri = $rreq->{uri};
108 0 0 0     0 return unless $uri =~ m!^/! || $uri =~ s/^pl://;
109 0         0 $uri =~ s/\A\Q$self->{riap_uri_prefix}\E//;
110 0         0 $uri =~ s!^/!!;
111 0         0 join("",
112             $self->get_server_url($env),
113             $uri
114             );
115 8   50     70 };
116              
117 8   66     38 $self->{match_uri} //= qr/(?<uri>[^?]*)/;
118 8   100     38 $self->{accept_yaml} //= 0;
119 8   100     36 $self->{parse_form} //= 1;
120 8   50     37 $self->{parse_reform} //= 0;
121 8   100     34 $self->{parse_path_info} //= 0;
122 8   50     37 $self->{use_tx} //= 0;
123 8   50     39 $self->{custom_tx_manager} //= undef;
124              
125             $self->{riap_client} //= Perinci::Access::Schemeless->new(
126             load => 0,
127             set_function_properties => {
128             #timeout => 300,
129             },
130             use_tx => $self->{use_tx},
131             custom_tx_manager => $self->{custom_tx_manager},
132 8   33     85 );
133              
134 8   66     2023 $self->{php_clients_ua_re} //= qr(Phinci|/php|php/)i;
135 8   100     47 $self->{deconfuse_php_clients} //= 1;
136              
137 8         27 log_trace("Prepared PeriAHS::ParseRequest middleware: %s", $self);
138             }
139              
140             sub call {
141 33     33 1 292386 my ($self, $env) = @_;
142 33         200 log_trace("=> PeriAHS::ParseRequest middleware");
143              
144 33   50     308 my $rreq = $env->{"riap.request"} //= {};
145              
146             # put Riap client for later phases
147 33         196 $env->{"periahs.riap_client"} = $self->{riap_client};
148              
149             # first determine the default output format (fmt), so we can return error
150             # page in that format
151 33   100     191 my $acp = $env->{HTTP_ACCEPT} // "";
152 33   100     162 my $ua = $env->{HTTP_USER_AGENT} // "";
153 33         65 my $fmt;
154 33 50       255 if ($acp =~ m!^text/(?:x-)?yaml$!) {
    50          
    50          
    100          
    50          
155 0         0 $fmt = "yaml";
156             } elsif ($acp eq 'application/json') {
157 0         0 $fmt = "json";
158             } elsif ($acp eq 'text/plain') {
159 0         0 $fmt = "text";
160             } elsif ($ua =~ m!Wget/|curl/!) {
161 1         4 $fmt = "text";
162             } elsif ($ua =~ m!Mozilla/!) {
163 0         0 $fmt = "json";
164             # XXX enable json->html templating
165             } else {
166 32         97 $fmt = "json";
167             }
168 33         96 $env->{"periahs.default_fmt"} = $fmt;
169              
170 33         99 my ($decsuc, $decerr); # json/yaml decoding success status & error message
171              
172             # parse Riap request keys from HTTP headers (required by spec)
173 33         251 for my $k0 (keys %$env) {
174 853 100       2207 next unless $k0 =~ /\AHTTP_X_RIAP_(.+?)(_J_)?\z/;
175 29         93 my $v = $env->{$k0};
176 29         147 my ($k, $encj) = (lc($1), $2);
177             # already ensured by Plack
178             #$k =~ /\A\w+\z/ or return errpage(
179             # $env, [400, "Invalid Riap request key syntax in HTTP header $k0"]);
180 29 100       103 if ($encj) {
181 15         73 ($decsuc, $decerr, $v) = __parse_json($v);
182 15 100       86 return errpage(
183             $env, [400, "Invalid JSON in HTTP header $k0: $decerr"])
184             if !$decsuc;
185             }
186 28         106 $rreq->{$k} = $v;
187             }
188              
189             # parse args from request body (required by spec)
190 32         345 my $preq = Plack::Request->new($env);
191 32 100       474 unless (exists $rreq->{args}) {
192             {
193 19         44 my $ct = $env->{CONTENT_TYPE};
  19         41  
194 19 100       59 last unless $ct;
195 7 50       20 last if $ct eq 'application/x-www-form-urlencoded';
196             return errpage(
197             $env, [400, "Unsupported request content type '$ct'"])
198             unless $ct eq 'application/json' ||
199 7 100 100     77 $ct eq 'text/yaml' && $self->{accept_yaml};
      100        
200 5 100       17 if ($ct eq 'application/json') {
    50          
201             #$log->trace('Request body is JSON');
202 4         32 ($decsuc,$decerr, $rreq->{args}) = __parse_json($preq->content);
203 4 100       23 return errpage(
204             $env, [400, "Invalid JSON in request body: $decerr"])
205             if !$decsuc;
206             #} elsif ($ct eq 'application/vnd.php.serialized') {
207             # #$log->trace('Request body is PHP serialized');
208             # request PHP::Serialization;
209             # eval { $args = PHP::Serialization::unserialize($body) };
210             # return errpage(
211             # $env, [400, "Invalid PHP serialized data in request body"])
212             # if $@;
213             } elsif ($ct eq 'text/yaml') {
214 1         5 ($decsuc,$decerr, $rreq->{args}) = __parse_yaml($preq->content);
215 1 50       8 return errpage(
216             $env, [400, "Invalid YAML in request body: $decerr"])
217             if !$decsuc;
218             }
219             }
220             }
221              
222             # special handling for php clients #1
223 29         88 my $rcua = $rreq->{ua};
224 29 100 100     395 if ($self->{deconfuse_php_clients} &&
      100        
225             $rcua && $rcua =~ $self->{php_clients_ua_re}) {
226 9 100 100     73 if (ref($rreq->{args}) eq 'ARRAY' && !@{ $rreq->{args} }) {
  2         9  
227 1         3 $rreq->{args} = {};
228             }
229             }
230              
231             return errpage(
232             $env, [400, "Riap request key 'args' must be hash"])
233 29 100 100     213 unless !defined($rreq->{args}) || ref($rreq->{args}) eq 'HASH'; # sanity
234              
235             # get uri from 'match_uri' config
236 25         92 my $mu = $self->{match_uri};
237 25 100 66     151 if ($mu && !exists($rreq->{uri})) {
238 24         72 my $uri = $env->{REQUEST_URI};
239 24         53 my %m;
240 24 100       90 if (ref($mu) eq 'ARRAY') {
241             $uri =~ $mu->[0] or return errpage(
242             $env, [404, $self->{match_uri_errmsg} //
243 3 50 0     27 "Request does not match match_uri[0] $mu->[0]"]);
244 3         36 %m = %+;
245 3         15 $mu->[1]->($env, \%m);
246             } else {
247             $uri =~ $mu or return errpage(
248             $env, [404, $self->{match_uri_errmsg} //
249 21 100 33     230 "Request does not match match_uri $mu"]);
250 19         386 %m = %+;
251 19         96 for (keys %m) {
252 19   33     133 $rreq->{$_} //= $m{$_};
253             }
254             }
255 22 50       124 if (defined $rreq->{uri}) {
256 22         195 $rreq->{uri} =~ s!\A\Q$self->{server_path}!!;
257             }
258             }
259              
260             # get riap request key from form variables (optional)
261 23 100       105 if ($self->{parse_form}) {
262 22         134 my $form = $preq->parameters;
263 22         4081 $env->{'periahs._form_cache'} = $form;
264              
265             # special name 'callback' is for jsonp
266 22 50 33     252 if (($rreq->{fmt} // $env->{"periahs.default_fmt"}) eq 'json' &&
      33        
267             defined($form->{callback})) {
268             return errpage(
269             $env, [400, "Invalid callback syntax, please use ".
270             "a valid JS identifier"])
271 0 0       0 unless $form->{callback} =~ /\A[A-Za-z_]\w*\z/;
272 0         0 $env->{"periahs.jsonp_callback"} = $form->{callback};
273 0         0 delete $form->{callback};
274             }
275              
276 22         153 while (my ($k, $v) = each %$form) {
277 13 100       58 if ($k =~ /(.+):j$/) {
    50          
278 3         28 $k = $1;
279             #$log->trace("CGI parameter $k (json)=$v");
280 3         16 ($decsuc, $decerr, $v) = __parse_json($v);
281 3 100       16 return errpage(
282             $env, [400, "Invalid JSON in query parameter $k: $decerr"])
283             if !$decsuc;
284             } elsif ($k =~ /(.+):y$/) {
285 0         0 $k = $1;
286             #$log->trace("CGI parameter $k (yaml)=$v");
287             return errpage($env, [400, "YAML form variable unacceptable"])
288 0 0       0 unless $self->{accept_yaml};
289 0         0 ($decsuc, $decerr, $v) = __parse_yaml($v);
290 0 0       0 return errpage(
291             $env, [400, "Invalid YAML in query parameter $k: $decerr"])
292             if !$decsuc;
293             #} elsif ($k =~ /(.+):p$/) {
294             # $k = $1;
295             # #$log->trace("PHP serialized parameter $k (php)=$v");
296             # return errpage($env, [400, "PHP serialized form variable ".
297             # "unacceptable"])
298             # unless $self->{accept_phps};
299             # require PHP::Serialization;
300             # eval { $v = PHP::Serialization::unserialize($v) };
301             # return errpage(
302             # $env, [400, "Invalid PHP serialized data in ".
303             # "query parameter $k: $@") if $@;
304             }
305 12 100       45 if ($k =~ /\A-riap-([\w-]+)/) {
306 4         13 my $rk = lc $1; $rk =~ s/-/_/g;
  4         10  
307 4 50       16 return errpage(
308             $env, [400, "Invalid Riap request key `$rk` (from form)"])
309             unless $rk =~ /\A\w+\z/;
310 4 100       23 $rreq->{$rk} = $v unless exists $rreq->{$rk};
311             } else {
312 8 100       47 $rreq->{args}{$k} = $v unless exists $rreq->{args}{$k};
313             }
314             }
315             }
316              
317 22 0 33     106 if ($self->{parse_reform} && $env->{'periahs._form_cache'} &&
      0        
318             $env->{'periahs._form_cache'}{'-submit'}) {
319             {
320 0 0       0 last unless $rreq->{uri};
  0         0  
321             my $res = $env->{'periahs._meta_res_cache'} //
322 0   0     0 $self->{riap_client}->request(meta => $rreq->{uri});
323 0 0       0 return errpage($env, [$res->[0], $res->[1]])
324             unless $res->[0] == 200;
325 0   0     0 $env->{'periahs._meta_res_cache'} //= $res;
326 0         0 my $meta = $res->[2];
327 0 0       0 last unless $meta;
328 0 0       0 last unless $meta->{args};
329              
330 0         0 require ReForm::HTML;
331 0         0 require Perinci::Sub::To::ReForm;
332 0         0 my $rf = ReForm::HTML->new(
333             spec => Perinci::Sub::To::ReForm::gen_form_spec_from_rinci_meta(
334             meta => $meta,
335             )
336             );
337 0         0 $res = $rf->get_data(psgi_env => $env);
338 0 0       0 return errpage($env, [$res->[0], $res->[1]])
339             unless $res->[0] == 200;
340 0         0 $rreq->{args} = $res->[2];
341             }
342             }
343              
344 22 100       98 if ($self->{parse_path_info}) {
345             {
346 1 50       3 last unless $rreq->{uri};
  1         4  
347             my $res = $env->{'periahs._meta_res_cache'} //
348 1   33     13 $self->{riap_client}->request(meta => $rreq->{uri});
349 1 50       4903 return errpage($env, [$res->[0], $res->[1]])
350             unless $res->[0] == 200;
351 1   33     7 $env->{'periahs._meta_res_cache'} //= $res;
352 1         2 my $meta = $res->[2];
353 1 50       4 last unless $meta;
354 1 50       3 last unless $meta->{args};
355              
356 1   50     4 my $pi = $env->{PATH_INFO} // "";
357 1         5 $pi =~ s!^/+!!;
358 1         6 my @pi = map {uri_unescape($_)} split m!/+!, $pi;
  2         19  
359 1         17 $res = get_args_from_array(array=>\@pi, meta=>$meta);
360 1 50       494 return errpage(
361             $env, [500, "Bad metadata for function $rreq->{uri}: ".
362             "Can't get arguments: $res->[0] - $res->[1]"])
363             unless $res->[0] == 200;
364 1         3 for my $k (keys %{$res->[2]}) {
  1         3  
365 2   33     11 $rreq->{args}{$k} //= $res->[2]{$k};
366             }
367             }
368             }
369              
370             # defaults
371 22   50     162 $rreq->{v} //= 1.1;
372 22   66     160 $rreq->{fmt} //= $env->{"periahs.default_fmt"};
373 22 50       90 if (!$rreq->{action}) {
374 22 100       105 if ($rreq->{uri} =~ m!/$!) {
375 2         7 $rreq->{action} = 'list';
376 2   50     11 $rreq->{detail} //= 1;
377             } else {
378 20         87 $rreq->{action} = 'call';
379             }
380             }
381              
382             # sanity: check required keys
383 22         74 for (qw/uri v action/) {
384 66 50       211 defined($rreq->{$_}) or return errpage(
385             $env, [500, "Required Riap request key '$_' has not been defined"]);
386             }
387              
388             # add uri prefix
389 22         103 $rreq->{uri} = "$self->{riap_uri_prefix}$rreq->{uri}";
390              
391             # special handling for php clients #2
392             {
393 22         64 last unless $self->{deconfuse_php_clients} &&
394 22 100 66     258 $rcua && $rcua =~ $self->{php_clients_ua_re};
      66        
395 8         42 my $rargs = $rreq->{args};
396 8 50       38 last unless $rargs;
397              
398             # XXX this is repetitive, must refactor
399             my $res = $env->{'periahs._meta_res_cache'} //
400 8   33     399 $self->{riap_client}->request(meta => $rreq->{uri});
401 8 50       3452 return errpage($env, [$res->[0], $res->[1]])
402             unless $res->[0] == 200;
403 8   33     83 $env->{'periahs._meta_res_cache'} //= $res;
404 8         28 my $meta = $res->[2];
405              
406 8 50       42 if ($meta->{args}) {
407 8         52 for my $arg (keys %$rargs) {
408 7         28 my $argm = $meta->{args}{$arg};
409 7 100 66     71 if ($argm && $argm->{schema}) {
410             # convert {} -> [] if function expects array
411 4 50 66     31 if (ref($rargs->{$arg}) eq 'HASH' &&
      66        
412 1         13 !keys(%{$rargs->{$arg}}) &&
413             $argm->{schema}[0] eq 'array') {
414 1         5 $rargs->{$arg} = [];
415             }
416             # convert [] -> {} if function expects hash
417 4 100 66     34 if (ref($rargs->{$arg}) eq 'ARRAY' &&
      100        
418 2         26 !@{$rargs->{$arg}} &&
419             $argm->{schema}[0] eq 'hash') {
420 1         8 $rargs->{$arg} = {};
421             }
422             }
423             }
424             }
425             }
426              
427             # Riap 1.2: decode base64-encoded args
428 22         160 decode_args_in_riap_req($rreq);
429              
430 22         306 log_trace("Riap request: %s", $rreq);
431              
432             # expose configuration for other middlewares
433 22         110 $env->{"middleware.PeriAHS.ParseRequest"} = $self;
434              
435             # continue to app
436 22         143 $self->app->($env);
437             }
438              
439             1;
440             # ABSTRACT: Parse Riap request from HTTP request
441              
442             __END__
443              
444             =pod
445              
446             =encoding UTF-8
447              
448             =head1 NAME
449              
450             Plack::Middleware::PeriAHS::ParseRequest - Parse Riap request from HTTP request
451              
452             =head1 VERSION
453              
454             This document describes version 0.61 of Plack::Middleware::PeriAHS::ParseRequest (from Perl distribution Perinci-Access-HTTP-Server), released on 2017-07-10.
455              
456             =head1 SYNOPSIS
457              
458             # in your app.psgi
459             use Plack::Builder;
460              
461             builder {
462             enable "PeriAHS::ParseRequest",
463             match_uri => m!^/api(?<uri>/[^?]*)!;
464             };
465              
466             =head1 DESCRIPTION
467              
468             This middleware's task is to parse Riap request from HTTP request (PSGI
469             environment) and should normally be the first middleware put in the stack.
470              
471             =head2 Parsing result
472              
473             The result of parsing will be put in C<< $env->{"riap.request"} >> hashref.
474              
475             Aside from that, this middleware also sets these for convenience of later
476             middlewares:
477              
478             =over 4
479              
480             =item * $env->{'periahs.default_fmt'} => STR
481              
482             Default output format, will be used for response if C<fmt> is not specified in
483             Rinci request. Determined using some simple heuristics, i.e. graphical browser
484             like Firefox or Chrome will get 'HTML', command-line browser like Wget or Curl
485             will get 'Text', others will get 'json'.
486              
487             =item * $env->{'periahs.jsonp_callback'} => STR
488              
489             From form variable C<callback>.
490              
491             =item * $env->{'periahs.riap_client'} => OBJ
492              
493             Store the Riap client (by default instance of L<Perinci::Access::Schemeless>).
494              
495             =back
496              
497             =head2 Parsing process
498              
499             B<From HTTP header and request body>. First parsing is done as per L<Riap::HTTP>
500             specification's requirement. All C<X-Riap-*> request headers are parsed for Riap
501             request key. When an unknown header is found, HTTP 400 error is returned. Then,
502             request body is read for C<args>. C<application/json> document type is accepted,
503             and also C<text/yaml> (if C<accept_yaml> configuration is enabled).
504              
505             Additionally, the following are also done:
506              
507             B<From URI>. Request URI is checked against B<match_uri> configuration (This
508             step will be skipped if B<match_uri> configuration is not set or empty). If URI
509             doesn't match this regex, a 404 error response is returned. It is a convenient
510             way to check for valid URLs as well as set Riap request keys, like:
511              
512             qr!^/api/(?<fmt>json|yaml)/!;
513              
514             The default C<match_uri> is qr/(?<uri>[^?]*)/.
515              
516             B<From form variables>. If B<parse_form> configuration is enabled, C<args>
517             request key will be set (or added) from GET/POST request variables, for example:
518             http://host/api/foo/bar?a=1&b:j=[2] will set arguments C<a> and C<b> (":j"
519             suffix means value is JSON-encoded; ":y" is also accepted if the C<accept_yaml>
520             configurations are enabled). In addition, request variables C<-riap-*> are also
521             accepted for setting other Riap request keys. Unknown Riap request key or
522             encoding suffix will result in 400 error.
523              
524             If request format is JSON and form variable C<callback> is defined, then it is
525             assumed to specify callback for JSONP instead part of C<args>. "callback(json)"
526             will be returned instead of just "json".
527              
528             B<From form variables (2, ReForm)>. PeriAHS has support for L<ReForm>. If
529             B<parse_reform> configuration is set to true and form variable C<-submit> is
530             also set to true, then the resulting C<args> from previous step will be further
531             fed to ReForm object. See the "parse_reform" in the configuration documentation.
532              
533             C<From URI (2, path info)>. If C<parse_path_info> configuration is enabled, and
534             C<uri> Riap request key has been set (so metadata can be retrieved), C<args>
535             will be set (or added) from URI path info. See "parse_path_info" in the
536             configuration documentation.
537              
538             http://host/api/v1/Module::Sub/func/a1/a2/a3
539              
540             will result in ['a1', 'a2', 'a3'] being fed into
541             L<Perinci::Sub::GetArgs::Array>. An unsuccessful parsing will result in HTTP 400
542             error.
543              
544             =for Pod::Coverage .*
545              
546             =head1 CONFIGURATIONS
547              
548             =over 4
549              
550             =item * riap_uri_prefix => STR (default: '')
551              
552             If set, Riap request C<uri> will be prefixed by this. For example, you are
553             exposing Perl modules at C<YourApp::API::*> (e.g. C<YourApp::API::Module1>. You
554             want to access this module via Riap request uri C</Module1/func> instead of
555             C</YourApp/API/Module1/func>. In that case, you can set B<riap_uri_prefix> to
556             C</YourApp/API/> (notice the ending slash).
557              
558             =item * server_host => STR
559              
560             Set server host. Used by B<get_http_request_url>. The default will be retrieved
561             from PSGI environment C<HTTP_HOST>.
562              
563             =item * server_port => STR
564              
565             Set server port. Used by B<get_http_request_url>. The default will be retrieved
566             from PSGI environment C<HTTP_HOST>.
567              
568             =item * server_path => STR (default: '/api')
569              
570             Set server URI path. Used by C<get_http_request_url>.
571              
572             =item * get_http_request_url => CODE (default: code)
573              
574             Should be set to code that returns HTTP request URL. Code will be passed
575             C<($self, $env, $rreq)>, where C<$rreq> is the Riap request hash. The default
576             code will return something like:
577              
578             http(s)://<SERVER_HOST>:<SERVER_PORT><SERVER_PATH><RIAP_REQUEST_URI>
579              
580             for example:
581              
582             https://cpanlists.org/api/get_list
583              
584             This code is currently used by the B<PeriAHS::Respond> middleware to print
585             text hints.
586              
587             Usually you do not need to customize this, you can already do some customization
588             by setting B<server_path> or B<riap_uri_prefix>, unless you have a more custom
589             URL scheme.
590              
591             =item * match_uri => REGEX or [REGEX, CODE] (default qr/.?/)
592              
593             This provides an easy way to extract Riap request keys (typically C<uri>) from
594             HTTP request's URI. Put named captures inside the regex and it will set the
595             corresponding Riap request keys, e.g.:
596              
597             qr!^/api(?<uri>/[^?]*)!
598              
599             If you need to do some processing, you can also specify a 2-element array
600             containing regex and code. When supplied this, the middleware will NOT
601             automatically set Riap request keys with the named captures; instead, your code
602             should do it. Code will be supplied ($env, \%match) and should set
603             $env->{'riap.request'} as needed. An example:
604              
605             match_uri => [
606             qr!^/api
607             (?: /(?<module>[\w.]+)?
608             (?: /(?<func>[\w+]+) )?
609             )?!x,
610             sub {
611             my ($env, $match) = @_;
612             if (defined $match->{module}) {
613             $match->{module} =~ s!\.!/!g;
614             $env->{'riap.request'}{uri} = "/$match->{module}/" .
615             ($match->{func} // "");
616             }
617             }];
618              
619             Given URI C</api/Foo.Bar/baz>, C<uri> Riap request key will be set to
620             C</Foo/Bar/baz>.
621              
622             =item * match_uri_errmsg => STR
623              
624             Show custom error message when URI does not match C<match_uri>.
625              
626             =item * accept_yaml => BOOL (default 0)
627              
628             Whether to accept YAML-encoded data in HTTP request body and form for C<args>
629             Riap request key. If you only want to deal with JSON, keep this off.
630              
631             =item * parse_form => BOOL (default 1)
632              
633             Whether to parse C<args> keys and Riap request keys from form (GET/POST)
634             variable of the name C<-x-riap-*> (notice the prefix dash). If an argument is
635             already defined (e.g. from request body) or request key is already defined (e.g.
636             from C<X-Riap-*> HTTP request header), it will be skipped.
637              
638             =item * parse_reform => BOOL (default 0)
639              
640             Whether to parse arguments in C<args> request key using L<ReForm>. Even if
641             enabled, will only be done if C<-submit> form variable is set to true.
642              
643             This configuration is used only if you render forms using ReForm and want to
644             process the submitted form.
645              
646             Form specification will be created (converted) from C<args> property in function
647             metadata, which means that a C<meta> Riap request to the backend will be
648             performed first to get this metadata.
649              
650             =item * parse_path_info => BOOL (default 0)
651              
652             Whether to parse arguments from $env->{PATH_INFO}. Note that this will require a
653             Riap C<meta> request to the backend, to get the specification for function
654             arguments. You'll also most of the time need to prepare the PATH_INFO first.
655             Example:
656              
657             parse_path_info => 1,
658             match_uri => [
659             qr!^/ga/(?<mod>[^?/]+)(?:
660             /?(?:
661             (?<func>[^?/]+)?:
662             (<pi>/?[^?]*)
663             )
664             )!x,
665             sub {
666             my ($env, $m) = @_;
667             $m->{mod} =~ s!::!/!g;
668             $m->{func} //= "";
669             $env->{'riap.request'}{uri} = "/$m->{mod}/$m->{func}";
670             $env->{PATH_INFO} = $m->{pi};
671             },
672             ]
673              
674             =item * riap_client => OBJ
675              
676             By default, a L<Perinci::Access::Schemeless> object will be instantiated (and
677             later put into C<$env->{'periahs.riap_client'}> for the next middlewares) to
678             perform Riap requests. You can supply a custom object here, for example the more
679             general L<Perinci::Access> object to allow requesting from remote URLs.
680              
681             =item * use_tx => BOOL (default 0)
682              
683             Will be passed to L<Perinci::Access::Schemeless> constructor.
684              
685             =item * custom_tx_manager => STR|CODE
686              
687             Will be passed to L<Perinci::Access::Schemeless> constructor.
688              
689             =item * php_clients_ua_re => REGEX (default: qr(Phinci|/php|php/)i)
690              
691             What regex should be used to identify PHP Riap clients. Riap clients often
692             (should) send C<ua> key identifying itself, e.g. C<Phinci/20130308.1>,
693             C<Perinci/0.12>, etc.
694              
695             =item * deconfuse_php_clients => BOOL (default: 1)
696              
697             Whether to do special handling for PHP Riap clients (identified by
698             C<php_clients_ua_re>). PHP clients often confuse empty array C<[]> with empty
699             hash C<{}>, since both are C<Array()> in PHP. If this setting is turned on, the
700             server makes sure C<args> becomes C<{}> when client sends C<[]>, and C<{}>
701             arguments become C<[]> or vice versa according to hint provided by function
702             metadata.
703              
704             =back
705              
706             =head1 HOMEPAGE
707              
708             Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Access-HTTP-Server>.
709              
710             =head1 SOURCE
711              
712             Source repository is at L<https://github.com/perlancar/perl-Perinci-Access-HTTP-Server>.
713              
714             =head1 BUGS
715              
716             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-Access-HTTP-Server>
717              
718             When submitting a bug or request, please include a test-file or a
719             patch to an existing test-file that illustrates the bug or desired
720             feature.
721              
722             =head1 SEE ALSO
723              
724             L<Perinci::Access::HTTP::Server>
725              
726             =head1 AUTHOR
727              
728             perlancar <perlancar@cpan.org>
729              
730             =head1 COPYRIGHT AND LICENSE
731              
732             This software is copyright (c) 2017, 2015, 2014, 2013, 2012, 2011 by perlancar@cpan.org.
733              
734             This is free software; you can redistribute it and/or modify it under
735             the same terms as the Perl 5 programming language system itself.
736              
737             =cut