annotate Lib/IMPL/Web/Handler/SecureCookie.pm @ 263:0f59b2de72af

*fixed IMPL::DOM::Schema circular module references *modified IMPL::Object::Singleton, added auto-activation *code cleanups, docs
author sergey
date Wed, 09 Jan 2013 05:17:44 +0400
parents 4ac39b9e2ca4
children 63709a4e6da0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
1 package IMPL::Web::Handler::SecureCookie;
196
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
2 use strict;
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
3
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
4
196
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
5 use Digest::MD5 qw(md5_hex);
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
6 use IMPL::Const qw(:prop);
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
7 use IMPL::Security::Auth qw(:Const GenSSID);
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
8 use IMPL::declare {
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
9 require => {
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
10 SecurityContext => 'IMPL::Security::Context',
238
b8c724f6de36 DOM model refactoring
sergey
parents: 233
diff changeset
11 User => 'IMPL::Security::Principal',
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
12 AuthSimple => 'IMPL::Security::Auth::Simple',
231
sergey
parents: 230
diff changeset
13 Exception => 'IMPL::Exception',
sergey
parents: 230
diff changeset
14 OperationException => '-IMPL::InvalidOperationException',
sergey
parents: 230
diff changeset
15 HttpResponse => '-IMPL::Web::HttpResponse'
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
16 },
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
17 base => {
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
18 'IMPL::Object' => undef,
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
19 'IMPL::Object::Autofill' => '@_',
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
20 'IMPL::Object::Serializable' => undef
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
21 },
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
22 props => [
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
23 salt => PROP_RO,
238
b8c724f6de36 DOM model refactoring
sergey
parents: 233
diff changeset
24 _manager => PROP_RO,
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
25 _cookies => PROP_RW
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
26 ]
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
27 };
196
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
28
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
29 sub CTOR {
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
30 my ($this) = @_;
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
31
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
32 $this->salt('DeadBeef') unless $this->salt;
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
33 }
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
34
262
sergey
parents: 254
diff changeset
35 sub ValidateCookie {
sergey
parents: 254
diff changeset
36 my ($this,$sid,$cookie,$sign) = @_;
sergey
parents: 254
diff changeset
37
sergey
parents: 254
diff changeset
38 return 1 if $sid and $cookie and $sign and $sign eq md5_hex($this->salt,$sid,$cookie,$this->salt);
sergey
parents: 254
diff changeset
39
sergey
parents: 254
diff changeset
40 return 0;
sergey
parents: 254
diff changeset
41 }
sergey
parents: 254
diff changeset
42
263
0f59b2de72af *fixed IMPL::DOM::Schema circular module references
sergey
parents: 262
diff changeset
43 sub AuthCookie {
0f59b2de72af *fixed IMPL::DOM::Schema circular module references
sergey
parents: 262
diff changeset
44 my ($this,$sid,$cookie,$sign, $context) = @_;
0f59b2de72af *fixed IMPL::DOM::Schema circular module references
sergey
parents: 262
diff changeset
45
0f59b2de72af *fixed IMPL::DOM::Schema circular module references
sergey
parents: 262
diff changeset
46 if (eval { $context->auth->isa(AuthSimple) }) {
0f59b2de72af *fixed IMPL::DOM::Schema circular module references
sergey
parents: 262
diff changeset
47 my ($result,$challenge) = $context->auth->DoAuth($cookie);
0f59b2de72af *fixed IMPL::DOM::Schema circular module references
sergey
parents: 262
diff changeset
48 return $result;
0f59b2de72af *fixed IMPL::DOM::Schema circular module references
sergey
parents: 262
diff changeset
49 }
0f59b2de72af *fixed IMPL::DOM::Schema circular module references
sergey
parents: 262
diff changeset
50
0f59b2de72af *fixed IMPL::DOM::Schema circular module references
sergey
parents: 262
diff changeset
51 return AUTH_FAIL;
0f59b2de72af *fixed IMPL::DOM::Schema circular module references
sergey
parents: 262
diff changeset
52 }
0f59b2de72af *fixed IMPL::DOM::Schema circular module references
sergey
parents: 262
diff changeset
53
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
54 sub Invoke {
196
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
55 my ($this,$action,$nextHandler) = @_;
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
56
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
57 return unless $nextHandler;
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
58
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
59 my $context;
238
b8c724f6de36 DOM model refactoring
sergey
parents: 233
diff changeset
60 $this->_manager($action->application->security);
196
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
61
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
62
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
63 my $sid = $action->cookie('sid',qr/(\w+)/);
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
64 my $cookie = $action->cookie('sdata',qr/(\w+)/);
239
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
65 my $sign = $action->cookie('sign',qw/(\w+)/);
196
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
66
262
sergey
parents: 254
diff changeset
67 if ( $this->ValidateCookie($sid,$cookie,$sign) ) {
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
68 # TODO: add a DefferedProxy to deffer a request to a data source
238
b8c724f6de36 DOM model refactoring
sergey
parents: 233
diff changeset
69 if ( $context = $this->_manager->GetSession($sid) ) {
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
70 if ( eval { $context->auth->isa(AuthSimple) } ) {
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
71 my ($result,$challenge) = $context->auth->DoAuth($cookie);
239
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
72
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
73 $context->authority($this);
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
74
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
75 if ($result == AUTH_FAIL) {
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
76 $context = undef;
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
77 }
239
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
78 } else {
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
79 undef $context;
196
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
80 }
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
81 }
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
82
196
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
83 }
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
84
231
sergey
parents: 230
diff changeset
85 $context ||= SecurityContext->new(principal => User->nobody, authority => $this);
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
86
238
b8c724f6de36 DOM model refactoring
sergey
parents: 233
diff changeset
87 my $httpResponse = $context->Impersonate($nextHandler,$action);
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
88
231
sergey
parents: 230
diff changeset
89 die OperationException->new("A HttpResponse instance is expected")
sergey
parents: 230
diff changeset
90 unless ref $httpResponse && eval { $httpResponse->isa(HttpResponse) };
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
91
231
sergey
parents: 230
diff changeset
92 return $this->WriteResponse($httpResponse);
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
93 }
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
94
231
sergey
parents: 230
diff changeset
95 sub InitSession {
239
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
96 my ($this,$user,$roles,$auth,$challenge) = @_;
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
97
254
fb52014f6931 updated web-session creation
sergey
parents: 239
diff changeset
98 my ($status,$answer);
fb52014f6931 updated web-session creation
sergey
parents: 239
diff changeset
99
fb52014f6931 updated web-session creation
sergey
parents: 239
diff changeset
100 if ($auth) {
fb52014f6931 updated web-session creation
sergey
parents: 239
diff changeset
101 ($status,$answer) = $auth->DoAuth($challenge);
fb52014f6931 updated web-session creation
sergey
parents: 239
diff changeset
102 } else {
fb52014f6931 updated web-session creation
sergey
parents: 239
diff changeset
103 $status = AUTH_SUCCESS;
fb52014f6931 updated web-session creation
sergey
parents: 239
diff changeset
104 }
239
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
105
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
106 die OperationException->new("This provider doesn't support multiround auth")
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
107 if ($status == AUTH_INCOMPLETE || $answer);
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
108
239
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
109 if ($status == AUTH_SUCCESS) {
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
110 my $sid = GenSSID();
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
111 my $cookie = GenSSID();
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
112
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
113 $this->_cookies({
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
114 sid => $sid,
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
115 sdata => $cookie
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
116 });
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
117
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
118 my $context = $this->_manager->CreateSession(
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
119 sessionId => $sid,
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
120 principal => $user,
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
121 auth => AuthSimple->Create(password => $cookie),
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
122 authority => $this,
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
123 rolesAssigned => $roles
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
124 );
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
125
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
126 $context->Apply();
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
127
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
128 }
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
129
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
130 return $status;
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
131 }
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
132
239
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
133 sub CloseSession {
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
134 my ($this) = @_;
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
135 if(my $session = SecurityContext->current) {
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
136 $this->_cookies({
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
137 sid => undef,
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
138 sdata => undef
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
139 })
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
140 }
196
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
141 }
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
142
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
143 sub WriteResponse {
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
144 my ($this,$response) = @_;
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
145
238
b8c724f6de36 DOM model refactoring
sergey
parents: 233
diff changeset
146 if (my $data = $this->_cookies) {
196
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
147
239
23daf2fae33a *security subsytem bugfixes
sergey
parents: 238
diff changeset
148 my $sign = $data->{sid} && md5_hex(
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
149 $this->salt,
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
150 $data->{sid},
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
151 $data->{sdata},
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
152 $this->salt
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
153 );
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
154
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
155 $response->cookies->{sid} = $data->{sid};
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
156 $response->cookies->{sdata} = $data->{sdata};
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
157 $response->cookies->{sign} = $sign;
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
158 }
231
sergey
parents: 230
diff changeset
159
sergey
parents: 230
diff changeset
160 return $response;
196
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
161 }
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
162
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
163 1;
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
164
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
165 __END__
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
166
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
167 =pod
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
168
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
169 =head1 NAME
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
170
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
171 C<IMPL::Web::Handler::SecureCookie>
196
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
172
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
173 =head1 DESCRIPTION
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
174
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
175 Возобновляет сессию пользователя на основе информации переданной через Cookie.
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
176
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
177 Использует механизм подписи информации для проверки верности входных данных перед
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
178 началом каких-либо действий.
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
179
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
180 Данный обработчик возвращает результат выполнения следдующего обработчика.
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
181
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
182
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 196
diff changeset
183
196
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
184 =head1 MEMBERS
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
185
231
sergey
parents: 230
diff changeset
186 =head2 C<[get,set] salt>
196
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
187
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
188 Скаляр, использующийся для подписи данных.
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
189
233
3cebcf6fdb9b refactoring, cleaning code
sergey
parents: 231
diff changeset
190
254
fb52014f6931 updated web-session creation
sergey
parents: 239
diff changeset
191 =head2 C<InitSession($user,$roles,$auth,$challenge)>
fb52014f6931 updated web-session creation
sergey
parents: 239
diff changeset
192
fb52014f6931 updated web-session creation
sergey
parents: 239
diff changeset
193 Инициирует сессию, поскольку данный модуль отвечает за взаимодействие с клиентом
fb52014f6931 updated web-session creation
sergey
parents: 239
diff changeset
194 при проверки аутентификации, ему передаются данные аутентификации для
fb52014f6931 updated web-session creation
sergey
parents: 239
diff changeset
195 продолжения обмена данными с клиентом. Если создается новая сессия, по
fb52014f6931 updated web-session creation
sergey
parents: 239
diff changeset
196 инициативе веб-приложения, то C<$auth> должно быть пусто.
196
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
197
a705e848dcc7 added IMPL::Config::Reference
cin
parents:
diff changeset
198 =cut