path: root/lib/FPanel/Interface.pm

package FPanel::Interface;

use 5.010_000;
use strict;
use warnings;
use utf8;

=head1 NAME

Interface.pm -

=cut

use lib 'lib';
use base 'FPanel::Login';


# This method is called right before the 'setup' method below. It
# inherits the configuration from the super class.
sub cgiapp_init {
    my $self = shift;

    $self->SUPER::cgiapp_init;

    # Every single Run Mode here is protected
    $self->authen->protected_runmodes( ':all' );
}


# This is the first page seen by authenticated users. It lists the known
# domains.
sub ListDomains : StartRunmode {
    my $self = shift;
    my %CFG = $self->cfg;
    my $suffix = join ',', @{$CFG{ldap_suffix}};

    my ($l,$d) = split /@/, $self->authen->username, 2;
    my $authzDN = "fvu=$l,fvd=$d,". $suffix;
    my $ldap = $self->ldap_from_auth_user($authzDN);

    my $domains = $ldap->search( base => $suffix
                               , scope => 'one'
                               , filter => 'objectClass=FripostVirtualDomain'
                               , deref => 'never'
                               , attrs => [ qw/fvd description
                                               fripostIsStatusActive
                                               fripostCanCreateAlias
                                               fripostCanCreateList
                                               fripostOwner
                                               fripostPostmaster/ ]
                               );
    die "403\n" if $domains->code;
    $ldap->unbind;


    my $template = $self->load_tmpl( 'list-domains.html', cache => 1, utf8 => 1
                                   , loop_context_vars => 1
                                   , global_vars => 1 );
    $template->param( URL => $self->query->url );
    $template->param( USER_LOCALPART => $l, USER_DOMAINPART => $d);
    $template->param( DOMAINS => [
        map { { DOMAIN => $_->get_value('fvd')
                # TODO: do we really want to list the permissions?
              , PERMS => &list_perms_long($_, $authzDN)
              , DESCRIPTION => join ("\n", $_->get_value('description'))
              , ISACTIVE => $_->get_value('fripostIsStatusActive') eq 'TRUE'
              };
            }
            $domains->sorted('fvd')
    ]);
    return $template->output;
}


# This Run Mode lists the known mailboxes, aliases and lists in the current
# domain.
sub ListLocals : Runmode {
    my $self = shift;
    my %CFG = $self->cfg;
    my $suffix = join ',', @{$CFG{ldap_suffix}};

    my ($l,$d) = split /@/, $self->authen->username, 2;
    my $authzDN = "fvu=$l,fvd=$d,". $suffix;
    my $ldap = $self->ldap_from_auth_user($authzDN);

    my $domainname = (split /\//, $ENV{PATH_INFO}, 3)[1];

    # Query *the* matching domain
    my $domains = $ldap->search( base => "fvd=$domainname,$suffix"
                               , scope => 'base'
                               , filter => 'objectClass=FripostVirtualDomain'
                               , deref => 'never'
                               , attrs => [ qw/fvd description
                                               fripostIsStatusActive
                                               fripostOptionalMaildrop
                                               fripostCanCreateAlias
                                               fripostCanCreateList
                                               fripostOwner
                                               fripostPostmaster/ ]
                               );
    die "404\n" if $domains->code;
    # The following is not supposed to happen.
    die "Error: Multiple matching entries found." if $domains->count > 1;
    my $domain = $domains->pop_entry or die "404\n";


    # Query the mailboxes under the given domain
    my $mailboxes = $ldap->search( base => "fvd=$domainname,$suffix"
                                 , scope => 'one'
                                 , filter => 'objectClass=FripostVirtualMailbox'
                                 , deref => 'never'
                                 , attrs => [ qw/fvu description
                                                 fripostIsStatusActive
                                                 fripostOptionalMaildrop
                                                 fripostMailboxQuota/ ]
                                );
    # We don't return 403 or 404 here, since it's not supposed to crash.
    die $mailboxes->error if $mailboxes->code;

    # Query the aliases under the given domain
    my $aliases = $ldap->search( base => "fvd=$domainname,$suffix"
                               , scope => 'one'
                               , filter => 'objectClass=FripostVirtualAlias'
                               , deref => 'never'
                               , attrs => [ qw/fva description
                                               fripostIsStatusActive
                                               fripostOwner
                                               fripostMaildrop/ ]
                               );
    # We don't return 403 or 404 here, since it's not supposed to crash.
    die $aliases->error if $aliases->code;

    # Query the lists under the given domain
    my $lists = $ldap->search( base => "fvd=$domainname,$suffix"
                             , scope => 'one'
                             , filter => 'objectClass=FripostVirtualList'
                             , deref => 'never'
                             , attrs => [ qw/fvl description
                                             fripostIsStatusActive
                                             fripostOwner
                                             fripostListManager/ ]
                             );
    # We don't return 403 or 404 here, since it's not supposed to crash.
    die $lists->error if $lists->code;

    $ldap->unbind;

    # Get the perms of the autenticated user, so that we know where
    # should put "add" and "edit" links (the LDAP ACLs back that up
    # eventually, anyway).
    my $perms = &list_perms($domain, $authzDN);

    my $template = $self->load_tmpl( 'list-locals.html', cache => 1, utf8 => 1
                                   , loop_context_vars => 1
                                   , global_vars => 1 );

    $template->param( URL => $self->query->url );
    $template->param( DOMAIN => $domainname );
    $template->param( USER_LOCALPART => $l, USER_DOMAINPART => $d);
    $template->param( DESCRIPTION =>
        join ("\n", $domain->get_value('description')) );
    $template->param( ISACTIVE =>
        $domain->get_value('fripostIsStatusActive') eq 'TRUE' );
    # Can the user edit the domain (change description, toggle
    # activation, modify catchalls?)
    $template->param( CANEDIT => $perms =~ /[op]/ );

    # Can the user add mailboxes?
    $template->param( CANADDMAILBOX => $perms =~ /p/ );
    # Should we list mailboxes?
    $template->param( LISTMAILBOXES => $mailboxes->count || $perms =~ /p/ );
    $template->param( MAILBOXES => [
        map { { USER => $_->get_value('fvu')
              , DESCRIPTION => join ("\n", $_->get_value('description'))
              , ISACTIVE => $_->get_value('fripostIsStatusActive') eq 'TRUE'
              , FORWARDS => [ map { {FORWARD => $_} }
                                  $_->get_value('fripostOptionalMaildrop') ]
              , QUOTA => $_->get_value('fripostMailboxQuota') // ''
              };
            }
            $mailboxes->sorted('fvu')
    ]);

    # Can the user add aliases?
    $template->param( CANADDALIAS => $perms =~ /[aop]/ );
    # Should we list aliases?
    $template->param( LISTALIASES => $aliases->count || $perms =~ /[aop]/ );
    $template->param( ALIASES => [
        map { { ALIAS => $_->get_value('fva')
              , DESCRIPTION => join ("\n", $_->get_value('description'))
              , ISACTIVE => $_->get_value('fripostIsStatusActive') eq 'TRUE'
                # TODO: do we really want to list the owners?
              , OWNERS => [ map { {OWNER => &dn2email($_)} }
                                  $_->get_value('fripostOwner') ]
              , DESTINATIONS => [ map { {DESTINATION => $_} }
                                      $_->get_value('fripostMaildrop') ]
              };
            }
            $aliases->sorted('fva')
    ]);
    $template->param( CATCHALLS => [ map { {CATCHALL => $_} }
                                         $domain->get_value('fripostOptionalMaildrop') ]
                      # TODO: do we really want to list the owners?
                    , OWNERS => [ ( map { {OWNER => &dn2email($_)} }
                                        $domain->get_value('fripostOwner') )
                                , ( map { {OWNER => &dn2email($_)} }
                                        $domain->get_value('fripostPostmaster') ) ]
                    , CAODD => $aliases->count % 2 );

    # Can the user add lists?
    $template->param( CANADDLIST => $perms =~ /[lop]/ );
    # Should we list lists?
    $template->param( LISTLISTS => $lists->count || $perms =~ /[lop]/ );
    $template->param( LISTS => [
        map { { LIST => $_->get_value('fvl')
              , DESCRIPTION => join ("\n", $_->get_value('description'))
              , ISACTIVE => $_->get_value('fripostIsStatusActive') eq 'TRUE'
                # TODO: do we really want to list the owners?
              , OWNERS => [ map { {OWNER => &dn2email($_)} }
                                $_->get_value('fripostOwner') ]
              , TRANSPORT => $_->get_value('fripostListManager')
              };
            }
            $lists->sorted('fvl')
    ]);
    return $template->output;
}


# In this Run Mode authenticated users can edit the domain description
# and catchall, and toggle activation (if they have the permission).
sub EditDomain : Runmode {
    my $self = shift;
    my %CFG = $self->cfg;
    my $suffix = join ',', @{$CFG{ldap_suffix}};

    my ($l,$d) = split /@/, $self->authen->username, 2;
    my $authzDN = "fvu=$l,fvd=$d,". $suffix;
    my $ldap = $self->ldap_from_auth_user($authzDN);

    my $domainname = (split /\//, $ENV{PATH_INFO}, 3)[1];

    my $error; # Tells wether the change submission has fails.
    if (defined $self->query->param('submit')) {
        # Changes have been submitted: process them
        my %changes;
        my $q = $self->query;
        $changes{fripostIsStatusActive} = $q->param('status') eq 'active' ?
                                              'TRUE' : 'FALSE';
        $changes{description} = [ split /\n/, $q->param('description') ];
        $changes{fripostOptionalMaildrop} = [ &form2EmailList($q->param('maildrop')) ];
        my $mesg = $ldap->modify( "fvd=$domainname,$suffix",
                                  replace => \%changes );
        $error = $mesg->error if $mesg->code;
    }

    my $domains = $ldap->search( base => "fvd=$domainname,$suffix"
                               , scope => 'base'
                               , filter => 'objectClass=FripostVirtualDomain'
                               , deref => 'never'
                               );
    die "404\n" if $domains->code;
    # The following is not supposed to happen.
    die "Error: Multiple matching entries found." if $domains->count > 1;
    my $domain = $domains->pop_entry or die "404\n";

    $ldap->unbind;

    my $template = $self->load_tmpl( 'edit-domain.html', cache => 1, utf8 => 1
                                   , loop_context_vars => 1
                                   , global_vars => 1 );
    $template->param( URL => $self->query->url );
    $template->param( USER_LOCALPART => $l, USER_DOMAINPART => $d);
    $template->param( DOMAIN => $domainname );
    $template->param( DESCRIPTION =>
        join ("\n",$domain->get_value('description')) );
    $template->param( MAILDROP =>
        join ("\n",$domain->get_value('fripostOptionalMaildrop')) );
    $template->param( ISACTIVE => $domain->get_value('fripostIsStatusActive') eq 'TRUE' );
    $template->param( NEWCHANGES => defined $self->query->param('submit') );
    $template->param( ERROR => $error );
    return $template->output;
}


# In this Run Mode authenticated users can edit the entry (if they have
# the permission).
sub EditLocal : Runmode {
    my $self = shift;
    my %CFG = $self->cfg;
    my $suffix = join ',', @{$CFG{ldap_suffix}};

    my ($l,$d) = split /@/, $self->authen->username, 2;
    my $authzDN = "fvu=$l,fvd=$d,". $suffix;
    my $ldap = $self->ldap_from_auth_user($authzDN);

    my ($null,$domainname,$localname,$crap) = split /\//, $ENV{PATH_INFO}, 4;

    my $error; # Tells wether the change submission has fails.
    if (defined $self->query->param('submit')) {
        # Changes have been submitted: process them
        my (%changes, $t2);
        my $q = $self->query;
        my $t = lc $q->param('t') // die "Error: Unknown type";

        if ($t eq 'mailbox') {
            $t2 = 'fvu';
            if ($q->param('oldpassword') ne '' or
                $q->param('newpassword') ne '' or
                $q->param('newpassword2') ne '') {
                # If the user tries to change the password, we make her
                # bind first, to prevent an attacker from setting a
                # custom password and accessing the emails.

                if ($q->param('newpassword') eq $q->param('newpassword2')) {
                    my $ldap2 = Net::LDAP->new( $CFG{ldap_uri} );
                    my $mesg = $ldap2->bind ( "fvu=$l,fvd=$d,$suffix",
                                              password => $q->param('oldpassword') );
                    if ($mesg->code) {
                        $error = "Wrong password (for ".$self->authen->username.").";
                    }
                    else {
                        my $pw = $q->param('newpassword');
                        # TODO: hash it.
                        $mesg = $ldap2->modify( "fvu=$localname,fvd=$domainname,$suffix",
                                                replace => { userPassword => $pw } );
                        $error = $mesg->error if $mesg->code;
                    }
                    $ldap2->unbind;
                }
                else {
                    $error = "Password don't match.";
                }
            }

            $changes{fripostOptionalMaildrop} = [ &form2EmailList($q->param('maildrop')) ];
        }

        elsif ($t eq 'alias') {
            $t2 = 'fva';
            $changes{fripostMaildrop} = [ &form2EmailList($q->param('maildrop')) ];
        }

        elsif ($t eq 'list') {
            $t2 = 'fvl';
        }

        else {
            die "Error: Unknown type";
        }

        # Global parameters
        $changes{fripostIsStatusActive} = $q->param('status') eq 'active' ?
                                              'TRUE' : 'FALSE';
        $changes{description} = [ split /\n/, $q->param('description') ];

        unless (defined $error) {
            my $mesg = $ldap->modify( "$t2=$localname,fvd=$domainname,$suffix",
                                      replace => \%changes );
            $error = $mesg->error if $mesg->code;
        }
    }

    # Query *the* matching mailbox, alias or list.
    my $locals = $ldap->search( base => "fvd=$domainname,$suffix"
                              , scope => 'one'
                              , filter => "(|(&(objectClass=FripostVirtualMailbox)
                                               (fvu=$localname))
                                             (&(objectClass=FripostVirtualAlias)
                                               (fva=$localname))
                                             (&(objectClass=FripostVirtualList)
                                               (fvl=$localname))
                                           )"
                              , deref => 'never'
                              , attrs => [ qw/fvu description
                                              fripostIsStatusActive
                                              fripostOptionalMaildrop
                                              fripostMailboxQuota
                                              fva fripostMaildrop
                                              fvl fripostListManager/ ]
                              );
    die "404\n" if $locals->code;
    # The following is not supposed to happen.
    die "Error: Multiple matching entries found." if $locals->count > 1;
    my $local = $locals->pop_entry or die "404\n";

    my $template;
    if ($local->dn =~ /^fvu=/) {
        $template = $self->load_tmpl( 'edit-mailbox.html', cache => 1, utf8 => 1 );
        $template->param( MAILBOX => $local->get_value('fvu') );
        $template->param( MAILDROP =>
            join ("\n",$local->get_value('fripostOptionalMaildrop')) );
    }
    elsif ($local->dn =~ /^fva=/) {
        $template = $self->load_tmpl( 'edit-alias.html', cache => 1, utf8 => 1 );
        $template->param( ALIAS => $local->get_value('fva') );
        $template->param( MAILDROP =>
            join ("\n",$local->get_value('fripostMaildrop')) );
    }
    elsif ($local->dn =~ /^fvl=/) {
        $template = $self->load_tmpl( 'edit-list.html', cache => 1, utf8 => 1 );
        $template->param( LIST => $local->get_value('fvl') );
    }

    $template->param( URL => $self->query->url );
    $template->param( DOMAIN => $domainname );
    $template->param( USER_LOCALPART => $l, USER_DOMAINPART => $d);
    $template->param( DESCRIPTION =>
        join ("\n",$local->get_value('description')) );
    $template->param( ISACTIVE => $local->get_value('fripostIsStatusActive') eq 'TRUE' );
    $template->param( NEWCHANGES => defined $self->query->param('submit') );
    $template->param( ERROR => $error );
    return $template->output;
}


# In this Run Mode authenticated users can add mailboxes, aliases and
# lists (if they have the permission).
sub AddLocal : Runmode {
    my $self = shift;
    my %CFG = $self->cfg;
    my $suffix = join ',', @{$CFG{ldap_suffix}};

    my ($l,$d) = split /@/, $self->authen->username, 2;
    my $authzDN = "fvu=$l,fvd=$d,". $suffix;
    my $ldap = $self->ldap_from_auth_user($authzDN);

    my $domainname = (split /\//, $ENV{PATH_INFO}, 3)[1];
    my $localname;

    my $error;
    my $q = $self->query;
    if (defined $self->query->param('submit')) {
        # A new alias has been submitted: process it
        my %new;
        $localname = $q->param('alias');
        $new{objectClass} = 'FripostVirtualAlias';
        $new{fripostIsStatusActive} = $q->param('status') eq 'active' ?
                                                'TRUE' : 'FALSE';
        $new{fripostOwner} = $authzDN;
        my @desc = split /\n/, $q->param('description');
        $new{description} = [ @desc ] if @desc;
        my @maildrop = &form2EmailList($q->param('maildrop'));
        $new{fripostMaildrop} = [ @maildrop ] if @maildrop;

        # TODO: more checks
        my $mesg = $ldap->add( "fva=$localname,fvd=$domainname,$suffix",
                               attrs => [ %new ] );
        if ($mesg->code) {
            $error = $mesg->error;
        }
        else {
            return $self->redirect($q->url .'/'. $domainname .'/');
        }
    }

    my $template = $self->load_tmpl( 'add-alias.html', cache => 1, utf8 => 1 );
    $template->param( URL => $self->query->url );
    $template->param( DOMAIN => $domainname );
    $template->param( USER_LOCALPART => $l, USER_DOMAINPART => $d);
    if (defined $error) {
      $template->param( ALIAS => $q->param('alias') );
      $template->param( ISACTIVE => $q->param('status') eq 'active');
      $template->param( DESCRIPTION => join ("\n",$q->param('description')) );
      $template->param( MAILDROP => join ("\n",$q->param('maildrop')) );
      $template->param( ERROR => $error );
    }
    return $template->output;
}


# This subroutine displays the access that the given DN has on the entry
# (long version). Possible values are :
# - "can create aliases" (a)
# - "can create lists" (l)
# - "can create aliases & lists" (al)
# - "owner" (o)
# - "postmaster" (p)
sub list_perms_long {
    my $perms = &list_perms(@_);

    if ( $perms =~ /a/) {
      return 'can create aliases & lists' if $perms =~ /l/;
      return 'can create aliases';
    }
    elsif ( $perms eq 'l' ) {
      return 'can create lists';
    }
    elsif ( $perms eq 'o' ) {
      return 'owner';
    }
    elsif ( $perms eq 'p' ) {
      return 'postmaster';
    }
}

# This subroutine displays the access that the given DN has on the entry
# (short version).
sub list_perms {
    my ($entry, $dn) = @_;
    my $perms = '';

    $perms .= 'a'
        if grep { $dn eq $_  or  (split /,/,$dn,2)[1] eq $_ }
                $entry->get_value ('fripostCanCreateAlias');

    $perms .= 'l'
        if grep { $dn eq $_  or  (split /,/,$dn,2)[1] eq $_ }
                $entry->get_value ('fripostCanCreateList');

    $perms = 'o'
        if grep { $dn eq $_ } $entry->get_value('fripostOwner');

    $perms = 'p'
        if grep { $dn eq $_ } $entry->get_value('fripostPostmaster');

    return $perms;
}


# This method SASL binds the web application and uses the provided
# authorization DN.
sub ldap_from_auth_user {
    my $self = shift;
    my $authzDN = shift;

    my $ldap = Net::LDAP->new( $self->cfg('ldap_uri'),
                               async => 1, onerror => 'die' );
    my $sasl = Authen::SASL->new(
                   mechanism => 'DIGEST-MD5',
                   callback => { user => $self->cfg('ldap_authcID')
                               , pass => $self->cfg('ldap_authcPW')
                               , authname => "dn:$authzDN" }
               );
    my $mesg = $ldap->bind( sasl => $sasl );
    die $mesg->error if $mesg->code;

    return $ldap;
}

# Converts a DN into an email.
sub dn2email {
  my $dn = shift;
  $dn =~ /^fv[ual]=([^,]+),fvd=([^,]+),/ or return '';
  return "$1\@$2";
}


# Produces an e-mail list from a form: split the new lines and strip out
# the spaces.
sub form2EmailList {
    my $str = shift;
    my @list;
    foreach my $e (split /\n/, $str) {
        $e =~ s/\s//g;
        push @list, $e unless $e =~ /^$/;
    }
    return @list;
}


=head1 AUTHOR

Guilhem Moulin C<< <guilhem at fripost.org> >>

=head1 COPYRIGHT

Copyright 2012 Guilhem Moulin.

=head1 LICENSE

This program is free software; you can redistribute it and/or modify it
under the same terms as perl itself.

=cut

1;

__END__