diff options
Diffstat (limited to 'lib/CatDap/Controller')
-rw-r--r-- | lib/CatDap/Controller/Root.pm | 69 | ||||
-rw-r--r-- | lib/CatDap/Controller/register.pm | 150 | ||||
-rw-r--r-- | lib/CatDap/Controller/user.pm | 335 |
3 files changed, 554 insertions, 0 deletions
diff --git a/lib/CatDap/Controller/Root.pm b/lib/CatDap/Controller/Root.pm new file mode 100644 index 0000000..550cd61 --- /dev/null +++ b/lib/CatDap/Controller/Root.pm @@ -0,0 +1,69 @@ +package CatDap::Controller::Root; +use Moose; +use namespace::autoclean; + +BEGIN { extends 'Catalyst::Controller' } + +# +# Sets the actions in this controller to be registered with no prefix +# so they function identically to actions created in MyApp.pm +# +__PACKAGE__->config(namespace => ''); + +=head1 NAME + +CatDap::Controller::Root - Root Controller for CatDap + +=head1 DESCRIPTION + +[enter your description here] + +=head1 METHODS + +=head2 index + +The root page (/) + +=cut + +sub index :Path :Args(0) { + my ( $self, $c ) = @_; + + # Hello World + #$c->response->body( $c->welcome_message ); +} + +=head2 default + +Standard 404 error page + +=cut + +sub default :Path { + my ( $self, $c ) = @_; + $c->response->body( 'Page not found' ); + $c->response->status(404); +} + +=head2 end + +Attempt to render a view, if needed. + +=cut + +sub end : ActionClass('RenderView') {} + +=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; diff --git a/lib/CatDap/Controller/register.pm b/lib/CatDap/Controller/register.pm new file mode 100644 index 0000000..d8fc7c1 --- /dev/null +++ b/lib/CatDap/Controller/register.pm @@ -0,0 +1,150 @@ +package CatDap::Controller::register; +use Moose; +use namespace::autoclean; +use Data::Dumper; +use Email::Valid; +use Data::UUID; + +BEGIN {extends 'Catalyst::Controller'; } + +=head1 NAME + +CatDap::Controller::register - Catalyst Controller + +=head1 DESCRIPTION + +Catalyst Controller. + +=head1 METHODS + +=cut + + +=head2 index + +=cut + +sub index :Path :Args(0) : Form { + my ( $self, $c ) = @_; + + #my $form = Catalyst::Controller::HTML::FormFu->form(); + #$c->response->body('Matched CatDap::Controller::register in register.'); +} + +sub check : Local { + my ( $self, $c ) = @_; + + my %details = %{$c->request->params}; + my $username = $c->request->params->{uid}; + $username =~ s/[A-Z]/[a-z]/g; + my @errors; + $c->stash(errors => []); + # Check username, start with letter, followed by letters or numbers + if ($username !~ /^[a-z][a-z0-9_\-]*$/) { + push @errors, $c->loc('Invalid username'); + } + my $email = $c->request->params->{mail1}; + if (! Email::Valid->address($email)) { + push @errors, $c->loc('Invalid email address'); + } + if ($email ne $c->request->params->{mail2}) { + push @errors, $c->loc('Addresses do not match'); + } + if (! $c->validate_captcha($c->req->param('validate'))){ + push @errors, $c->loc('Incorrect validation text, please try again'); + } + if ($c->request->params->{gn} !~ /^\p{IsAlnum}*\z$/) { + push @errors, $c->loc('The first name supplied contains illegal characters'); + } + if ($c->request->params->{sn} !~ /^\p{IsAlnum}*\z$/) { + #push @errors, $c->loc('The') . ' ' $c->loc('surname') . ' ' . $c->loc('supplied contains unprintable characters'); + push @errors, $c->loc('The surname supplied contains illegal characters'); + } + + if (@errors gt 0) { + $c->stash(errors => \@errors); + $c->stash(template => 'register/index.tt'); + } else { + # check in LDAP now that we have validated username and email + my $mesg = $c->model('Proxy')->search("(mail=$email)"); + if ($mesg->entries ne 0) { + push @errors,$c->loc('An account already exists with this email address'); + } + $mesg = $c->model('Proxy')->search("(uid=$username)"); + if ($mesg->entries ne 0) { + my $foo = Dumper(${$c->config}{'Model::Proxy'}{'base'}); + push @errors,$c->loc('An account already exists with this username'); + #push @errors,"under base" . __PACKAGE__->config{Model::Proxy}{base}; + push @errors,$foo; + } + if (@errors gt 0) { + $c->stash(errors => \@errors); + $c->stash(template => 'register/index.tt'); + } else { + my $dn = "uid=$username,${$c->config}{'Model::Proxy'}{'base'}"; + my $ug = Data::UUID->new; + my $password = $ug->create_str(); + my $cn = $c->request->params->{gn} . " " . $c->request->params->{sn}; + $mesg = $c->model('Proxy')->add($dn, + attr => [ + objectclass => [ 'inetOrgPerson' ], + sn => $c->request->params->{sn}, + gn => $c->request->params->{gn}, + cn => $cn, + mail => $email, + pwdReset => 'TRUE', + userPassword => $password, + ] + ); + if ($mesg) { + push @errors,$mesg->error; + $c->stash(errors => \@errors); + #$c->stash(template => 'register/index.tt'); + } + #} else { + my $body; + $body .= $c->loc('Dear') . " $c->request->params->{gn},\n"; + $body .= $c->loc("Your Mageia indentity has been successfully created, but requires activation.\n"); + $body .= $c->loc("To activate your account, please follow the link below.\n"); + $body .= $c->uri_for('/user/firstlogin') . "?username=$username&key=$password"; + $c->stash->{email} = { + to => $email, + from => 'no-reply@mageia.org', + subject => $c->loc('Mageia Identity Activation'), + body => $body, + }; + + $c->forward( $c->view('Email') ); + if ( scalar( @{ $c->error } ) ) { + my $errors = join "\n",@{ $c->error }; + $c->response->body($c->loc('An error occured sending the email, but your account was created. Please try the password recovery process f you entered the correct email address: [_1]', $errors)); + $c->error(0); # Reset the error condition if you need to + } + $c->stash(template => 'register/complete.tt'); + $c->stash(message => 'Check your email'); + #} + } + } +} + +sub captcha : Local { + my ($self, $c) = @_; + return $c->create_captcha(); +} + + + +=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; 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; |