Context Navigation

← Previous Change
Next Change →

Catalyst-Controller-RequestToken

Timestamp:

06/30/08 10:47:25 (5 years ago)

Author:

hidek

Message:

merge refactoring branch to trunk

Location:

lang/perl/Catalyst-Controller-RequestToken/trunk

Files:

: 14 added
: 11 modified

.shipit (modified) (1 diff)
Changes (modified) (1 diff)
MANIFEST (added)
META.yml (added)
Makefile.PL (modified) (1 diff)
inc (added)
inc/.author (added)
inc/Module (added)
inc/Module/Install (added)
inc/Module/Install.pm (added)
inc/Module/Install/Base.pm (added)
inc/Module/Install/Can.pm (added)
inc/Module/Install/Fetch.pm (added)
inc/Module/Install/Makefile.pm (added)
inc/Module/Install/Metadata.pm (added)
inc/Module/Install/Win32.pm (added)
inc/Module/Install/WriteAll.pm (added)
lib/Catalyst/Controller/RequestToken.pm (modified) (13 diffs)
lib/Catalyst/Controller/RequestToken/Action/CreateToken.pm (modified) (2 diffs)
lib/Catalyst/Controller/RequestToken/Action/RemoveToken.pm (modified) (1 diff)
lib/Catalyst/Controller/RequestToken/Action/ValidateToken.pm (modified) (1 diff)
t/lib/TestApp.pm (modified) (1 diff)
t/lib/TestApp/Controller/Root.pm (modified) (1 diff)
t/lib/TestApp/Controller/Simple.pm (modified) (7 diffs)
t/live-test.t (modified) (4 diffs)

Legend:

: Unmodified
: Added
: Removed

lang/perl/Catalyst-Controller-RequestToken/trunk/.shipit

r13221	r14891
1	1	steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN
	2	git.tagpattern = %v
	3	git.push_to = origi
2	4
3		~~git.tagpattern = %v~~
4		~~git.push_to = origin~~

lang/perl/Catalyst-Controller-RequestToken/trunk/Changes

r13249	r14891
1		0.01 Thu Jun 5 0:32:10 JST 2008
	1	0.02 Fri Jun 6 11:37:31 JST 2008
	2
	3	0.01 Thu Jun 5 0:32:10 JST 2008
2	4	- first release
3	5

lang/perl/Catalyst-Controller-RequestToken/trunk/Makefile.PL

r13241	r14891
7	7	build_requires 'Catalyst::Plugin::Session';
8	8	test_requires 'Catalyst::Plugin::Session::State::Cookie';
	9	test_requires 'Catalyst::Action::RenderView';
9	10	test_requires 'Test::WWW::Mechanize::Catalyst';
10	11	test_requires 'Test::More';

lang/perl/Catalyst-Controller-RequestToken/trunk/lib/Catalyst/Controller/RequestToken.pm

r13285	r14891
4	4	use warnings;
5	5
6
7	6	use base qw(Catalyst::Controller);
8	7
	8	use Catalyst::Exception;
9	9	use Scalar::Util qw/weaken/;
10
11		our $VERSION = '0.01';
12
13		__PACKAGE__->config(
14		session_name => '_token',
15		request_name => '_token',
16		);
	10	use Class::C3;
	11	use Digest();
	12
	13	our $VERSION = '0.02';
17	14
18	15	sub ACCEPT_CONTEXT {
…	…
23	20	weaken( $self->{c} );
24	21
25		return $self->NEXT::ACCEPT_CONTEXT(~~$c, @_~~) \|\| $self;
	22	return $self->NEXT::ACCEPT_CONTEXT( $c, @_ ) \|\| $self;
26	23	}
27	24
28	25	sub new {
29	26	my $class = shift;
30		my $self = $class->NEXT::new(@_);
31
32		$self->_setup(@_);
33		return $self;
34		}
35
36		sub _setup {
37		my $self = shift;
38		my ($c) = @_;
39
40		$self->config(%{$self->config}, %{$c->config->{'Controller::RequestToken'}});
	27	my ( $c, $args ) = @_;
	28
	29	my $self = $class->next::method( $c, $args );
41	30
42	31	Catalyst::Exception->throw("Catalyst::Plugin::Session is required")
43	32	unless $c->isa('Catalyst::Plugin::Session');
	33
	34	my $config = {
	35	session_name => '_token',
	36	request_name => '_token',
	37	%{ $c->config->{'Controller::RequestToken'} },
	38	%{ $class->config },
	39	%{$args},
	40	};
	41
	42	$self->config($config);
	43	return $self;
	44	}
	45
	46	sub token {
	47	my ( $self, $arg ) = @_;
	48	my $c = $self->{c};
	49
	50	if ( defined $arg ) {
	51	$c->session->{ $self->_ident() } = $arg;
	52	return $arg;
	53	}
	54
	55	return $c->session->{ $self->_ident() };
	56	}
	57
	58	sub create_token {
	59	my ( $self, $arg ) = @_;
	60	my $c = $self->{c};
	61
	62	$c->log->debug("create token") if $c->debug;
	63	my $digest = _find_digest();
	64	my $seed = join( time, rand(10000), $$, {} );
	65	$digest->add($seed);
	66	my $token = $digest->hexdigest;
	67	$c->log->debug("token is created: $token") if $c->debug;
	68
	69	return $self->token($token);
	70	}
	71
	72	sub remove_token {
	73	my ( $self, $arg ) = @_;
	74	my $c = $self->{c};
	75
	76	$c->log->debug("remove token") if $c->debug;
	77	undef $c->session->{$self->_ident()};
	78	$self->token(undef);
44	79	}
45	80
46	81	sub validate_token {
47		my $self = shift;
48
49		return $self->{c}->stash->{validate_token};
	82	my ( $self, $arg ) = @_;
	83	my $c = $self->{c};
	84	my $conf = $self->config;
	85
	86	$c->log->debug('validate token') if $c->debug;
	87	my $session = $self->token;
	88	my $request = $c->req->param( $conf->{request_name} );
	89
	90	$c->log->debug("session: $session");
	91	$c->log->debug("request: $request");
	92
	93	if ( ( $session && $request ) && $session eq $request ) {
	94	$c->log->debug('token is valid') if $c->debug;
	95	$c->stash->{$self->_ident()} = 1;
	96	}
	97	else {
	98	$c->log->debug('token is invalid') if $c->debug;
	99	if ( $c->isa('Catalyst::Plugin::FormValidator::Simple') ) {
	100	$c->set_invalid_form( $conf->{request_name} => 'TOKEN' );
	101	}
	102	undef $c->stash->{$self->_ident()};
	103	}
	104	}
	105
	106	sub is_valid_token {
	107	my ( $self, $arg ) = @_;
	108	my $c = $self->{c};
	109
	110	return $c->stash->{$self->_ident()};
	111	}
	112
	113	sub _ident { # secret stash key for this template'
	114	return '__' . ref( $_[0] ) . '_token';
	115	}
	116
	117	# following code is from Catalyst::Plugin::Session
	118	my $usable;
	119
	120	sub _find_digest () {
	121	unless ($usable) {
	122	foreach my $alg (qw/SHA-256 SHA-1 MD5/) {
	123	if ( eval { Digest->new($alg) } ) {
	124	$usable = $alg;
	125	last;
	126	}
	127	}
	128	Catalyst::Exception->throw(
	129	"Could not find a suitable Digest module. Please install "
	130	. "Digest::SHA1, Digest::SHA, or Digest::MD5" )
	131	unless $usable;
	132	}
	133
	134	return Digest->new($usable);
50	135	}
51	136
…	…
53	138	my ( $self, $app_class, $action_name, $vaue, $attrs ) = @_;
54	139
55		return ( ActionClass => 'Catalyst::Controller::RequestToken::Action::CreateToken' );
	140	return ( ActionClass =>
	141	'Catalyst::Controller::RequestToken::Action::CreateToken' );
56	142	}
57	143
…	…
59	145	my ( $self, $app_class, $action_name, $vaue, $attrs ) = @_;
60	146
61		return ( ActionClass => 'Catalyst::Controller::RequestToken::Action::ValidateToken' );
	147	return ( ActionClass =>
	148	'Catalyst::Controller::RequestToken::Action::ValidateToken' );
62	149	}
63	150
…	…
65	152	my ( $self, $app_class, $action_name, $vaue, $attrs ) = @_;
66	153
67		return ( ActionClass => 'Catalyst::Controller::RequestToken::Action::RemoveToken' );
	154	return ( ActionClass =>
	155	'Catalyst::Controller::RequestToken::Action::RemoveToken' );
68	156	}
69	157
…	…
71	159	my ( $self, $app_class, $action_name, $vaue, $attrs ) = @_;
72	160
73		return ( ActionClass => 'Catalyst::Controller::RequestToken::Action::ValidateRemoveToken' );
	161	return ( ActionClass =>
	162	'Catalyst::Controller::RequestToken::Action::ValidateRemoveToken'
	163	);
74	164	}
75	165
…	…
97	187	use base qw(Catalyst::Controller::RequestToken);
98	188
99		sub form :~~Local~~ {
	189	sub form :CreateToken {
100	190	my ($self, $c) = @_;
101	191	$c->stash->{template} = 'form.tt';
…	…
103	193	}
104	194
105		sub confirm :Local :~~Cre~~ateToken {
	195	sub confirm :Local :ValidateToken {
106	196	my ($self, $c) = @_;
107	197	$c->stash->{template} = 'confirm.tt';
…	…
109	199	}
110	200
111		sub complete :Local :ValidateToken {
	201	sub complete :Local :ValidateRemoveToken {
112	202	my ($self, $c) = @_;
113	203	if ($self->validate_token) {
…	…
123	213	<body>
124	214	<form action="confirm" method="post">
	215	<input type="hidden" name="_token" values="[% c.req.param('_token') %]"/>
125	216	<input type="submit" name="submit" value="confirm"/>
126	217	</form>
…	…
146	237	This module REQUIRES Catalyst::Plugin::Session to store server side token.
147	238
148		If you add CreateToken attribute to action, token will be created and stored
149		into request and session. You can return a content with request token which
150		should be posted to server.
151
152		If you add ValidateToken attribute, this will validate request token with
153		sever-side session token, and remove token from session.
154
155		After ValidateToken, there is any token in session, so validation will be
156		failed, if user request with expired token.
	239	=head1 ATTRIBUTES
	240
	241	=over 4
	242
	243	=item CreateToken
	244
	245	Creates new token and put it into request and session.
	246	You can return a content with request token which should be posted
	247	to server.
	248
	249	=item ValidateToken
	250
	251	After CreateToken, clients will post token request, so you need
	252	validate it correct or not.
	253
	254	ValidateToken attribute validates request token with session token
	255	which is created by CreateToken attribute.
	256
	257	=item RemoveToken
	258
	259	Removes token from session, then request token will be invalid any more.
	260
	261	= item ValidateRemoveToken
	262	Works as combination of ValidateToken and RemoveToken.
	263	This will be useful for the last part of transaction.
	264
	265	=back
157	266
158	267	=head1 METHODS
159	268
160	269	=over 4
	270
	271	=item token
	272
	273	=item create_token
	274
	275	=item remove_token
161	276
162	277	=item validate_token
…	…
164	279	Return token is valid or not. This will work collectlly only after
165	280	ValidateToken.
	281
	282	=item is_valid_token
166	283
167	284	=back
…	…
183	300
184	301	=item request_name
	302
	303	Default: _token
	304
	305	=item validate_stash_name
185	306
186	307	Default: _token

lang/perl/Catalyst-Controller-RequestToken/trunk/lib/Catalyst/Controller/RequestToken/Action/CreateToken.pm

r13240	r14891
6	6	use base qw(Catalyst::Action);
7	7
8		~~use Catalyst::Exception;~~
9		~~use Digest();~~
10
11	8	sub execute {
12	9	my $self = shift;
13	10	my ( $controller, $c, @args ) = @_;
14	11
15		$c->log->debug("create token") if $c->debug;
16		my $digest = _find_digest();
17		my $seed = join( time, rand(10000), $$, {} );
18		$digest->add($seed);
19		my $token = $digest->hexdigest;
20		$c->log->debug("token is created: $token") if $c->debug;
21
22		my $conf = $controller->config;
23		$c->session->{ $conf->{session_name} } = $token;
24		$c->request->params->{ $conf->{request_name} } = $token;
25
	12	$controller->create_token;
26	13	return $self->NEXT::execute(@_);
27	14	}
28	15
29		# following code is from Catalyst::Plugin::Session
30		my $usable;
	16	1;
31	17
32		sub _find_digest () {
33		unless ($usable) {
34		foreach my $alg (qw/SHA-256 SHA-1 MD5/) {
35		if ( eval { Digest->new($alg) } ) {
36		$usable = $alg;
37		last;
38		}
39		}
40		Catalyst::Exception->throw(
41		"Could not find a suitable Digest module. Please install "
42		. "Digest::SHA1, Digest::SHA, or Digest::MD5" )
43		unless $usable;
44		}
45
46		return Digest->new($usable);
47		}
	18	__END__
48	19
49	20	=head1 NAME
…	…
83	54	=cut
84	55
85		1;
86	56

lang/perl/Catalyst-Controller-RequestToken/trunk/lib/Catalyst/Controller/RequestToken/Action/RemoveToken.pm

r13285	r14891
6	6	use base qw(Catalyst::Action);
7	7
8		~~use Catalyst::Exception;~~
9		~~use Class::C3;~~
10
11	8	sub execute {
12	9	my $self = shift;
13	10	my ( $controller, $c, @args ) = @_;
14	11
15		$c->log->debug("remove token") if $c->debug;
16		my $conf = $controller->config;
17		undef $c->session->{ $conf->{session_name} };
18
	12	$controller->remove_token;
19	13	return $self->next::method(@_);
20	14	}

lang/perl/Catalyst-Controller-RequestToken/trunk/lib/Catalyst/Controller/RequestToken/Action/ValidateToken.pm

r13285	r14891
6	6	use base qw(Catalyst::Action);
7	7
8		~~use Catalyst::Exception;~~
9		~~use Class::C3;~~
10
11	8	sub execute {
12	9	my $self = shift;
13	10	my ( $controller, $c, @args ) = @_;
14	11
15		my $conf = $controller->config;
16
17		$c->log->debug('validate token') if $c->debug;
18		my $session = $c->session->{ $conf->{session_name} };
19		my $request = $c->req->param( $conf->{request_name} );
20
21		if ( ( $session && $request ) && $session eq $request ) {
22		$c->stash->{validate_token} = 1;
23		$c->log->debug('token is valid') if $c->debug;
24		} else {
25		$c->log->debug('token is invalid') if $c->debug;
26		if ( $c->isa('Catalyst::Plugin::FormValidator::Simple') ) {
27		$c->set_invalid_form(
28		$conf->{request_name} => 'TOKEN' );
29		}
30		}
31
	12	$controller->validate_token;
32	13	return $self->next::method(@_);
33	14	}

lang/perl/Catalyst-Controller-RequestToken/trunk/t/lib/TestApp.pm

r13285	r14891
5	5	use Catalyst qw(-Debug Session Session::Store::Dummy Session::State::Cookie);
6	6	#use Catalyst qw(Session Session::Store::Dummy Session::State::Cookie);
7
	7	__PACKAGE__->config('Controller::RequestToken' => {session_name => '__token', request_name => '__token'});
8	8	__PACKAGE__->setup;
9	9

lang/perl/Catalyst-Controller-RequestToken/trunk/t/lib/TestApp/Controller/Root.pm

r13221	r14891
9	9	# your actions replace this one
10	10	sub main :Path { $_[1]->res->body('<h1>It works</h1>') }
11		sub end : ActionClass('RenderView'){};
	11	sub end :Private {
	12	my ($self, $c) = @_;
	13	$c->response->content_type("text/html; charset=UTF-8");
	14	}
12	15	1;

lang/perl/Catalyst-Controller-RequestToken/trunk/t/lib/TestApp/Controller/Simple.pm

r13285	r14891
8	8	my ( $self, $c ) = @_;
9	9
10		~~$c->stash->{html}~~ = <<HTML;
	10	my $html = <<HTML;
11	11	<html>
12	12	<head></head>
…	…
14	14	FORM
15	15	<form action="confirm" method="post">
16		<input type="hidden" name="_token" value="TOKEN"/>
	16	<input type="hidden" name="__token" value="TOKEN"/>
17	17	<input type="submit" name="submit" value="submit"/>
18	18	</form>
…	…
21	21	HTML
22	22
23		$c->forward('parse_html');
	23	my $token = $self->token;
	24	$html =~ s/TOKEN/$token/g;
	25	$c->response->body($html);
24	26	}
25	27
…	…
27	29	my ( $self, $c ) = @_;
28	30
29		$c->stash->{html} = <<HTML;
	31	$c->detach('error') unless $self->is_valid_token;
	32	my $html = <<HTML;
30	33	<html>
31	34	<body>
32	35	CONFIRM
33	36	<form action="complete" method="post">
34		<input type="hidden" name="_~~token" value="TOKEN~~"/>
	37	<input type="hidden" name="__token" value="REQUEST"/>
35	38	<input type="submit" name="submit" value="submit"/>
36	39	</form>
…	…
38	41	</html>
39	42	HTML
40		$c->detach('error') unless $self->validate_token;
41		$c->forward('parse_html');
	43	my $token = $c->req->param('__token');
	44	$html =~ s/REQUEST/$token/g;
	45	$c->response->body($html);
42	46	}
43	47
…	…
45	49	my ( $self, $c ) = @_;
46	50
47		$c->stash->{html} = <<HTML;
	51	$c->detach('error') unless $self->is_valid_token;
	52	my $html = <<HTML;
48	53	<html><body>SUCCESS</body></html>
49	54	HTML
50	55
51		$c->detach('error') unless $self->validate_token;
52		$c->forward('parse_html');
	56	$c->response->body($html);
53	57	}
54	58
…	…
63	67	}
64	68
65		~~sub parse_html : Private {~~
66		~~my ( $self, $c ) = @_;~~
67		~~my $token = $c->req->param('_token');~~
68
69		~~my $html = $c->stash->{html};~~
70		~~$html =~ s/TOKEN/$token/g;~~
71		~~$c->response->body($html);~~
72		}
73
74	69	1;

lang/perl/Catalyst-Controller-RequestToken/trunk/t/live-test.t

r13285	r14891
3	3	use strict;
4	4	use warnings;
5		~~#use Test::More tests => 15;~~
6	5	use Test::More qw(no_plan);
7	6
…	…
24	23	$mech->submit_form_ok({}, 'submit form');
25	24	$mech->content_like(qr/CONFIRM/i, 'see if it has our text');
26		~~$mech->content;~~
27	25
28	26	$mech->submit_form_ok({}, 'submit form');
…	…
31	29	$mech->reload;
32	30	$mech->content_like(qr/INVALID ACCESS/i, 'see if it has our text');
33
	31	=cut
34	32	$mech->back;
35	33	$mech->content_like(qr/CONFIRM/i, 'see if it has our text');
…	…
46	44	$mech->submit;
47	45	$mech->content_like(qr/SUCCESS/i, 'see if it has our text');
48
	46	=cut

Context Navigation

Changeset 14891 for lang/perl/Catalyst-Controller-RequestToken

Legend:

Download in other formats: