use strict; use warnings; use Plack::Builder; use Plack::App::File; use Plack::Request; use Plack::Util; use Plack::Middleware::CrossOrigin; use Socket; # Adjust these values to test how browsers respond to the different headers my $co_mw = Plack::Middleware::CrossOrigin->new( origins => '*', methods => '*', expose_headers => '*', max_age => 0, ); sub alt_addr { my $address = shift; if ($address =~ /^[\d.]+$/) { return gethostbyaddr(inet_aton($address), AF_INET); } else { no warnings; return ( eval { inet_ntoa(inet_aton($address)) } || $address ); } } builder { enable sub { my $app = shift; sub { my $env = shift; if ($env->{'psgi.multithread'} || $env->{'psgi.multiprocess'}) { return [401, ['Content-Type' => 'text/plain'], ['Unsupported server. Please use a single threaded, single process server.']]; } $app->($env); }; }; my $last_cors = ''; mount '/last_cors' => sub { my $out = $last_cors; $last_cors = ''; [200, ['Content-Type' => 'text/plain'], [$out]]; }; mount '/cors' => builder { my $main_app_run; enable sub { my $app = shift; sub { my $env = shift; my $req = Plack::Request->new($env); $main_app_run = undef; my $in_head = $req->headers; return Plack::Util::response_cb($app->($env), sub { my $res = shift; my $preflight = $req->method eq 'OPTIONS' && $in_head->header('Access-Control-Request-Method'); if ( $preflight ) { $last_cors .= "Preflight request:\n"; } else { $last_cors .= "Actual request:\n"; } if ( $main_app_run ) { $last_cors .= " Main Plack app run\n"; } $last_cors .= " Incoming:\n"; $last_cors .= sprintf " Method: %s\n", $req->method; if ( defined $in_head->header('Origin') ) { $last_cors .= sprintf " Origin: %s\n", $in_head->header('Origin'); } $in_head->scan( sub { my ($k, $v) = @_; return unless $k =~ /^Access-Control/i; $k =~ s/\b(\w)(\w+)\b/\u$1\L$2/g; $last_cors .= sprintf " %s: %s\n", $k, $v; } ); $last_cors .= " Response:\n"; $last_cors .= sprintf " Status code: %s\n", $res->[0]; my %out_headers = @{ $res->[1] }; my @cors_headers = grep { /^Access-Control/i } keys %out_headers; for my $header (@cors_headers) { for my $value (Plack::Util::header_get($res->[1], $header)) { $last_cors .= sprintf " %-30s: %s\n", $header, $value; } } my $will_browser_see = !( $preflight || ( $in_head->header('Origin') && ! @cors_headers) ); if ($will_browser_see) { $res->[2] = [$last_cors]; $last_cors = ''; } }); }; }; enable sub { $co_mw->wrap($_[0]) }; sub { $main_app_run = 1; [ 200, ['X-Some-Other-Header' => 1, 'Content-Type' => 'text/plain'], [ 'output' ] ] }; }; mount '/' => sub { my $env = shift; my $req = Plack::Request->new($env); my $cors = $req->base; $cors->host(alt_addr($cors->host)); $cors->path($cors->path . 'cors'); my $last_cors_url = $req->base; $last_cors_url->path($last_cors_url->path . 'last_cors'); return [ 200, ['Content-Type' => 'text/html'], [ sprintf <<'END_HTML', $cors->scheme, $cors->host_port, $cors->path_query, $last_cors_url ] ]; CORS Test
Requesting from %s://%s
Request Type :
Headers

Result Status:
Results:
END_HTML }; };