package CatDap::Controller::register; use Moose; use namespace::autoclean; 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 = lc($c->request->params->{uid}); 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 ( ! open( my $etcpasswd, "/etc/passwd")) { push @errors, $c->loc('Cannot check /etc/passwd, please warn system administrators'); } else { if ( grep { /^$username:/ } <$etcpasswd> ) { push @errors, $c->loc('Invalid username, already used by system'); } close($etcpasswd); } if ( grep /^$username$/, @{${$c->config}{'register'}{'login_blacklist'}}) { push @errors, $c->loc('Username is not authorized to be used'); } if ($c->request->params->{gn} !~ /^\p{IsAlnum}+$/) { push @errors, $c->loc( 'The first name supplied contains illegal characters' ); } if ($c->request->params->{sn} !~ /^\p{IsAlnum}+$/) { push @errors, $c->loc( 'The surname supplied contains illegal characters' ); } if (@errors) { $c->stash(errors => \@errors); $c->stash(template => 'register/index.tt'); return; } # check in LDAP now that we have validated username and email my $mesg = $c->model('Proxy')->search("(mail=$email)"); if ($mesg->entries()) { push @errors,$c->loc( 'An account already exists with this email address' ); } $mesg = $c->model('Proxy')->search("(uid=$username)"); if ($mesg->entries()) { push @errors,$c->loc('An account already exists with this username'); } if (@errors) { $c->stash(errors => \@errors); $c->stash(template => 'register/index.tt'); return; } 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}; $c->log->info("Creating account for user $username"); $c->log->debug("Preferred language: " . ${$c->languages}[0]); $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, preferredLanguage => ${$c->languages}[0], ] ); if ($mesg->code) { push @errors,$mesg->error; $c->log->info( sprintf("Creating DN $dn failed: %s", $mesg->error) ); $c->stash(errors => \@errors); #$c->stash(template => 'register/index.tt'); } $c->stash( email => { 'to' => $email, 'from' => ${$c->config}{'emailfrom'}, 'subject' => ${$c->config}{'apptitle'} . " - " . $c->loc('Activation'), 'template' => 'activation.tt', }, cn => $cn, url => $c->uri_for('/user/firstlogin') . "?username=$username&key=$password", ); $c->log->info("Sending activation mail for user $username to $email"); $c->forward( $c->view('Email::Template') ); if ( @{ $c->error } ) { my $errors = join "\n",@{ $c->error }; $c->log->info("Sending activation mail to $email failed: $errors"); $c->response->body($c->loc('An error occured sending the email, but your account was created. Please try the password recovery process if you entered the correct email address. Errors [_1]', $errors)); $c->error(0); # Reset the error condition if you need to } $c->stash(template => 'register/complete.tt'); } 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;