From 41074cf0bc2da78eaffef8eca757a76d5e08fc34 Mon Sep 17 00:00:00 2001 From: Buchan Milne Date: Wed, 3 Nov 2010 09:37:24 +0000 Subject: Add some account admin features --- catdap.yml | 8 +- lib/CatDap/Controller/admin.pm | 559 +++++++++++++++++++++++++++++++++++++++++ root/admin/account.tt | 47 ++++ root/admin/account_addoc.tt | 27 ++ root/admin/account_group.tt | 24 ++ root/admin/account_modify.tt | 66 +++++ root/admin/account_promote.tt | 34 +++ root/admin/group.tt | 38 +++ root/admin/group_modify.tt | 22 ++ root/admin/index.tt | 1 + t/controller_admin.t | 9 + 11 files changed, 831 insertions(+), 4 deletions(-) create mode 100644 lib/CatDap/Controller/admin.pm create mode 100644 root/admin/account.tt create mode 100644 root/admin/account_addoc.tt create mode 100644 root/admin/account_group.tt create mode 100644 root/admin/account_modify.tt create mode 100644 root/admin/account_promote.tt create mode 100644 root/admin/group.tt create mode 100644 root/admin/group_modify.tt create mode 100644 root/admin/index.tt create mode 100644 t/controller_admin.t diff --git a/catdap.yml b/catdap.yml index 3e12daa..75406cf 100644 --- a/catdap.yml +++ b/catdap.yml @@ -74,10 +74,10 @@ Controller::User: - uid # - uidNumber # - gidNumber - - homeDirectory - - host - - manager - - krb5PrincipalName + # - homeDirectory + # - host + # - manager + # - krb5PrincipalName # List of attributes which are not displayed at all in the user view skip_attrs: - objectClass diff --git a/lib/CatDap/Controller/admin.pm b/lib/CatDap/Controller/admin.pm new file mode 100644 index 0000000..99e011a --- /dev/null +++ b/lib/CatDap/Controller/admin.pm @@ -0,0 +1,559 @@ +package CatDap::Controller::admin; +use Moose; +use namespace::autoclean; +use Data::UUID; +use Data::Dumper; + +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 = sprintf( "%02x%02x%02x", split /\./, $c->req->address ); + if ( !defined $c->user ) { + $c->detach('/user/login') + if ( not $c->req->param('username') + or not $c->req->param('password') ); + $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->log->info("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->info('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->info( "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->info("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++; + $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 or $c->log->info("LDAP update failed: $!"); + if ($mesg->code) { + 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"); + } + } + } + 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->info("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->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; + 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->info( $mesg->error ) if $mesg->code; + my $entry = $mesg->entry; + $c->log->info( $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->info("Missing attribute $addattr"); + $haveall = 0; + } + } + if ($haveall) { + $entry->add( objectClass => [$objectclass] ); + $c->log->info("About to push updates to $dn"); + $c->log->info( 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 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->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; diff --git a/root/admin/account.tt b/root/admin/account.tt new file mode 100644 index 0000000..b00b8a4 --- /dev/null +++ b/root/admin/account.tt @@ -0,0 +1,47 @@ +
+ + + + + + +
+Search by + + +
+
+[% IF entries %] + + + + + + +[% FOREACH entry IN entries %] + + + + + + + +[% END %] +
UsernameEmailFirst NameSurname +Full Name +
[% entry.uid %][% entry.mail %][% entry.givenName %][% entry.sn %][% entry.cn %]
+[% END %] + + diff --git a/root/admin/account_addoc.tt b/root/admin/account_addoc.tt new file mode 100644 index 0000000..771ac8d --- /dev/null +++ b/root/admin/account_addoc.tt @@ -0,0 +1,27 @@ +Adding objectclass [% oc %] to dn [% dn %] +
+ + + + + + + + +[% FOREACH attr IN must %] +[% IF attr != "objectClass" %] + + + + +[% END %] +[% END %] +[% FOREACH attr IN may %] + + + + +[% END %] +
AttributeValue
[% attr %]*
[% attr %]
+ + diff --git a/root/admin/account_group.tt b/root/admin/account_group.tt new file mode 100644 index 0000000..3b04992 --- /dev/null +++ b/root/admin/account_group.tt @@ -0,0 +1,24 @@ +Add user [% uid %] to a new group: + + + + + + +
+ +Delete user [% uid %] from an existing group: +
+ + + + +
diff --git a/root/admin/account_modify.tt b/root/admin/account_modify.tt new file mode 100644 index 0000000..6a1ecc8 --- /dev/null +++ b/root/admin/account_modify.tt @@ -0,0 +1,66 @@ +Reset password +Groups + +
+ + + +[% FOREACH attr IN values %] + + + + +[% END %] + +
AttributeValue
[% attr.name %][% FOREACH val IN attr.values %][% IF attr.editable %][% ELSE %][% val %]
[% END %] +[% IF attr.addable AND attr.editable %]Add[% END %] +[% IF attr.removable AND attr.editable %]Delete[% END %] + [% END %]
+
+ + + + + +[% IF groups %] + + + +[% END %] + + + +
+
+ + Add attribute + + with value + + +
+
+Promote user to posixAccount with primary group: +
+ + + +
+
+
+ + + + +
+
diff --git a/root/admin/account_promote.tt b/root/admin/account_promote.tt new file mode 100644 index 0000000..fd6400e --- /dev/null +++ b/root/admin/account_promote.tt @@ -0,0 +1,34 @@ +
+ + + + + + + +[% FOREACH entry IN entries %] + + + + + + + +[% END %] +
SelectUsernameEmailFirst NameSurname +Full Name +
+[% entry.uid %][% entry.mail %][% entry.givenName %][% entry.sn %][% entry.cn %]
+ + + + + +
Primary group + +
+
diff --git a/root/admin/group.tt b/root/admin/group.tt new file mode 100644 index 0000000..50c6bde --- /dev/null +++ b/root/admin/group.tt @@ -0,0 +1,38 @@ +
+ + + + + + +
+Search by + + +
+
+[% IF entries %] + + + + +[% FOREACH entry IN entries %] + + + + +[% END %] +
Group Name
[% entry.cn %][% entry.cn %]
+[% END %] + + diff --git a/root/admin/group_modify.tt b/root/admin/group_modify.tt new file mode 100644 index 0000000..01520d5 --- /dev/null +++ b/root/admin/group_modify.tt @@ -0,0 +1,22 @@ +
+ + + + + + +[% FOREACH attr IN group.attributes %] + + + + +[% END %] +
AttributeValue
+[% attr %] + +[% FOREACH value IN group.get_value(attr) %] +[% value %] delete
+[% END %] + + +
diff --git a/root/admin/index.tt b/root/admin/index.tt new file mode 100644 index 0000000..a603c30 --- /dev/null +++ b/root/admin/index.tt @@ -0,0 +1 @@ +Please use the menus above diff --git a/t/controller_admin.t b/t/controller_admin.t new file mode 100644 index 0000000..1ee0b0a --- /dev/null +++ b/t/controller_admin.t @@ -0,0 +1,9 @@ +use strict; +use warnings; +use Test::More; + +BEGIN { use_ok 'Catalyst::Test', 'CatDap' } +BEGIN { use_ok 'CatDap::Controller::admin' } + +ok( request('/admin')->is_success, 'Request should succeed' ); +done_testing(); -- cgit v1.2.1