path: root/lib/CatDap/Controller/admin.pm

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;

    # TODO merge this code with the one in user.pm
    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 @orig_entries = $mesg->entries;
    my @entries;
    foreach my $entry (@orig_entries) {
	my %new_entry;
	foreach my $attr ($entry->attributes) {
	    $new_entry{$attr} = Encode::decode_utf8($entry->get_value($attr));
	}
	push @entries, \%new_entry;
    }
    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;
    my @promoted;
    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, $c->loc("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;
	    } else {
		push @promoted, $uid; 
	    }
        }
    }
    my $mesg =
      $c->model('user')
      ->search("(&(objectClass=inetOrgPerson)(!(objectClass=posixAccount)))");
    my @orig_entries = $mesg->entries;
    my @entries;
    foreach my $entry (@orig_entries) {
	my %new_entry;
        foreach my $attr($entry->attributes) {
            $new_entry{$attr} = Encode::decode_utf8($entry->get_value($attr));
        }
        push @entries, \%new_entry;
    }
    @entries = sort { $a->{'uid'} cmp $b->{'uid'} } @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 );
    $c->stash( promoted => \@promoted );
}

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);
	foreach (@vals) { $_ = Encode::decode_utf8( $_ ); }
        $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, $c->loc('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, $c->loc('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, $c->loc("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;
    my $mainrole;
    if ( $c->check_user_roles('Account Admins') ) {
	$mainrole = 'account';
    }
    elsif ( $c->check_user_roles('Group Admins') ) {	
        $mainrole = 'group';
    }
    else {
	$c->forward('/user');
    }
    #$c->assert_any_user_role({['Account Admins','Group Admins']});
    #$mainrole = 'account' if $c->check_user_roles('Account Admins');
    $c->stash( subpages => gensubpages($mainrole) );
    my @errors;
    my ($attribute,$value);
    if ( not $c->req->param('attribute') and not $c->req->param('value') ) {
	$attribute = 'owner';
	$value = $c->user->ldap_entry->dn;
	$c->stash( heading => $c->loc('Groups you manage'));
    }
    else {
        $attribute = $c->req->param('attribute');
        $attribute =~ s/[^\w\d]//g;
        $value = $c->req->param('value');
        $value =~ s/[^\w\d\* ]//g;
	$c->stash( heading => $c->loc('Groups matching search criteria'));
    }
    my $mesg =
      $c->model('user')
      ->search("(&(objectclass=groupOfNames)($attribute=$value))");
    push @errors, $mesg->error if $mesg->code;
    my @entries = $mesg->entries if ($mesg->entries ge 1);
    push @errors, $mesg->error if $mesg->code;
    $c->stash( entries => \@entries ) if (@entries);
    $c->stash( errors  => \@errors);
}

sub group_modify : Local {
    my ( $self, $c, $group, $op, $attr, $value ) = @_;

    $c->detach('/user/login') if not $c->user;

    my $mainrole = 'account';
    $mainrole = 'group' if (not $c->check_user_roles('Account Admins'));
    $c->stash( subpages => gensubpages($mainrole) );
    
    my @errors;
    my @entries;
    my $mesg;

    $c->detach('/admin/group') if $group eq '';
    if ( $group !~ /^[-\w\d ]*$/ ) {
        push @errors, $c->loc('Group contains illegal characters');
        $c->detach('/admin/group');
    }

    my $mesg_group = $c->model('user')->search("(&(objectClass=groupOfNames)(cn=$group))");
    if ( $mesg_group->entries gt 1 ) {
        push @errors, $c->loc('More than one entry matched');
        $c->detach('/admin/group');
    }

    #FIXME I am sure that the code can be smaller and leaner
    @entries = $mesg_group->entries;
    @entries = $entries[0]->get_value('owner');
    my $is_owner = grep { $_ eq $c->user->ldap_entry->dn } @entries;

    if ( ! $is_owner and ! $c->check_user_roles('Account Admins') and ! $c->check_user_roles('Group Admins')) {
	$c->forward('/user');
    }

    if (defined $op and $op eq 'delete') {
	@entries = $mesg_group->entries;
	$entries[0]->delete( $attr => $value)->update;
	$c->res->redirect("/admin/group_modify/$group");
    } 

    if ( defined $op and $op eq 'add' ) {
        my $member = $c->req->param('member');
        $mesg = $c->model('user')->search("(uid=$member)");
        if ( $mesg->code ) {
	    $c->stash({ errors => $mesg->error});
            $c->detach('/admin/group');
        }
        if ( $mesg->entries ne 1 ) {
            $c->detach('/admin/group');
        }
        @entries = $mesg->entries;
        my $dn = $entries[0]->dn;
	@entries = $mesg_group->entries;
	$entries[0]->add( 'member' => $dn )->update;
	$c->res->redirect("/admin/group_modify/$group");
    }

    $c->stash( group => $mesg_group->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" },
        );
    }
    if ( $type eq 'group' ) {
	@subpagenames = (
            { 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;