/usr/share/perl5/Catalyst/ActionRole/RequireSSL.pm is in libcatalyst-actionrole-requiressl-perl 0.07-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | package Catalyst::ActionRole::RequireSSL;
{
$Catalyst::ActionRole::RequireSSL::VERSION = '0.07';
}
use Moose::Role;
with 'Catalyst::ActionRole::RequireSSL::Role';
use namespace::autoclean;
=head1 NAME
Catalyst::ActionRole::RequireSSL - Force an action to be secure only.
=head1 VERSION
version 0.07
=head1 SYNOPSIS
package MyApp::Controller::Foo;
use parent qw/Catalyst::Controller::ActionRole/;
sub bar : Local Does('RequireSSL') { ... }
sub bar : Local Does('NoSSL') { ... }
=head2 HIERARCHY
You can chain the SSL Roles to allow for enforced combinations such as all
secure apart from a certain action and vice versa. See the tests to see this
in action.
=cut
around execute => sub {
my $orig = shift;
my $self = shift;
my ($controller, $c) = @_;
unless(defined $c->config->{require_ssl}->{disabled}) {
$c->config->{require_ssl}->{disabled} =
$c->engine->isa("Catalyst::Engine::HTTP") ? 1 : 0;
}
#use Data::Dumper;warn Dumper($c->action);
if (!$c->req->secure && $c->req->method eq "POST"
&& !$c->config->{require_ssl}->{ignore_on_post})
{
$c->error("Cannot secure request on POST")
}
unless(
$c->config->{require_ssl}->{disabled} ||
$c->req->secure ||
$c->req->method eq "POST" ||
!$self->check_chain($c)
) {
my $uri = $c->req->uri->clone;
$uri->scheme('https');
$c->res->redirect( $uri );
$c->detach();
} else {
$c->log->warn("Would've redirected to SSL")
if $c->config->{require_ssl}->{disabled} && $c->debug;
$self->$orig( @_ );
}
};
1;
=head1 AUTHOR
Simon Elliott <cpan@papercreatures.com>
=head1 THANKS
Andy Grundman, <andy@hybridized.org> for the original RequireSSL Plugin
t0m (Tomas Doran), zamolxes (Bogdan Lucaciu), wreis (Wallace Reis)
=head1 COPYRIGHT & LICENSE
Copyright 2009 by Simon Elliott
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
|