Commit | Line | Data |
19262e3d |
1 | package stemmaweb::Controller::Users; |
2 | use Moose; |
3 | use namespace::autoclean; |
4 | |
85990daf |
5 | use Google::JWT; |
6 | |
7 | use JSON::MaybeXS; |
8 | use JSON::WebToken; |
9 | |
10 | use MIME::Base64; |
11 | |
19262e3d |
12 | BEGIN {extends 'CatalystX::Controller::Auth'; } |
b74843e5 |
13 | with 'Catalyst::TraitFor::Controller::reCAPTCHA'; |
19262e3d |
14 | |
15 | =head1 NAME |
16 | |
17 | stemmaweb::Controller::Users - Catalyst Controller |
18 | |
19 | =head1 DESCRIPTION |
20 | |
b74843e5 |
21 | The Users controller is based on L<CatalystX::Controller::Auth>, see |
22 | there for most of the functionality. Any localised parts are described |
23 | below. |
24 | |
25 | This controller uses L<Catalyst::TraitFor::Controller::reCAPTCHA> to |
26 | create and check a reCaptcha form shown on the C<register> form to |
27 | help prevent spam signups. |
19262e3d |
28 | |
29 | =head1 METHODS |
30 | |
31 | =cut |
32 | |
33 | sub base :Chained('/') :PathPart('') :CaptureArgs(0) |
34 | { |
35 | my ( $self, $c ) = @_; |
1628e97a |
36 | |
19262e3d |
37 | $self->next::method( $c ); |
38 | } |
39 | |
40 | =head2 index |
41 | |
b74843e5 |
42 | The index action is not currently used. |
43 | |
19262e3d |
44 | =cut |
45 | |
46 | sub index :Path :Args(0) { |
47 | my ( $self, $c ) = @_; |
48 | |
49 | $c->response->body('Matched stemmaweb::Controller::Users in Users.'); |
50 | } |
51 | |
b74843e5 |
52 | =head2 login with openid |
53 | |
54 | Logging in with openid/google requires two passes through the login |
55 | action, on the 2nd pass the C<openid-check> value is passed in when |
56 | the openid providing webserver links the user back to the stemmaweb |
eb38afbc |
57 | site. This adaptation to the C<login> action sets the realm we are |
b74843e5 |
58 | authenticating against to be C<openid> in this case. |
59 | |
60 | =cut |
61 | |
b600c671 |
62 | before login => sub { |
63 | my($self, $c) = @_; |
64 | $c->req->param( realm => 'openid') |
65 | if $c->req->param('openid-check'); |
66 | }; |
19262e3d |
67 | |
b74843e5 |
68 | =head2 register with recaptcha |
69 | |
70 | This adapts the C<register> action to add the recaptcha HTML to the |
71 | page, and verify the recaptcha info entered is correct when the form |
72 | is submitted. If the recaptcha is not correct, we just redisplay the |
73 | form with an error message. |
74 | |
75 | =cut |
76 | |
77 | before register => sub { |
78 | my ($self, $c) = @_; |
79 | |
80 | ## Puts HTML into stash in "recaptcha" key. |
81 | $c->forward('captcha_get'); |
82 | |
83 | ## When submitting, check recaptcha passes, else re-draw form |
84 | if($c->req->method eq 'POST') { |
85990daf |
85 | if(!$c->forward('captcha_check') || 0 ) { |
b74843e5 |
86 | ## Need these two lines to detach, so end can draw the correct template again: |
87 | my $form = $self->form_handler->new( active => [ $self->login_id_field, 'password', 'confirm_password' ] ); |
88 | $c->stash( template => $self->register_template, form => $form ); |
89 | |
90 | $c->detach(); |
91 | } |
92 | } |
93 | }; |
94 | |
85990daf |
95 | before login => sub { |
96 | my ($self, $c) = @_; |
97 | |
98 | if ($c->req->params->{email} && $c->req->params->{id_token}) { |
99 | |
100 | $c->req->param( realm => 'google'); |
101 | |
102 | } |
103 | }; |
104 | |
eb38afbc |
105 | =head2 success |
106 | |
107 | A stub page returned on login / registration success. |
108 | |
109 | =cut |
110 | |
111 | sub success :Local :Args(0) { |
112 | my ( $self, $c ) = @_; |
113 | |
114 | $c->load_status_msgs; |
115 | $c->stash->{template} = 'auth/success.tt'; |
116 | } |
117 | |
118 | =head2 post_logout |
119 | |
120 | Return to the index page, not to the login page. |
121 | |
122 | =cut |
123 | |
124 | sub post_logout { |
125 | my( $self, $c ) = @_; |
126 | $c->response->redirect( $c->uri_for_action( '/index' ) ); |
127 | $c->detach; |
128 | } |
129 | |
19262e3d |
130 | =head1 AUTHOR |
131 | |
132 | A clever guy |
133 | |
134 | =head1 LICENSE |
135 | |
136 | This library is free software. You can redistribute it and/or modify |
137 | it under the same terms as Perl itself. |
138 | |
139 | =cut |
140 | |
141 | __PACKAGE__->meta->make_immutable; |
142 | |
143 | 1; |