/[soft]/identity/CatDap/trunk/lib/CatDap/Controller/user.pm
ViewVC logotype

Contents of /identity/CatDap/trunk/lib/CatDap/Controller/user.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1807 - (show annotations) (download)
Wed Jul 27 16:53:34 2011 UTC (8 years, 8 months ago) by rda
File size: 15323 byte(s)
code layout
1 package CatDap::Controller::user;
2 use Moose;
3 use namespace::autoclean;
4 use Net::LDAP;
5 use Net::LDAP::Schema;
6 use Net::LDAP::Extension::SetPassword;
7 use Net::LDAP::Control::PasswordPolicy 0.02;
8 use Crypt::CBC;
9 use Data::UUID;
10 #use Data::Dumper;
11
12 BEGIN {extends 'Catalyst::Controller'; }
13
14 =head1 NAME
15
16 CatDap::Controller::user - Catalyst Controller
17
18 =head1 DESCRIPTION
19
20 Catalyst Controller.
21
22 =head1 METHODS
23
24 =cut
25
26 =head2 auto
27
28 Ensure the user is logged in. In order to bind as the user, we use
29 CatDap::Model::User, which uses Catalyst::Model::LDAP::FromAuthentication,
30 which effectively requires calling $c->authenticate on every request.
31
32 To do this, we keep the password, encrypted with blowfish, using the
33 (for now), first 3 octets of IPv4 request address and a UUID string (stored in
34 a cookie) as the key. To access the password, an attacker would need:
35 - the first 3 octets of IPv4 request (not stored anywhere, but accessible
36 in server logs)
37 - the encrpyted password (only available server-side in the session variable)
38 - the UUID key portion (only available on the browser-side in a cookie)
39
40 So, if the user does "not exist", we authenticate them, if it succeeds we encrypt
41 the password and store it in the session.
42
43 If the user is logged in, we get the encrypted password from the session, decrypt
44 it (we need to handle failure to decrypt it better)
45
46 =cut
47
48 sub auto : Private {
49 my ( $self, $c ) = @_;
50 if ($c->req->path eq 'user/firstlogin') {
51 return 1;
52 }
53 my $cipher;
54 my $password;
55 my $mesg;
56 my $dn;
57 my @errors;
58 my $keyprefix = $self->get_keyprefix($c);
59 if (! defined $c->user or not $c->req->cookie('key')) {
60 if (not $c->req->param('password')) {
61 push @errors,$c->loc('Your session has expired');
62 $c->stash(template => 'index.tt',errors => \@errors);
63 $c->detach;
64 }
65
66 $c->log->debug("No session, logging user in");
67 if (! $c->authenticate({ username => $c->req->param('username'),
68 password => $c->req->param('password') || $c->req->param('key')}) ) {
69
70 #TODO: ppolicy ....
71 $c->stash(errors => ['Incorrect username or password']);
72 $c->stash(template => 'index.tt');
73
74 #$c->forward('/index');
75 $c->detach('/user/login');
76 } else {
77
78 #if (defined $c->user->pwdReset) {
79 # $c->res->redirect('/user');
80 #}
81 #$c->persist_user;
82 $c->log->debug('Logging user in to LDAP');
83
84 my $ug = Data::UUID->new;
85 my $key = $ug->create_str();
86 $cipher = Crypt::CBC->new( -key => $keyprefix . $key,
87 -cipher => 'Blowfish'
88 ) or die $!;
89 $c->session->{enc_password} = $cipher->encrypt($c->req->param('password') || $c->req->param('key'));
90 $c->response->cookies->{'key'} = { value => $key, expires => '+10m' };
91 $c->stash(pages => roles2pages($c->user->roles));
92 $c->session->{dn} = $c->user->ldap_entry->dn;
93 $c->session->{user} = $c->req->param('username');
94 $password = $c->req->param('password') || $c->req->param('key');
95 return 1;
96 }
97
98 } else {
99 my $key = $c->req->cookie('key')->value;
100 $cipher = Crypt::CBC->new( -key => $keyprefix . $key,
101 -cipher => 'Blowfish'
102 ) or die $!;
103 $password = $cipher->decrypt($c->session->{enc_password});
104 $c->log->debug("Re-authenticating user " . $c->user->username);
105 $c->authenticate({username => $c->user->username,password => $password});
106 $c->res->cookies->{'key'} = {value => $key, expires => '+10m'};
107
108 $c->stash(pages => roles2pages($c->user->roles));
109 $c->log->info($@) if $@;
110 return 1;
111 }
112
113 }
114
115 sub get_keyprefix : Private {
116 my ( $self, $c ) = @_;
117 my $keyprefix;
118 if ($c->req->address =~ m/:/) {
119 my $address = $c->req->address;
120 $address =~ s/\[\]://;
121
122 # if we shift right 104 bits from 128 we have 24 bits left or 3 bytes.
123 $keyprefix = sprintf( "%06x", $address >> 104 );
124 }
125 else {
126 $keyprefix = sprintf( "%02x%02x%02x", split /\./, $c->req->address );
127 }
128 return $keyprefix;
129 }
130
131 =head2 index
132
133 =cut
134
135 sub index :Path :Args(0) {
136 my ( $self, $c ) = @_;
137 my $cipher;
138 my $password;
139 my $mesg;
140 my $dn;
141 my $userfilter;
142
143 if (not defined $c->user ) {
144 $c->stash(template => 'index.tt');
145 $c->forward('/index');
146 $c->detach;
147 }
148 my $schemaldap = Net::LDAP->new(${$c->config}{'Model::Proxy'}{'host'}) or warn "LDAP bind failed: $!";
149 $schemaldap->start_tls if ${$c->config}{'Model::Proxy'}{'start_tls'};
150 $schemaldap->bind;
151 my $schema = $schemaldap->schema or die ("Searching schema failed: $!");
152 my $attrdef;
153
154 my $user = $c->user->username;
155 my $entry;
156 $userfilter = $c->user->store->user_filter;
157 $userfilter =~ s/\%s/$user/g,
158 $c->log->debug("Searching for user $user with filter $userfilter");
159 $mesg = $c->model('User')->search($userfilter);
160 $entry = $mesg->entry;
161 my %mods;
162 my %params = %{$c->req->parameters};
163 my $update = 0;
164 foreach my $req (keys %params) {
165 next if $req !~ /(.+)_new/;
166 my $attrname = $1;
167 next if $params{$attrname . '_new'} eq $params{$attrname . '_old'};
168 $c->log->info("Received update request for attribute $attrname");
169 $update = 1;
170 $attrdef = $schema->attribute($attrname) or die ("getting schema failed: $!");
171 if ($$attrdef{'single-value'}) {
172 $entry->replace($attrname => $params{$attrname . '_new' }) or $c->log->info($!);
173 } else {
174 $entry->delete($attrname => $params{$attrname . '_old'});
175 $entry->add($attrname => $params{$attrname . '_new'});
176 }
177 if ($update) {
178 $mesg = $entry->update;
179 push @{${$c->stash}{'errors'}},$mesg->error if $mesg->code;
180 }
181 }
182
183 $mesg = $c->model('User')->search($userfilter);
184 $c->log->debug($mesg->error) if $mesg->code;
185 $entry = $mesg->entry;
186 $c->log->debug($mesg->error) if $mesg->code;
187
188 my @values;
189 my @attributes = $entry->attributes;
190 my @may;
191 my @addable_attrs = @attributes;
192 my @ocs;
193 my @must;
194 @ocs = $entry->get_value("objectClass");
195 foreach my $oc (@ocs) {
196 foreach my $attr ($schema->must($oc)) {
197 push @must,$$attr{'name'} if not grep /$$attr{'name'}/,@must;
198 }
199 }
200
201 foreach my $attr (sort @attributes) {
202 next if ($attr eq "objectClass");
203 next if grep /$attr/,@{${$c->config}{'Controller::User'}{'skip_attrs'}};
204 my @vals = $entry->get_value($attr);
205 foreach (@vals) { $_ = Encode::decode_utf8( $_ ); }
206 $attrdef = $schema->attribute($attr) or die ("getting schema failed: $!");
207 my %valhash = (
208 name => $attr,
209 values => \@vals,
210 desc => $$attrdef{'desc'},
211 );
212 if (! grep /^$attr$/, @{${$c->config}{'Controller::User'}{'uneditable_attrs'}}) {
213 $valhash{'editable'} = 1;
214 }
215 if (! $$attrdef{'single-value'} && $valhash{'editable'}) { $valhash{'addable'} = 1; }
216 if (! grep /$attr/,@must) { $valhash{'removable'} = 1; }
217 push @values, \%valhash;
218 }
219 foreach my $oc (@ocs) {
220 foreach my $attrdef ($schema->may($oc)) {
221 my $attrname = $$attrdef{'name'};
222 grep /$attrname/,@may or
223 grep /$attrname/,@attributes or
224 grep /$attrname/,@{${$c->config}{'Controller::User'}{'uneditable_attrs'}} or
225 grep /$attrname/,@{${$c->config}{'Controller::User'}{'skip_attrs'}} or
226 grep /$attrname/,@{${$c->config}{'Controller::User'}{'editable_attrs'}} and
227 push @may, $attrname;
228 }
229 }
230 @may = sort @may;
231 $c->stash({ username => $user,
232 values => \@values,
233 attrdef => $attrdef,
234 may => \@may,
235 must => \@must,
236 });
237 $c->stash(subpages => gensubpages());
238 }
239
240 sub add : Local {
241 my ( $self, $c) = @_;
242 my $attr = $c->req->param('attribute');
243 my $value = $c->req->param('value');
244 my $user = $c->user->username;
245 my $userfilter = sprintf($c->user->store->user_filter ,$c->user->username);
246 $c->log->debug("Searching for user $user with $userfilter");
247 my $mesg = $c->model('User')->search($userfilter);
248 my $entry = $mesg->entry;
249 $entry->add( $attr => $value);
250 $c->log->info("Adding $attr = $value to user $user");
251 $mesg = $entry->update;
252 push @{${$c->stash}{'errors'}},$mesg->error if $mesg->code;
253 $c->log->info($mesg->error);
254 $c->res->redirect('/user');
255 }
256
257 sub delete : Local : Args(2) {
258 my ( $self, $c, $attrname,$attrvalue) = @_;
259 my ($mesg,$entry,$user,$userfilter);
260 $user = $c->user->username;
261 $userfilter = $c->user->store->user_filter;
262 $userfilter =~ s/%s/$user/g;
263 $c->log->debug("Searching for user $user with filter $userfilter");
264 $mesg = $c->model('User')->search($userfilter);
265 push @{${$c->stash}{'errors'}},$mesg->error if $mesg->code;
266 $c->log->info($mesg->error) if $mesg->code;
267 $entry = $mesg->entry;
268 $c->log->info("Deleting $attrname: $attrvalue from dn " . $entry->dn);
269 $entry->delete($attrname => $attrvalue);
270 $mesg = $entry->update;
271 push @{${$c->stash}{'errors'}},$mesg->error if $mesg->code;
272 $c->log->info("Result of update: " . $mesg->error . "," . $mesg->code) if $mesg->code;
273 $c->res->redirect('/user') unless $mesg->code;
274 $c->stash({ attrname => $attrname, attrvalue => $attrvalue});
275 }
276
277 sub password : Local {
278 my ( $self, $c) = @_;
279 my ($mesg,$newpass,$cipher);
280 $c->stash(subpages => gensubpages());
281 if ( not defined $c->req->param('password') or not defined $c->req->param('newpassword1') or not defined $c->req->param('newpassword2')) {
282 #if ( not defined $c->req->param('newpassword1') or not defined $c->req->param('newpassword2')) {
283
284 $c->detach;
285 }
286 # Re-authenticate to check the user has the right password
287 if (not $c->authenticate({
288 'username' => $c->user->username,
289 'password' => $c->req->param('password'),
290 })
291 ) {
292 $c->stash(errors => [ $c->loc('Password incorrect') ]);
293 $c->detach;
294 }
295 if ($c->req->param('newpassword1') eq $c->req->param('newpassword2')) {
296 $newpass = $c->req->param('newpassword1');
297 } else {
298 push @{${$c->stash}{'errors'}},$c->loc('New passwords dont match');
299 $c->detach;
300 }
301 my $pp = Net::LDAP::Control::PasswordPolicy->new;
302 $mesg = $c->model('User')->set_password(
303 #oldpasswd => $c->req->param('password'),
304 newpasswd => $newpass,
305 control => [ $pp ],
306 );
307 if ($mesg->code) {
308 my $perror = $mesg->error;
309 push @{${$c->stash}{'errors'}},"Password change failed: $perror";
310 $c->detach;
311 } else {
312
313 # re-encrypt the new password and forward to user view
314 my $keyprefix = $self->get_keyprefix($c);
315 my $key = $c->req->cookie('key')->value;
316 $cipher = Crypt::CBC->new( -key => $keyprefix . $key,
317 -cipher => 'Blowfish'
318 ) or die $!;
319 $c->session->{enc_password} = $cipher->encrypt($newpass);
320 push @{${$c->stash}{'errors'}},"Password change succeeded";
321 #$c->res->redirect('/user');
322 }
323
324 }
325
326 sub firstlogin : Local {
327 my ( $self, $c ) = @_;
328 my ($mesg,$newpass,$cipher);
329
330 # we want to do our own authentication and caching here, as we
331 # dont want what auto does, and auto returns early for this path
332
333 if ( not defined $c->req->param('newpassword1') or not defined $c->req->param('newpassword2')) {
334 if (! $c->authenticate({
335 username => $c->req->param('username'),
336 password => $c->req->param('key')}) ) {
337 $c->stash(errors => ['An error occurred']);
338 $c->log->info("Failed to authenticate user in first login: " . $c->req->param('key'));
339 $c->res->redirect('/user');
340 }
341 # cache password for next request with form data
342 my $keyprefix = $self->get_keyprefix($c);
343 my $key = Data::UUID->new->create_str();
344 $cipher = Crypt::CBC->new( -key => $keyprefix . $key,
345 -cipher => 'Blowfish'
346 ) or die $!;
347 $c->session->{enc_password} = $cipher->encrypt($c->req->param('key'));
348 $c->response->cookies->{'key'} = { value => $key, expires => '+10m' };
349 $c->detach;
350 }
351
352 if ($c->req->param('newpassword1') eq $c->req->param('newpassword2')) {
353 $newpass = $c->req->param('newpassword1');
354 } else {
355 push @{${$c->stash}{'errors'}},"New passwords dont match";
356 }
357
358 #Re-authenticate user
359 my $keyprefix = $self->get_keyprefix($c);
360 my $key = $c->req->cookie('key')->value;
361 $cipher = Crypt::CBC->new( -key => $keyprefix . $key,
362 -cipher => 'Blowfish'
363 ) or die $!;
364 my $password = $cipher->decrypt($c->session->{enc_password});
365 $c->authenticate({username => $c->req->param('username'),password => $password})
366 or $c->log->info("Authenticating user for first password change failed");
367
368 my $pp = Net::LDAP::Control::PasswordPolicy->new;
369 $mesg = $c->model('User')->set_password(
370
371 #oldpasswd => $c->req->param('password'),
372 newpasswd => $newpass,
373 control => [ $pp ],
374 );
375 if ($mesg->code) {
376 my $perror = $mesg->error;
377 push @{${$c->stash}{'errors'}},"Password change failed: $perror";
378 $c->detach;
379 }
380
381 # re-encrypt the new password and redirect to user view
382 $cipher = Crypt::CBC->new( -key => $keyprefix . $key,
383 -cipher => 'Blowfish'
384 ) or die $!;
385 $c->session->{enc_password} = $cipher->encrypt($newpass);
386 $c->authenticate({username => $c->req->param('username'),password => $newpass});
387 push @{${$c->stash}{'errors'}},"Password change succeeded";
388 $c->res->redirect('/user');
389
390 }
391
392 sub login : Local {
393 my ( $self, $c ) = @_;
394 if ($c->authenticate({ username => $c->req->param('username'),
395 password => $c->req->param('password') || $c->req->param('key')}) ) {
396 $c->res->redirect('/user');
397 } else {
398
399 #TODO: ppolicy ....
400 $c->stash(errors => ['Incorrect username or password']);
401 $c->stash(template => 'index.tt');
402 $c->forward('/index');
403 }
404 return $c->error;
405 }
406
407 sub logout : Local {
408 my ( $self, $c ) = @_;
409 $c->delete_session;
410 $c->res->redirect('/');
411 }
412
413 sub roles2pages : Private {
414 my @roles = @_;
415 my @pages;
416 foreach my $role (sort @roles) {
417 if ($role =~ /^(\w+) ?(\w*) (Admin)s$/) {
418 my $page = lc("/$3/$1$2");
419 push @pages,{ page => lc("/$3/$1$2"), title => "$1 $2 $3"};
420 }
421 }
422 return \@pages;
423 }
424
425 sub gensubpages : Private {
426 my ($type) = @_;
427 my @subpagenames;
428 @subpagenames = (
429 { page => './', title => 'Edit'},
430 { page => 'password', title => 'Change password'},
431 );
432 return \@subpagenames;
433 }
434
435 =head1 AUTHOR
436
437 Buchan Milne
438
439 =head1 LICENSE
440
441 This library is free software. You can redistribute it and/or modify
442 it under the same terms as Perl itself.
443
444 =cut
445
446 __PACKAGE__->meta->make_immutable;
447
448 1;

  ViewVC Help
Powered by ViewVC 1.1.26