package CatDap::Controller::admin; use Moose; use namespace::autoclean; use Data::UUID; #use Data::Dumper; use Net::LDAP::Extension::SetPassword; BEGIN { extends 'Catalyst::Controller'; } =head1 NAME CatDap::Controller::admin - 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 a UUID string (stored in a cookie) as the key. To access the password, an attacker would need: - the first 3 octets of IPv4 request (not stored anywhere, but accessible in server logs) - the encrpyted password (only available server-side in the session variable) - the UUID key portion (only available on the browser-side in a cookie) 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; if ($c->req->address =~ m/:/) { my $address = $c->req->address; $address =~ s/\[\]://; $keyprefix = sprintf( "%06x", $address >> 104 ); # if we shift right 104 bits from 128 we have 24 bits left or 3 bytes. } else { $keyprefix = sprintf( "%02x%02x%02x", split /\./, $c->req->address ); } if ( !defined $c->user or not $c->req->cookie('key') ) { $c->detach('/user/login') if ( not $c->req->param('username') or not $c->req->param('password') ); $c->log->debug("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->log->debug("Logging user in failed, forwarding to login page"); $c->visit('/user/login'); $c->detach; return 1; } else { #if (defined $c->user->pwdReset) { # $c->res->redirect('/user'); #} #$c->persist_user; $c->log->debug('Logging user in to LDAP'); my $ug = Data::UUID->new; my $key = $ug->create_str(); $cipher = Crypt::CBC->new( -key => $keyprefix . $key, -cipher => 'Blowfish' ) or die $!; $c->session->{enc_password} = $cipher->encrypt( $c->req->param('password') || $c->req->param('key') ); $c->stash( pages => roles2pages( $c->user->roles ) ); $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 { my $key = $c->req->cookie('key')->value; $cipher = Crypt::CBC->new( -key => $keyprefix . $key, -cipher => 'Blowfish' ) or die $!; $password = $cipher->decrypt( $c->session->{enc_password} ); $c->log->debug( "Re-authenticating user " . $c->session->{user} ); $c->authenticate( { username => $c->session->{user}, password => $password } ) or $c->view('/user/login'); $c->res->cookies->{'key'} = {value => $key, expires => '+10m'}; $c->stash( pages => roles2pages( $c->user->roles ) ); $c->log->info($@) if $@; return 1; } } sub account : Local { my ( $self, $c ) = @_; $c->detach('/user/login') if not $c->user; $c->assert_user_roles('Account Admins'); $c->stash( subpages => gensubpages('account') ); my @errors; return if not defined $c->req->param('attribute') and not defined $c->req->param('value'); #my $attribute =~ m/^([\w\d]*)/,$c->req->param('attribute'); my $attribute = $c->req->param('attribute'); $c->log->debug("Searching for account using attribute $attribute"); #my $value =~ /^[\w\d]*/,$c->req->param('attribute'); my $value = $c->req->param('value'); my $mesg = $c->model('user') ->search("(&(objectClass=inetOrgPerson)($attribute=$value))"); my @entries = $mesg->entries; push @errors, $mesg->error if $mesg->code; $c->stash( entries => \@entries ); $c->stash( errors => \@errors ); } sub account_promote : Local { my ( $self, $c ) = @_; $c->detach('/user/login') if not $c->user; $c->assert_user_roles('Account Admins'); $c->stash( subpages => gensubpages('account') ); my @errors; if ( defined $c->req->param('gid') and defined $c->req->param('username') ) { my $gid = $c->req->param('gid'); foreach my $uid ( $c->req->param('username') ) { $c->log->info("Promoting user $uid with gid $gid"); my $mesg = $c->model('user') ->search( "(&(uid=$uid)(objectclass=inetOrgPerson)(!(objectClass=posixAccount)))" ); if ( $mesg->entries gt 1 ) { push @errors, "More than one account matched user $uid"; #TODO forward to error page } my $entry = $mesg->entry; $mesg = $c->model('user')->search("(objectclass=sambaUnixIdPool)"); if ( $mesg->entries gt 1 ) { push @errors, "More than one ID Pool"; #TODO forward to error page } my $idpool = $mesg->entry; my $uidnum = $idpool->uidNumber; my $newuidnum = $uidnum+1; $entry->add( objectclass => [ 'posixAccount', 'ldapPublicKey' ], loginShell => '/bin/bash', gidNumber => $c->req->param('gid'), uidNumber => $uidnum, homeDirectory => "/home/$uid", ); $idpool->replace( uidNumber => $newuidnum ); $idpool->update; $mesg = $entry->update; if ($mesg->code) { $c->log->info('LDAP update failed: ' . $mesg->error); push @errors, $mesg->error; #reverse idpool update $idpool->replace( uidNumber => $uidnum ); $mesg = $idpool->update; $c->log->info("ERROR IdPool could not be reset to $uidnum: ", $mesg->error) if $mesg->code; } } } my $mesg = $c->model('user') ->search("(&(objectClass=inetOrgPerson)(!(objectClass=posixAccount)))"); my @entries = $mesg->entries; $c->stash( entries => \@entries ); push @errors, $mesg->error if $mesg->code; $mesg = $c->model('user')->search("(objectClass=posixGroup)"); my @groups = $mesg->entries; $c->stash( groups => \@groups ); $c->stash( errors => \@errors ); } sub account_modify : Local { my ( $self, $c, $user ) = @_; $c->detach('/user/login') if not $c->user; $c->stash( subpages => gensubpages('account') ); $c->assert_user_roles('Account Admins'); my @errors; my $mesg; if ( $user eq '' ) { $c->forward( $c->uri_for('/account') ); $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 $entry; $c->log->debug("Searching for user $user"); $mesg = $c->model('User')->search("(&(objectclass=inetOrgPerson)(uid=$user))"); $entry = $mesg->entry; # Handle adding attributes immediately here, forwarding back to ourselves if ( $c->req->param('operation') eq 'add' ) { $entry->add( $c->req->param('attribute') => $c->req->param('value') ); $mesg = $entry->update; push @errors, $mesg->error if $mesg->code; $c->res->redirect( $c->uri_for( $c->req->uri ) . "/$user" ); } 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->debug("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->debug( $mesg->error ) if $mesg->code; $entry = $mesg->entry; $c->log->debug( $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; my @available_ocs = $schema->all_objectclasses; my @offer_ocs; foreach my $oc (@available_ocs) { my $ocname = $$oc{name}; next if grep /$ocname/, @ocs; next if not $$oc{auxiliary}; push @offer_ocs, $ocname; } @offer_ocs = sort @offer_ocs; my @groups; if ( grep /posixAccount/, @offer_ocs ) { my $mesg = $c->model('user')->search('objectclass=posixGroup'); foreach my $group ( $mesg->entries ) { push @groups, { name => $group->cn, gidNumber => $group->gidNumber, }; } } $c->stash( { username => $user, values => \@values, attrdef => $attrdef, may => \@may, must => \@must, offer_ocs => \@offer_ocs, dn => $entry->dn, uid => $entry->uid, } ); $c->stash( 'groups' => \@groups ) if (@groups); } sub account_modifydel : Local { my ( $self, $c, $uid, $attr, $value ) = @_; $c->detach('/user/login') if not $c->user; $c->assert_user_roles('Account Admins'); $c->stash( subpages => gensubpages('account') ); my @errors; my $mesg; $mesg = $c->model('user')->search("(&(objectClass=inetOrgPerson)(uid=$uid))"); push @errors, $mesg->error if $mesg->code; $mesg = $mesg->entry->delete( $attr => $value )->update; push @errors, $mesg->error if $mesg->code; $c->res->redirect( $c->uri_for('/admin/account_modify') . "/$uid" ); } sub account_group : Local { my ( $self, $c, $uid ) = @_; $c->detach('/user/login') if not $c->user; $c->assert_user_roles('Account Admins'); $c->stash( subpages => gensubpages('account') ); $c->res->redirect($c->uri_for('/admin/account')) if $uid eq ''; my (@errors,@newgroups,@groups); my ($mesg,$entry,$dn); $mesg = $c->model('user')->search("(&(objectclass=inetOrgperson)(uid=$uid))"); $entry = $mesg->entry; $dn = $entry->dn; if (defined $c->req->param('op')) { my $group = $c->req->param('group'); $mesg = $c->model('user')->search("(&(objectclass=groupOfNames)(cn=$group))"); $entry = $mesg->entry; $entry->delete(member => $dn) if ($c->req->param('op') eq 'delete'); $entry->add(member => $dn) if ($c->req->param('op') eq 'add'); $mesg = $entry->update if ($entry->changes); push @errors,$mesg->error if $mesg->code; } $mesg = $c->model('user')->search("(&(objectclass=groupOfNames)(member=$dn))"); @groups = $mesg->entries; $mesg = $c->model('user')->search("(&(objectclass=groupOfNames)(!(member=$dn)))"); @newgroups = $mesg->entries; $c->stash( uid => $uid, groups => \@groups, newgroups => \@newgroups, ); } sub account_addoc : Local { my ( $self, $c ) = @_; $c->detach('/user/login') if not $c->user; $c->assert_user_roles('Account Admins'); $c->stash( subpages => gensubpages('account') ); my $objectclass = $c->req->param('objectclass') or $c->detach('/admin/group'); my $dn = $c->req->param('dn'); my $uid = $c->req->param('uid'); my ( @errors, @must, @may ); my $mesg; my $schemaldap = Net::LDAP->new( ${ $c->config }{'Model::Proxy'}{'host'} ) or warn "LDAP bind failed: $!"; $mesg = $schemaldap->start_tls if ${ $c->config }{'Model::Proxy'}{'start_tls'}; push @errors, $mesg->error if $mesg->code; $schemaldap->bind; push @errors, $mesg->error if $mesg->code; my $schema = $schemaldap->schema or die("Searching schema failed: $!"); $mesg = $c->model('user')->search("(&(objectclass=inetOrgPerson)(uid=$uid))"); $c->log->debug( $mesg->error ) if $mesg->code; my $entry = $mesg->entry; $c->log->debug( $mesg->error ) if $mesg->code; foreach my $attr ( $schema->must($objectclass) ) { push @must, $$attr{name} if not $entry->get_value( $$attr{name} ); } foreach my $attr ( $schema->may($objectclass) ) { push @may, $$attr{name} if not $entry->get_value( $$attr{name} ); } # if we have all the musts as params my $haveall = 1; foreach my $addattr (@must) { if ( defined $c->req->param($addattr) ) { $entry->add( $addattr => $c->req->param($addattr) ); } else { $c->log->debug("Missing attribute $addattr"); $haveall = 0; } } if ($haveall) { $entry->add( objectClass => [$objectclass] ); $c->log->debug("About to push updates to $dn"); #$c->log->debug( Dumper( \$entry->changes ) ); $mesg = $entry->update; push @errors, $mesg->error if $mesg->code; $c->stash( template => 'admin/account.tt', errors => @errors ); #$c->detach('account_modify'); $c->res->redirect( $c->uri_for('/admin/account_modify') . "/" . $uid ); $c->detach; } $c->stash( may => \@may, must => \@must, oc => $objectclass, dn => $dn, uid => $uid, ); } sub password : Local { my ($self,$c,$uid) = @_; $c->detach('/user/login') if not $c->user; $c->assert_user_roles('Account Admins'); $c->stash( subpages => gensubpages('account') ); my (@errors,@mail); my ($mesg,$entry,$newpass); $c->res->redirect($c->uri_for('/admin/account')) if $uid eq ''; # Find the user so we have their email now for confirmation, or can easily # set password if reset has been confirmed $mesg = $c->model('user')->search("uid=$uid"); push @errors,$mesg->error if $mesg->code; if ($mesg->entries gt 1) { push @errors,'More than one entry matched'; $c->detach; } $entry = $mesg->entry; @mail = $entry->mail; if (!$c->req->param('txnid')) { my $txnid = Data::UUID->new->create_str(); $c->session(txnid => $txnid); $c->stash( uid => $uid, txnid => $txnid, mails => @mail); return 1; } if ($c->req->param('txnid') ne $c->session->{txnid}) { push @errors,'Transaction ID mismatch'; $c->detach; } $newpass = Data::UUID->new->create_str(); my $pp = Net::LDAP::Control::PasswordPolicy->new; $mesg = $entry->replace( userPassword => $newpass,pwdReset => 'TRUE' )->update; if ($mesg->code) { push @errors,"Password reset failed: " . $mesg->error; $c->detach; } my $email = join(',',@mail); # send the mail in the users preferred language my @oldlang = $c->languages; if ($entry->preferredLanguage) { #$c->log->debug("Setting languages to: " . Dumper($entry->preferredLanguage)); $c->languages([$entry->preferredLanguage]); } $c->stash( email => { 'to' => $email, 'subject' => $c->config->{apptitle} . " - " . $c->loc('password reset'), 'from' => $c->config->{emailfrom}, 'template' => 'admin/password.tt', 'content_type' => 'text/plain', }, entry => $entry, url => $c->uri_for('/user/firstlogin') . "/?username=$uid&key=$newpass", ); $c->forward( $c->view('Email::Template') ); $c->languages(@oldlang); if ( @{ $c->error } ) { my $errors = join "\n",@{ $c->error }; $c->log->info("Sending reset 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: [_1]', $errors)); $c->error(0); # Reset the error condition if you need to } push @errors,$c->loc('Password reset and email sent'); $c->res->redirect($c->uri_for('/admin/account_modify') . "/$uid"); } sub group : Local { my ( $self, $c ) = @_; $c->detach('/user/login') if not $c->user; $c->assert_user_roles('Account Admins'); $c->stash( subpages => gensubpages('account') ); my @errors; return if not $c->req->param('attribute') and not $c->req->param('value'); my $attribute = $c->req->param('attribute'); $attribute =~ s/[^\w\d]//g; my $value = $c->req->param('value'); $value =~ s/[^\w\d\*]//g; my $mesg = $c->model('user') ->search("(&(objectclass=posixGroup)($attribute=$value))"); push @errors, $mesg->error if $mesg->code; my @entries = $mesg->entries; push @errors, $mesg->error if $mesg->code; $c->stash( entries => \@entries, errors => \@errors, ); } sub group_modify : Local { my ( $self, $c, $group ) = @_; $c->detach('/user/login') if not $c->user; $c->assert_user_roles('Account Admins'); $c->stash( subpages => gensubpages('account') ); my @errors; $c->detach('/admin/group') if $group eq ''; if ( $group !~ /^[\w\d]*$/ ) { push @errors, "Group contains illegal characters"; $c->detach('admin/group'); } my $mesg = $c->model('user')->search("(&(objectClass=posixGroup)(cn=$group))"); if ( $mesg->entries gt 1 ) { push @errors, 'More than one entry matched'; $c->detach('/admin/group'); } $c->stash( group => $mesg->entry ); } =head2 index =cut sub index : Path : Args(0) { my ( $self, $c ) = @_; $c->detach('/index') if not $c->user; $c->assert_user_roles('Account Admins'); $c->stash( pages => roles2pages( $c->user->roles ) ); #$c->response->body("Matched CatDap::Controller::admin in admin, roles $rolelist"); } sub roles2pages : Private { my @roles = @_; my @pages; foreach my $role ( sort @roles ) { if ( $role =~ /^(\w+) ?(\w*) (Admin|User)s$/ ) { my $page = lc("/$3/$1$2"); push @pages, { page => lc("/$3/$1$2"), title => "$1 $2 $3" }; } } return \@pages; } sub gensubpages : Private { my ($type) = @_; my @subpagenames; if ( $type eq 'account' ) { @subpagenames = ( { page => 'account', title => "Users" }, { page => 'account_promote', title => "Promote" }, #{ page => 'account_unlock', title => "Unlock" }, { page => 'group', title => "Groups" }, ); } return \@subpagenames; } =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;