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::UUID;
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 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->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('/user/login');
        } 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->response->cookies->{'key'} = { value => $key, expires => '+10m' };
            $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});

        $c->stash(pages => roles2pages($c->user->roles));
        $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,
        });
    $c->stash(subpages => gensubpages());
}

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);
    $c->stash(subpages => gensubpages());
    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('/');
}

sub roles2pages : Private {
    my @roles = @_;
    my @pages;
    foreach my $role (sort @roles) {
        if ($role =~ /^(\w+) ?(\w*) (Admin)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;
    @subpagenames = (
        { page => './', title => "Edit"},
        { page => 'password', title => "Change password"},
      );
    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;