diff options
Diffstat (limited to 'lib/CatDap/Controller/user.pm')
| -rw-r--r-- | lib/CatDap/Controller/user.pm | 335 |
1 files changed, 335 insertions, 0 deletions
diff --git a/lib/CatDap/Controller/user.pm b/lib/CatDap/Controller/user.pm new file mode 100644 index 0000000..41fe412 --- /dev/null +++ b/lib/CatDap/Controller/user.pm @@ -0,0 +1,335 @@ +package CatDap::Controller::user; +use Moose; +use namespace::autoclean; +use Net::LDAP; +use Net::LDAP::Schema; +use Net::LDAP::Extension::SetPassword; +use Net::LDAP::Control::PasswordPolicy 0.02; +use Crypt::CBC; +use Data::Dumper; + +BEGIN {extends 'Catalyst::Controller'; } + +=head1 NAME + +CatDap::Controller::user - Catalyst Controller + +=head1 DESCRIPTION + +Catalyst Controller. + +=head1 METHODS + +=cut + +=head2 auto + +Ensure the user is logged in. In order to bind as the user, we use +CatDap::Model::User, which uses Catalyst::Model::LDAP::FromAuthentication, +which effectively requires calling $c->authenticate on every request. + +To do this, we keep the password, encrypted with blowfish, using the +(for now), first 3 octets of IPv4 request address and the session id as the key. + +So, if the user does "not exist", we authenticate them, if it succeeds we encrypt +the password and store it in the session. + +If the user is logged in, we get the encrypted password from the session, decrypt +it (we need to handle failure to decrypt it better) + +=cut + +sub auto : Private { + my ( $self, $c ) = @_; + my $cipher; + my $password; + my $mesg; + my $dn; + my $keyprefix = sprintf("%02x%02x%02x",split /\./,$c->req->address); + $c->log->info("Using $keyprefix as first part of enc key"); + if (! defined $c->user) { + $c->log->info("No session, logging user in"); + if (! $c->authenticate({ username => $c->req->param('username'), + password => $c->req->param('password') || $c->req->param('key')}) ) { + #TODO: ppolicy .... + $c->stash(errors => ['Incorrect username or password']); + $c->stash(template => 'index.tt'); + $c->forward('/index'); + $c->detach; + } else { + #if (defined $c->user->pwdReset) { + # $c->res->redirect('/user'); + #} + #$c->persist_user; + $c->log->info('Logging user in to LDAP'); + $cipher = Crypt::CBC->new( -key => $keyprefix . $c->sessionid, + -cipher => 'Blowfish' + ) or die $!; + $c->session->{enc_password} = $cipher->encrypt($c->req->param('password') || $c->req->param('key')); + $c->session->{dn} = $c->user->ldap_entry->dn; + $c->session->{user} = $c->req->param('username'); + $password = $c->req->param('password') || $c->req->param('key'); + return 1; + } + + } else { + $cipher = Crypt::CBC->new( -key => $keyprefix . $c->sessionid, + -cipher => 'Blowfish' + ) or die $!; + $password = $cipher->decrypt($c->session->{enc_password}); + $c->log->info("Re-authenticating user " . $c->session->{user}); + $c->authenticate({username => $c->session->{user},password => $password}); + $c->log->info($@) if $@; + return 1; + } + +} + +=head2 index + +=cut + +sub index :Path :Args(0) { + my ( $self, $c ) = @_; + my $cipher; + my $password; + my $mesg; + my $dn; + + if (not defined $c->user ) { + $c->stash(template => 'index.tt'); + $c->forward('/index'); + $c->detach; + } + my $schemaldap = Net::LDAP->new(${$c->config}{'Model::Proxy'}{'host'}) or warn "LDAP bind failed: $!"; + $schemaldap->start_tls if ${$c->config}{'Model::Proxy'}{'start_tls'}; + $schemaldap->bind; + my $schema = $schemaldap->schema or die ("Searching schema failed: $!"); + my $attrdef; + + my $user = $c->user->username; + my $entry; + $c->log->info("Searching for user $user"); + $mesg = $c->model('User')->search("(&(objectclass=inetOrgPerson)(uid=$user))"); + $entry = $mesg->entry; + my %mods; + my %params = %{$c->req->parameters}; + my $update = 0; + foreach my $req (keys %params) { + next if $req !~ /(.+)_new/; + my $attrname = $1; + next if $params{$attrname . '_new'} eq $params{$attrname . '_old'}; + $c->log->info("Received update request for attribute $attrname"); + $update = 1; + $attrdef = $schema->attribute($attrname) or die ("getting schema failed: $!"); + if ($$attrdef{'single-value'}) { + $entry->replace($attrname => $params{$attrname . '_new' }) or $c->log->info($!); + } else { + $entry->delete($attrname => $params{$attrname . '_old'}); + $entry->add($attrname => $params{$attrname . '_new'}); + } + if ($update) { + $mesg = $entry->update; + push @{${$c->stash}{'errors'}},$mesg->error if $mesg->code; + } + } + + + $mesg = $c->model('User')->search("(&(objectclass=inetOrgPerson)(uid=$user))"); + $c->log->info($mesg->error) if $mesg->code; + $entry = $mesg->entry; + $c->log->info($mesg->error) if $mesg->code; + + my @values; + my @attributes = $entry->attributes; + my @may; + my @addable_attrs = @attributes; + my @ocs; + my @must; + @ocs = $entry->get_value("objectClass"); + foreach my $oc (@ocs) { + foreach my $attr ($schema->must($oc)) { + push @must,$$attr{'name'} if not grep /$$attr{'name'}/,@must; + } + } + + foreach my $attr (sort @attributes) { + next if ($attr eq "objectClass"); + next if grep /$attr/,@{${$c->config}{'Controller::User'}{'skip_attrs'}}; + my @vals = $entry->get_value($attr); + $attrdef = $schema->attribute($attr) or die ("getting schema failed: $!"); + my %valhash = ( + name => $attr, + values => \@vals, + desc => $$attrdef{'desc'}, + ); + if (! grep /^$attr$/, @{${$c->config}{'Controller::User'}{'uneditable_attrs'}}) { + $valhash{'editable'} = 1; + } + if (! $$attrdef{'single-value'} && $valhash{'editable'}) { $valhash{'addable'} = 1; } + if (! grep /$attr/,@must) { $valhash{'removable'} = 1; } + push @values, \%valhash; + } + foreach my $oc (@ocs) { + foreach my $attrdef ($schema->may($oc)) { + my $attrname = $$attrdef{'name'}; + grep /$attrname/,@may or + grep /$attrname/,@attributes or + grep /$attrname/,@{${$c->config}{'Controller::User'}{'uneditable_attrs'}} or + grep /$attrname/,@{${$c->config}{'Controller::User'}{'skip_attrs'}} or + push @may, $attrname; + } + } + @may = sort @may; + $c->stash({ username => $user, + values => \@values, + attrdef => $attrdef, + may => \@may, + must => \@must, + }); +} + +sub add : Local { + my ( $self, $c) = @_; + my ($mesg,$entry,$user,$attr,$value); + $attr = $c->req->param('attribute'); + $value = $c->req->param('value'); + $user = $c->user->username; + $c->log->info("Searching for user $user"); + $mesg = $c->model('User')->search("(&(objectclass=inetOrgPerson)(uid=$user))"); + $entry = $mesg->entry; + $entry->add( $attr => $value); + $c->log->info("Adding $attr = $value to user $user"); + $entry->update; + push @{${$c->stash}{'errors'}},$mesg->error if $mesg->code; + $c->log->info($mesg->error); + $c->res->redirect('/user'); +} + +sub delete : Local : Args(2) { + my ( $self, $c, $attrname,$attrvalue) = @_; + my ($mesg,$entry,$user); + $user = $c->user->username; + $c->log->info("Searching for user $user"); + $mesg = $c->model('User')->search("(&(objectclass=inetOrgPerson)(uid=$user))"); + $entry = $mesg->entry; + $c->log->info("Deleting $attrname = $attrvalue from user $user"); + $entry->delete($attrname => $attrvalue); + $entry->update; + push @{${$c->stash}{'errors'}},$mesg->error if $mesg->code; + $c->log->info($mesg->error); + $c->res->redirect('/user'); +} + +sub password : Local { + my ( $self, $c) = @_; + my ($mesg,$newpass,$cipher); + if ( not defined $c->req->param('password') or not defined $c->req->param('newpassword1') or not defined $c->req->param('newpassword2')) { + #if ( not defined $c->req->param('newpassword1') or not defined $c->req->param('newpassword2')) { + $c->detach; + } + if ($c->req->param('newpassword1') eq $c->req->param('newpassword2')) { + $newpass = $c->req->param('newpassword1'); + } else { + push @{${$c->stash}{'errors'}},"New passwords dont match"; + } + my $pp = Net::LDAP::Control::PasswordPolicy->new; + $mesg = $c->model('User')->set_password( + oldpasswd => $c->req->param('password'), + newpasswd => $newpass, + control => [ $pp ], + ); + if ($mesg->code) { + my $perror = $mesg->error; + push @{${$c->stash}{'errors'}},"Password change failed: $perror"; + $c->detach; + } else { + # re-encrypt the new password and forward to user view + my $keyprefix = sprintf("%02x%02x%02x",split /\./,$c->req->address); + $cipher = Crypt::CBC->new( -key => $keyprefix . $c->sessionid, + -cipher => 'Blowfish' + ) or die $!; + $c->session->{enc_password} = $cipher->encrypt($newpass); + push @{${$c->stash}{'errors'}},"Password change succeeded"; + $c->res->redirect('/user'); + } + + +} + +sub firstlogin : Local { + my ( $self, $c ) = @_; + my ($mesg,$newpass,$cipher); + + if (! $c->authenticate({ + username => $c->req->param('username'), + password => $c->req->param('key')}) ) { + $c->stash(errors => ['An error occurred']); + $c->res->redirect('/user'); + } + + if ( not defined $c->req->param('newpassword1') or not defined $c->req->param('newpassword2')) { + $c->detach; + } + if ($c->req->param('newpassword1') eq $c->req->param('newpassword2')) { + $newpass = $c->req->param('newpassword1'); + } else { + push @{${$c->stash}{'errors'}},"New passwords dont match"; + } + my $pp = Net::LDAP::Control::PasswordPolicy->new; + $mesg = $c->model('User')->set_password( + #oldpasswd => $c->req->param('password'), + newpasswd => $newpass, + control => [ $pp ], + ); + if ($mesg->code) { + my $perror = $mesg->error; + push @{${$c->stash}{'errors'}},"Password change failed: $perror"; + $c->detach; + } else { + # re-encrypt the new password and forward to user view + my $keyprefix = sprintf("%02x%02x%02x",split /\./,$c->req->address); + $cipher = Crypt::CBC->new( -key => $keyprefix . $c->sessionid, + -cipher => 'Blowfish' + ) or die $!; + $c->session->{enc_password} = $cipher->encrypt($newpass); + push @{${$c->stash}{'errors'}},"Password change succeeded"; + $c->res->redirect('/user'); + } + +} + +sub login : Local { + my ( $self, $c ) = @_; + if ($c->authenticate({ username => $c->req->param('username'), + password => $c->req->param('password') || $c->req->param('key')}) ) { + $c->res->redirect('/user'); + } else { + #TODO: ppolicy .... + $c->stash(errors => ['Incorrect username or password']); + $c->stash(template => 'index.tt'); + $c->forward('/index'); + } + return $c->error; +} + +sub logout : Local { + my ( $self, $c ) = @_; + $c->delete_session; + $c->res->redirect('/'); +} + +=head1 AUTHOR + +Buchan Milne + +=head1 LICENSE + +This library is free software. You can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +__PACKAGE__->meta->make_immutable; + +1; |