/[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 64 - (show annotations) (download)
Thu Nov 4 15:26:50 2010 UTC (13 years, 4 months ago) by buchan
File size: 14287 byte(s)
Dont use Data::Dumper

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 = sprintf("%02x%02x%02x",split /\./,$c->req->address);
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 =head2 index
116
117 =cut
118
119 sub index :Path :Args(0) {
120 my ( $self, $c ) = @_;
121 my $cipher;
122 my $password;
123 my $mesg;
124 my $dn;
125
126 if (not defined $c->user ) {
127 $c->stash(template => 'index.tt');
128 $c->forward('/index');
129 $c->detach;
130 }
131 my $schemaldap = Net::LDAP->new(${$c->config}{'Model::Proxy'}{'host'}) or warn "LDAP bind failed: $!";
132 $schemaldap->start_tls if ${$c->config}{'Model::Proxy'}{'start_tls'};
133 $schemaldap->bind;
134 my $schema = $schemaldap->schema or die ("Searching schema failed: $!");
135 my $attrdef;
136
137 my $user = $c->user->username;
138 my $entry;
139 $c->log->debug("Searching for user $user");
140 $mesg = $c->model('User')->search("(&(objectclass=inetOrgPerson)(uid=$user))");
141 $entry = $mesg->entry;
142 my %mods;
143 my %params = %{$c->req->parameters};
144 my $update = 0;
145 foreach my $req (keys %params) {
146 next if $req !~ /(.+)_new/;
147 my $attrname = $1;
148 next if $params{$attrname . '_new'} eq $params{$attrname . '_old'};
149 $c->log->info("Received update request for attribute $attrname");
150 $update = 1;
151 $attrdef = $schema->attribute($attrname) or die ("getting schema failed: $!");
152 if ($$attrdef{'single-value'}) {
153 $entry->replace($attrname => $params{$attrname . '_new' }) or $c->log->info($!);
154 } else {
155 $entry->delete($attrname => $params{$attrname . '_old'});
156 $entry->add($attrname => $params{$attrname . '_new'});
157 }
158 if ($update) {
159 $mesg = $entry->update;
160 push @{${$c->stash}{'errors'}},$mesg->error if $mesg->code;
161 }
162 }
163
164 $mesg = $c->model('User')->search("(&(objectclass=inetOrgPerson)(uid=$user))");
165 $c->log->debug($mesg->error) if $mesg->code;
166 $entry = $mesg->entry;
167 $c->log->debug($mesg->error) if $mesg->code;
168
169 my @values;
170 my @attributes = $entry->attributes;
171 my @may;
172 my @addable_attrs = @attributes;
173 my @ocs;
174 my @must;
175 @ocs = $entry->get_value("objectClass");
176 foreach my $oc (@ocs) {
177 foreach my $attr ($schema->must($oc)) {
178 push @must,$$attr{'name'} if not grep /$$attr{'name'}/,@must;
179 }
180 }
181
182 foreach my $attr (sort @attributes) {
183 next if ($attr eq "objectClass");
184 next if grep /$attr/,@{${$c->config}{'Controller::User'}{'skip_attrs'}};
185 my @vals = $entry->get_value($attr);
186 $attrdef = $schema->attribute($attr) or die ("getting schema failed: $!");
187 my %valhash = (
188 name => $attr,
189 values => \@vals,
190 desc => $$attrdef{'desc'},
191 );
192 if (! grep /^$attr$/, @{${$c->config}{'Controller::User'}{'uneditable_attrs'}}) {
193 $valhash{'editable'} = 1;
194 }
195 if (! $$attrdef{'single-value'} && $valhash{'editable'}) { $valhash{'addable'} = 1; }
196 if (! grep /$attr/,@must) { $valhash{'removable'} = 1; }
197 push @values, \%valhash;
198 }
199 foreach my $oc (@ocs) {
200 foreach my $attrdef ($schema->may($oc)) {
201 my $attrname = $$attrdef{'name'};
202 grep /$attrname/,@may or
203 grep /$attrname/,@attributes or
204 grep /$attrname/,@{${$c->config}{'Controller::User'}{'uneditable_attrs'}} or
205 grep /$attrname/,@{${$c->config}{'Controller::User'}{'skip_attrs'}} or
206 push @may, $attrname;
207 }
208 }
209 @may = sort @may;
210 $c->stash({ username => $user,
211 values => \@values,
212 attrdef => $attrdef,
213 may => \@may,
214 must => \@must,
215 });
216 $c->stash(subpages => gensubpages());
217 }
218
219 sub add : Local {
220 my ( $self, $c) = @_;
221 my ($mesg,$entry,$user,$attr,$value);
222 $attr = $c->req->param('attribute');
223 $value = $c->req->param('value');
224 $user = $c->user->username;
225 $c->log->debug("Searching for user $user");
226 $mesg = $c->model('User')->search("(&(objectclass=inetOrgPerson)(uid=$user))");
227 $entry = $mesg->entry;
228 $entry->add( $attr => $value);
229 $c->log->info("Adding $attr = $value to user $user");
230 $entry->update;
231 push @{${$c->stash}{'errors'}},$mesg->error if $mesg->code;
232 $c->log->info($mesg->error);
233 $c->res->redirect('/user');
234 }
235
236 sub delete : Local : Args(2) {
237 my ( $self, $c, $attrname,$attrvalue) = @_;
238 my ($mesg,$entry,$user);
239 $user = $c->user->username;
240 $c->log->debug("Searching for user $user");
241 $mesg = $c->model('User')->search("(&(objectclass=inetOrgPerson)(uid=$user))");
242 $entry = $mesg->entry;
243 $c->log->info("Deleting $attrname = $attrvalue from user $user");
244 $entry->delete($attrname => $attrvalue);
245 $entry->update;
246 push @{${$c->stash}{'errors'}},$mesg->error if $mesg->code;
247 $c->log->info($mesg->error);
248 $c->res->redirect('/user');
249 }
250
251 sub password : Local {
252 my ( $self, $c) = @_;
253 my ($mesg,$newpass,$cipher);
254 $c->stash(subpages => gensubpages());
255 if ( not defined $c->req->param('password') or not defined $c->req->param('newpassword1') or not defined $c->req->param('newpassword2')) {
256
257 #if ( not defined $c->req->param('newpassword1') or not defined $c->req->param('newpassword2')) {
258
259 $c->detach;
260 }
261 # Re-authenticate to check the user has the right password
262 if (not $c->authenticate({
263 'username' => $c->user->username,
264 'password' => $c->req->param('password'),
265 })
266 ) {
267 $c->stash(errors => [ $c->loc('Password incorrect') ]);
268 $c->detach;
269 }
270 if ($c->req->param('newpassword1') eq $c->req->param('newpassword2')) {
271 $newpass = $c->req->param('newpassword1');
272 } else {
273 push @{${$c->stash}{'errors'}},$c->loc('New passwords dont match');
274 $c->detach;
275 }
276 my $pp = Net::LDAP::Control::PasswordPolicy->new;
277 $mesg = $c->model('User')->set_password(
278 #oldpasswd => $c->req->param('password'),
279 newpasswd => $newpass,
280 control => [ $pp ],
281 );
282 if ($mesg->code) {
283 my $perror = $mesg->error;
284 push @{${$c->stash}{'errors'}},"Password change failed: $perror";
285 $c->detach;
286 } else {
287
288 # re-encrypt the new password and forward to user view
289 my $keyprefix = sprintf("%02x%02x%02x",split /\./,$c->req->address);
290 my $key = $c->req->cookie('key')->value;
291 $cipher = Crypt::CBC->new( -key => $keyprefix . $key,
292 -cipher => 'Blowfish'
293 ) or die $!;
294 $c->session->{enc_password} = $cipher->encrypt($newpass);
295 push @{${$c->stash}{'errors'}},"Password change succeeded";
296 #$c->res->redirect('/user');
297 }
298
299 }
300
301 sub firstlogin : Local {
302 my ( $self, $c ) = @_;
303 my ($mesg,$newpass,$cipher);
304
305 # we want to do our own authentication and caching here, as we
306 # dont want what auto does, and auto returns early for this path
307
308 if ( not defined $c->req->param('newpassword1') or not defined $c->req->param('newpassword2')) {
309 if (! $c->authenticate({
310 username => $c->req->param('username'),
311 password => $c->req->param('key')}) ) {
312 $c->stash(errors => ['An error occurred']);
313 $c->log->info("Failed to authenticate user in first login: " . $c->req->param('key'));
314 $c->res->redirect('/user');
315 }
316 # cache password for next request with form data
317 my $keyprefix = sprintf("%02x%02x%02x",split /\./,$c->req->address);
318 my $key = Data::UUID->new->create_str();
319 $cipher = Crypt::CBC->new( -key => $keyprefix . $key,
320 -cipher => 'Blowfish'
321 ) or die $!;
322 $c->session->{enc_password} = $cipher->encrypt($c->req->param('key'));
323 $c->response->cookies->{'key'} = { value => $key, expires => '+10m' };
324 $c->detach;
325 }
326
327 if ($c->req->param('newpassword1') eq $c->req->param('newpassword2')) {
328 $newpass = $c->req->param('newpassword1');
329 } else {
330 push @{${$c->stash}{'errors'}},"New passwords dont match";
331 }
332
333 #Re-authenticate user
334 my $keyprefix = sprintf("%02x%02x%02x",split /\./,$c->req->address);
335 my $key = $c->req->cookie('key')->value;
336 $cipher = Crypt::CBC->new( -key => $keyprefix . $key,
337 -cipher => 'Blowfish'
338 ) or die $!;
339 my $password = $cipher->decrypt($c->session->{enc_password});
340 $c->authenticate({username => $c->req->param('username'),password => $password})
341 or $c->log->info("Authenticating user for first password change failed");
342
343 my $pp = Net::LDAP::Control::PasswordPolicy->new;
344 $mesg = $c->model('User')->set_password(
345
346 #oldpasswd => $c->req->param('password'),
347 newpasswd => $newpass,
348 control => [ $pp ],
349 );
350 if ($mesg->code) {
351 my $perror = $mesg->error;
352 push @{${$c->stash}{'errors'}},"Password change failed: $perror";
353 $c->detach;
354 }
355
356 # re-encrypt the new password and redirect to user view
357 $cipher = Crypt::CBC->new( -key => $keyprefix . $key,
358 -cipher => 'Blowfish'
359 ) or die $!;
360 $c->session->{enc_password} = $cipher->encrypt($newpass);
361 $c->authenticate({username => $c->req->param('username'),password => $newpass});
362 push @{${$c->stash}{'errors'}},"Password change succeeded";
363 $c->res->redirect('/user');
364
365 }
366
367 sub login : Local {
368 my ( $self, $c ) = @_;
369 if ($c->authenticate({ username => $c->req->param('username'),
370 password => $c->req->param('password') || $c->req->param('key')}) ) {
371 $c->res->redirect('/user');
372 } else {
373
374 #TODO: ppolicy ....
375 $c->stash(errors => ['Incorrect username or password']);
376 $c->stash(template => 'index.tt');
377 $c->forward('/index');
378 }
379 return $c->error;
380 }
381
382 sub logout : Local {
383 my ( $self, $c ) = @_;
384 $c->delete_session;
385 $c->res->redirect('/');
386 }
387
388 sub roles2pages : Private {
389 my @roles = @_;
390 my @pages;
391 foreach my $role (sort @roles) {
392 if ($role =~ /^(\w+) ?(\w*) (Admin)s$/) {
393 my $page = lc("/$3/$1$2");
394 push @pages,{ page => lc("/$3/$1$2"), title => "$1 $2 $3"};
395 }
396 }
397 return \@pages;
398 }
399
400 sub gensubpages : Private {
401 my ($type) = @_;
402 my @subpagenames;
403 @subpagenames = (
404 { page => './', title => 'Edit'},
405 { page => 'password', title => 'Change password'},
406 );
407 return \@subpagenames;
408 }
409
410 =head1 AUTHOR
411
412 Buchan Milne
413
414 =head1 LICENSE
415
416 This library is free software. You can redistribute it and/or modify
417 it under the same terms as Perl itself.
418
419 =cut
420
421 __PACKAGE__->meta->make_immutable;
422
423 1;

  ViewVC Help
Powered by ViewVC 1.1.30