view release on metacpan or  search on metacpan

lib/Dancer/Plugin/CORS.pm  view on Meta::CPAN

	my @requested_headers = map { s{\s+}{}g; $_ } split /,+/, (scalar($request->header('Access-Control-Request-Headers')) || '');
	
	my ($ok, $i) = (0, 0);
	my ($headers, $xoptions);
	
	if (exists $routes->{$route}) {
		$path = "$route";
		debug "[CORS] dynamic route: $path" if DEBUG;
	} else {
		debug "[CORS] static route: $path" if DEBUG;
	}
	
	my $n = scalar @{$routes->{$path}};
	
	RULE: foreach my $options (@{$routes->{$path}}) {
		debug "[CORS] testing rule ".++$i." of $n" if DEBUG;
		if (DEBUG) {
			use Data::Dumper;
			debug Dumper($options);
		}
		$headers = {};
		if (exists $options->{origin}) {
			my $reftype = ref $options->{origin};
			if ($reftype eq 'CODE') {
				if (!$options->{origin}->(URI->new($origin))) {
					debug "[CORS] origin $origin did not matched against coderef" if DEBUG;
					next RULE;
				}
			} elsif ($reftype eq 'ARRAY') {
				unless (_isin $origin => @{ $options->{origin} }) {
					debug "[CORS] origin $origin is not in array" if DEBUG;
					next RULE;
				}
			} elsif ($reftype eq 'Regexp') {
				unless ($origin =~ $options->{origin}) {
					debug "[CORS] origin $origin did not matched against regexp" if DEBUG;
					next RULE;
				}
			} elsif ($reftype eq '') {
				unless ($options->{origin} eq $origin) {
					debug "[CORS] origin $origin did not matched against static string" if DEBUG;
					next RULE;
				}
			} else {
				confess("unknown origin type: $reftype");
			}
		} else {
			$origin = '*';
		}
		$headers->{'Access-Control-Allow-Origin'} = $origin;
		$headers->{'Vary'} = 'Origin' if $origin ne '*';
		
		if (exists $options->{timing}) {
			if (defined $options->{timing} and $options->{timing} eq '1') {
				$headers->{'Timing-Allow-Origin'} = $headers->{'Access-Control-Allow-Origin'};
			} else {
				$headers->{'Timing-Allow-Origin'} = 'null';
			}
		}
		
		if (exists $options->{credentials}) {
			if (!!$options->{credentials}) {
				if ($origin eq '*') {
					warning('For a resource that supports credentials a origin matcher must be specified.');
					next RULE;
				}
				$headers->{'Access-Control-Allow-Credentials'} = 'true' ;
			}
		}
		
		if (exists $options->{expose}) {
			$headers->{'Access-Control-Expose-Headers'} = $options->{expose};
		}
		
		if (exists $options->{methods}) {
			unless (_isin lc $requested_method => map lc, @{ $options->{methods} }) {
				debug "[CORS] request method not allowed" if DEBUG;
				next RULE;
			}
			$headers->{'Access-Control-Allow-Methods'} = join ', ' => map uc, @{ $options->{methods} };
		} elsif (exists $options->{method}) {
			unless ($options->{method} eq $requested_method) {
				debug "[CORS] request method '$requested_method' not allowed: ".$options->{method} if DEBUG;
				next RULE;
			}
			$headers->{'Access-Control-Allow-Methods'} = $options->{method};
		}
		
		if (exists $options->{headers}) {
			foreach my $requested_header (@requested_headers) {
				unless (_isin lc $requested_header => map lc, @{ $options->{headers} }) {
					debug "[CORS] requested headers did not match allowed in rule" if DEBUG;
					next RULE;
				}
			}
			$headers->{'Access-Control-Allow-Headers'} = join ', ' => @{ $options->{headers} };
		} elsif (@requested_headers) {
			$headers->{'Access-Control-Allow-Headers'} = join ', ' => @requested_headers;
		}

		if ($preflight and exists $options->{maxage}) {
			$headers->{'Access-Control-Max-Age'} = $options->{maxage};
		}
		
		$ok = 1;
		var CORS => {%$options};
		Dancer::SharedData->response->headers(%$headers);
		if (DEBUG) {
			use Data::Dumper;
			debug Dumper({headers => $headers});
		}
		last RULE;
	}

	if ($ok) {
		debug "[CORS] matched!" if DEBUG;
	} else {
		debug "[CORS] no rule matched" if DEBUG;
	}
	
	return $ok;
}


register(share => \&_add_rule);

hook(before => sub {
	$current_route = shift || return;
	my $preflight = uc Dancer::SharedData->request->method eq 'OPTIONS';
	if ($preflight) {
		debug "[CORS] pre-check: preflight request, handle within main subroutine" if DEBUG;
	} else {
		debug "[CORS] pre-check: no preflight, handle actual request now" if DEBUG;
		_handle($current_route);
	}
});

my $current_sharing;


register sharing => sub {
	my $class = __PACKAGE__.'::Sharing';
	$current_sharing ||= $class->new(@_,_add_rule=>\&_add_rule);
	return $current_sharing;
};

register_plugin;
1;

__END__

=pod

=head1 NAME

Dancer::Plugin::CORS - A plugin for using cross origin resource sharing

=head1 VERSION

version 0.13

=head1 DESCRIPTION

Cross origin resource sharing is a feature used by modern web browser to bypass cross site scripting restrictions. A webservice can provide those rules from which origin a client is allowed to make cross-site requests. This module helps you to setup ...

=head1 SYNOPSIS

    use Dancer::Plugin::CORS;

    get '/foo' => sub { ... };
	share '/foo' =>
		origin => 'http://localhost/',
		credentials => 1,
		expose => [qw[ Content-Type ]],
		method => 'GET',
		headers => [qw[ X-Requested-With ]],
		maxage => 7200,
		timing => 1,
	;

=head1 METHODS

=head2 share(C<$route>, C<%options>)

The parameter C<$route> may be any valid path like used I<get>, I<post>, I<put>, I<delete> or I<patch> but not I<option>.

Alternatively a L<Dancer::Route> object may be used instead:

	$route = post '/' => sub { ... };
	share $route => ... ;

Or a arrayref to one or more Routes:

	@head_and_get = get '/' => sub { ... };
	share \@head_and_get => ...;

This syntax works too:

	share [ get ('/' => sub { ... }) ] => ...;

For any route more than one rule may be defined. The order is relevant: the first matching rule wins.

Following keywords recognized by C<%options>:

=over 4

=item I<origin>

This key defines a static origin (scalar), a list (arrayref), a regex or a subroutine.

If not specified, any origin is allowed.

If a subroutine is used, the first passed parameter is a L<URI> object. It should return a true value if this origin is allowed to access the route in question; otherwise false.

	origin => sub {
		my $host = shift->host;
		# allow only from localhost
		grep { $host eq $_ } qw(localhost 127.0.0.1 ::1)
	}

Hint: a origin consists of protocol, hostname and maybe a port. Examples: C<http://www.example.com>, C<https://securesite.com>, C<http://localhost:3000>, C<http://127.0.0.1>, C<http://[::1]>

=item I<credentials>

This indicates whether cookies, HTTP authentication and/or client-side SSL certificates may sent by a client. Allowed values are C<0> or C<1>.

This option must be used together with I<origin>.

=item I<expose>

A comma-seperated list of headers, that a client may extract from response for use in a client application.

=item I<methods>

A arrayref of allowed methods. If no methods are specified, all methods are allowed.

=item I<method>

A string containing a single supported method. This parameter is autofilled when I<share()> is used together with a L<Dancer::Route> object. If no method is specified, any method is allowed.

=item I<headers>

A arrayref of allowed request headers. In most cases that should be C<[ 'X-Requested-With' ]> when ajax requests are made. If no headers are specified, all requested headers are allowed.

=item I<maxage>

A maximum time (in seconds) a client may cache a preflight request. This can decrease the amount of requests made to the webservice.

=item I<timing>

Allow access to the resource timing information. If set to 1, the header C<Timing-Allow-Origin> is set to the same value as I<Access-Control-Allow-Origin>. Otherwise, its set to the value I<null>. If the keyword is not present, no I<Timing-Allow-Orig...

=back

=head2 sharing

This keyword is a helper for re-using rules for many routes.

See L<Dancer::Plugin::CORS::Sharing> for more information about this feature.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website
https://github.com/zurborg/libdancer-plugin-cors-perl/issues

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

David Zurborg <zurborg@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2014 by David Zurborg.

This is free software, licensed under:

  The ISC License

=cut