path: root/lib/Fripost/Panel/Interface.pm

package Fripost::Panel::Interface;

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

=head1 NAME

Interface.pm -

=cut

use parent 'Fripost::Panel::Login';

use Fripost::Schema;
use Fripost::Schema::Util 'split_addr';
use Fripost::Password;
use HTML::Entities 'encode_entities';
use URI::Escape::XS 'encodeURIComponent';
use Net::IDN::Encode qw/email_to_unicode email_to_ascii domain_to_ascii/;
use Encode;


# 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 $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
    my @domains = $fp->domain->search( undef, -die => 403, -sort => 1,
                    -keys => [qw/name isActive isPending description/]);
    my $canIAdd = $fp->domain->domain->canIAdd;
    $fp->done;

    my $template = $self->load_tmpl( 'list-domains.html', cache => 1
                                   , loop_context_vars => 1 );
    $template->param( $self->userInfo );
    $template->param( canIAddDomain => $canIAdd );
    $template->param( domains => [
          map {
            { &mkLink( domain => $_->{name})
            , isActive => $_->{isActive}
            , isPending => $_->{isPending}
            , description => &mkDesc($_->{description})
            } }
          @domains ]
    );
    return $template->output;
}


# This Run Mode lists the known users, aliases and lists under the current
# domain.
sub ListLocals : Runmode {
    my $self = shift;
    my %CFG = $self->cfg;

    my $d = ($self->split_path)[1];
    my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );

    my $q = $self->query;
    if (defined $q->param('unlock')) {
        my $error; # TODO
        $fp->domain->unlock( $d, $q->param('unlock'), -error => \$error )
            if $q->param('unlock') ne '';
        $fp->done;
        return $self->redirect('../');
    }

    # Query *the* matching domain
    my %domain = $fp->domain->get( $d, -die => 404 );

    # Query the users, aliases and lists under the given domain. We don't
    # die with a HTTP error code here, as it is not supposed to crash.
    my @users   = $fp->user->search( $d );
    my @aliases = $fp->alias->search( $d );
    my @lists   = $fp->list->search( $d );

    $fp->done;

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

    $template->param( $self->userInfo );
    $template->param( domain => encode_entities($domain{domain})
                    , isactive => $domain{isactive}
                    , description => join ("\n", @{$domain{description}}) );
    # Can the user edit the domain (change description, toggle
    # activation, modify catchalls?)
    $template->param( canEditDomain => $domain{permissions} =~ /[op]/ );

    # Can the user add users?
    $template->param( canAddUser => $domain{permissions} =~ /p/ );
    # Should we list users?
    $template->param( listUsers => $#users >= 0 ||
                                       $domain{permissions} =~ /p/ );
    $template->param( users => [
        map { { &mkLink(user => $_->{user})
              , description => join ("\n", @{$_->{description}})
              , isactive => $_->{isactive}
              , forwards => [ map { {forward => encode_entities($_)} }
                                  @{$_->{forwards}} ]
              , quota => $_->{quota}
              };
            }
            @users
    ]);

    # Can the user add aliases?
    $template->param( canAddalias => $domain{permissions} =~ /[aop]/ );
    $template->param( listCanAddAlias => [ map { {user => encode_entities($_)} }
                                               @{$domain{canAddAlias}} ] )
        if $domain{permissions} =~ /[op]/;
    # Should we list aliases?
    $template->param( listAliases => $#aliases >= 0 ||
                                     $domain{permissions} =~ /[aop]/ );
    $template->param( aliases => [
        map { { &mkLink(alias => $_->{alias})
              , description => join ("\n", @{$_->{description}})
              , isactive => $_->{isactive}
              , destinations => [ map { {destination => encode_entities($_)} }
                                      @{$_->{maildrop}} ]
              };
            }
            @aliases
    ]);
    $template->param( catchalls => [ map { {catchall => encode_entities($_)} }
                                         @{$domain{catchalls}} ]
                    , CAodd => not $#aliases % 2);

    # Can the user add lists?
    $template->param( canAddList => $domain{permissions} =~ /[lop]/ );
    $template->param( listCanAddList => [ map { {user => encode_entities($_)} }
                                                @{$domain{canAddList}} ] )
        if $domain{permissions} =~ /[op]/;
    # Should we list lists?
    $template->param( listLists => $#lists >= 0 || $domain{permissions} =~ /[lop]/ );
    $template->param( lists => [
        map { { &mkLink(list => $_->{list})
              , description => join ("\n", @{$_->{description}})
              , isactive => $_->{isactive}
              , ispending => $_->{ispending}
              , transport => $_->{transport}
              , listURL => $CFG{'listurl_'.$_->{transport}}.
                           email_to_ascii($_->{list}.'@'.$d)
              };
            }
            @lists
    ]);
    return $template->output;
}


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

    my $d = ($self->split_path)[1];

    my $q = $self->query;
    return $self->redirect('./') if defined $q->param('cancel');

    my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );

    my $error; # Tells whether the change submission has failed.
    if (defined $q->param('submit')) {
        # Changes have been submitted: process them
        $fp->domain->replace({
                     name => $d,
                     isActive => $q->param('isActive') // 1,
                     description => $q->param('description'),
                     catchAlls => [ split /\x{0D}\x{0A}/, ($q->param('catchAlls')//'') ],
#                     canAddAlias => [ split /\x{0D}\x{0A}/, ($q->param('canAddAlias')//'') ],
#                     canAddList => [ split /\x{0D}\x{0A}/, ($q->param('canAddList')//'') ]
                     # ^ TODO: if postmaster
        }, -error => \$error);
    }
    my $domain = $fp->domain->search( $d, -die => 403, -filter => 'unlocked' ) // die "404\n";
    $fp->done;

    my $template = $self->load_tmpl( 'edit-domain.html', cache => 1,
                                   , loop_context_vars => 1 );
    $template->param( $self->userInfo );
    $template->param( domain => encode_entities($d)
                    , isPostmaster => $domain->{permissions} eq 'p');
    if ($error) {
        # Preserve the (incorrect) form
        $template->param( isActive => $q->param('isActive') // 1
                        , description => $q->param('description') // undef
                        , catchAlls => $q->param('catchAlls') // undef
                        , canAddAlias => $q->param('canAddAlias') // undef
                        , canAddList => $q->param('canAddList') // undef
                        , error => encode_entities ($error) );
    }
    else {
        $template->param( isactive => $domain{isactive}
                        , description => &mkFormContent (@{$domain{description}})
                        , catchalls => &mkFormContentE (@{$domain{catchalls}})
                        , canAddAlias => &mkFormContentE (@{$domain{canAddAlias}})
                        , canAddList => &mkFormContentE (@{$domain{canAddList}})
                        );
    }
    $template->param( newChanges => defined $q->param('submit') );
    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 $q = $self->query;
    return $self->redirect('../') if defined $q->param('cancel');

    my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );

    # Search for *the* matching user, alias or list.
    my ($d,$l) = ($self->split_path)[1,2];
    $fp->domain->get ($d, -die => 404, -assert_exist => 1);
    my %local = $fp->local->get ($l.'@'.$d, -die => 404,
                                            -concat => "\x{0D}\x{0A}" );
    die "Unknown type" unless grep { $local{type} eq $_ }
                                   qw/user alias list/;
    die "404\n" if $local{ispending};

    my $error; # Tells whether the change submission has failed.
    my $t = $local{type};

    if (defined $q->param('a') and $q->param('a') eq 'delete') {
        # Delete the entry
        $error = $fp->$t->delete($l.'@'.$d, -die => 0);
        unless ($error) {
            $fp->done;
            return $self->redirect('../');
        }
    }
    if (defined $q->param('submit')) {
        # Changes have been submitted: process them
        my %entry;
        if ($t eq 'user') {
            $entry{user} = $l.'@'.$d;
            $entry{forwards} = $q->param('forwards') // undef;

            if (($q->param('oldpw')  // '') ne '' or
                ($q->param('newpw')  // '') ne '' or
                ($q->param('newpw2') // '') 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('newpw') ne $q->param('newpw2')) {
                    $error = "Passwords do not match";
                }
                elsif (length $q->param('newpw') < $CFG{password_min_length}) {
                    $error = "Password should be at least "
                            .$CFG{password_min_length}
                            ." characters long.";
                }
                else {
                    my $fp;
                    eval {
                        my $u = email_to_unicode($self->authen->username);
                        $fp = Fripost::Schema::->auth(
                                  $u,
                                  $q->param('oldpw') // '',
                                  %CFG,
                                  -die => "Wrong password (for ‘".$u."’)." );
                    };
                    $error = $@ || $fp->user->passwd(
                                      $entry{user},
                                      Fripost::Password::hash($q->param('newpw') // '')
                                   );
                    $fp->done if defined $fp;
                }
            }
        }
        elsif ($t eq 'alias') {
            $entry{alias} = $l.'@'.$d;
            $entry{maildrop} = $q->param('maildrop') // undef;
        }
        elsif ($t eq 'list') {
            $entry{list} = $l.'@'.$d;
            $entry{transport} = $q->param('transport') // undef;
        }
        $entry{isactive} = $q->param('isactive') // 1;
        $entry{description} = $q->param('description') // undef;
        $error = $fp->$t->replace( \%entry, -concat => "(\n|\x{0D}\x{0A})")
            unless $error;
    }

    my $template = $self->load_tmpl( "edit-$t.html", cache => 1 );
    $template->param( $self->userInfo );
    $template->param( domain => encode_entities($d) );

    if ($error and defined $q->param('submit')) {
        # Preserve the (incorrect) form, except the passwords
        if ($t eq 'user') {
            $template->param( user => encode_entities($l)
                            , forwards => $q->param('forwards') // undef );
        }
        elsif ($t eq 'alias') {
            $template->param( alias => encode_entities($l)
                            , maildrop => $q->param('maildrop') // undef );
        }
        elsif ($t eq 'list') {
            $template->param( list => encode_entities($l) );
        }
        $template->param( isactive => $q->param('isactive') // 1
                        , description => $q->param('description') // undef );
    }
    else {
        %local = $fp->local->get ($l.'@'.$d, -die => 404,
                                             -concat => "\x{0D}\x{0A}" );
        if ($t eq 'user') {
            $template->param( user => encode_entities($local{user})
                            , forwards => encode_entities($local{forwards}) );
        }
        elsif ($t eq 'alias') {
            $template->param( alias => encode_entities($local{alias})
                            , maildrop => encode_entities($local{maildrop}) );
        }
        elsif ($t eq 'list') {
            $template->param( list => encode_entities($local{list}) );
        }
        $template->param( isactive => $local{isactive}
                        , description => $local{description} );
    }
    $fp->done;
    my $news = (defined $q->param('submit') or
                (defined $q->param('a') and $q->param('a') eq 'delete'));
    $template->param( newChanges => $news );
    $template->param( error => encode_entities ($error) ) if $error;
    $template->param( canDelete => 1 ) if $t eq 'alias';
    $template->param( listURL => $CFG{'listurl_'.$local{transport}}.
                                 email_to_ascii($l.'@'.$d) )
        if $t eq 'list';
    $q->delete('a');
    return $template->output;
}

sub AddDomain : Runmode {
    my $self = shift;
    my %CFG = $self->cfg;

    my $q = $self->query;
    return $self->redirect('./') if defined $q->param('cancel'); # Cancellation

    my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
    my $domain = $q->param('domain');
    Encode::_utf8_on($domain) if defined $domain;
    my $session_param;
    $session_param = 'AddDomain-Postmasters-' . domain_to_ascii($domain)
        if defined $domain;

    my $error; # Tells whether the change submission has failed.
    if (defined $q->param('submit')) {
        # Changes have been submitted: process them

        if (defined $q->param('postmaster') and defined $session_param) {
            my @postmasters = split /\s*,\s*/, $self->session->param($session_param);
            $error = "‘".$q->param('postmaster')."’ was not listed among the domain owners."
                unless defined $self->session->param($session_param)
                           and grep { $q->param('postmaster') eq $_ } @postmasters;
        }

        $fp->domain->add({
                     name => $domain,
                     isActive => $q->param('isActive') // 1,
#                     description => $q->param('description') // undef,
#                     catchAlls => [ split /\x{0D}\x{0A}/, $q->param('catchAlls') ]
                     },
                '-send-confirmation-token' => $q->param('postmaster') // undef,
                '-dry-run' => not (defined $q->param('postmaster')),
                 -error => \$error,
                 webapp_url => $self->cfg('webapp_url'),
                 tmpl_path => $self->cfg('tmpl_path'),
                 email_from => $self->cfg('email_from')
        );
    }
    $fp->done;

    return $self->redirect('./') # Confirmation token sent, everything OK
        if ($error // '') eq '' and defined $q->param('postmaster');

    my $tmpl_file;
    my @postmasters;

    if (($error // '') ne '' or not (defined $domain)) {
        # Something went wrong, or the domain is unknown
        $tmpl_file = 'add-domain-1.html';
    }
    else {
        $tmpl_file = 'add-domain-2.html';
        @postmasters = Fripost::Schema::Domain::->list_admin_emails(
                             $domain, -error => \$error
        );
        $tmpl_file = 'add-domain-1.html' if $error;
    }

    my $template = $self->load_tmpl( $tmpl_file, cache => 1,
                                   , loop_context_vars => 1 );
    $template->param( $self->userInfo );
    $template->param( error => encode_entities ($error) ) if $error;

    $template->param( isActive => $q->param('isActive') // 1
                    , description => $q->param('description') // undef
                    , catchAlls => $q->param('catchAlls') // undef
                    );
    $template->param( domain => encode_entities($domain) )
        if defined $domain;

    if (@postmasters) {
        # Store it, to ensure the user doesn't send back a bogus email
        $self->session->param( $session_param, join(',', @postmasters) );
        $self->session->flush;

        $template->param( postmasters => [ map {{postmaster => $_}} @postmasters ] )
    }

    return $template->output;
}


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

    my $q = $self->query;
    return $self->redirect('./') if defined $q->param('cancel');

    my $d = ($self->split_path)[1];
    my $t = $q->param('t') // die "Undefined type";
    my $error; # Tells whether the change submission has failed.
    if (defined $q->param('submit')) {
        # Changes have been submitted: process them
        my %entry;
        my %rest;
        if ($t eq 'user') {
            $entry{user} = $q->param('user').'@'.$d;
            $entry{forwards} = $q->param('forwards');
            if ($q->param('password') ne $q->param('password2')) {
                $error = "Passwords do not match";
            }
            elsif (length $q->param('password') < $CFG{password_min_length}) {
                $error = "Password should be at least "
                        .$CFG{password_min_length}
                        ." characters long.";
            }
            else {
                $entry{password} = Fripost::Password::hash($q->param('password'));
            }
            # TODO: inherit the quota from the postmaster's?
        }
        elsif ($t eq 'alias') {
            $entry{alias} = $q->param('alias').'@'.$d;
            $entry{maildrop} = $q->param('maildrop');
        }
        elsif ($t eq 'list') {
            $entry{list} = $q->param('list').'@'.$d;
            $entry{transport} = $q->param('transport');
            if ($q->param('password') ne $q->param('password2')) {
                $error = "Passwords do not match";
            }
            elsif (length $q->param('password') < $CFG{password_min_length}) {
                $error = "Password should be at least "
                        .$CFG{password_min_length}
                        ." characters long.";
            }
            else {
                $rest{gpg} = { use_agent => 0
                             , keydir => $CFG{gpghome}
                             , key => $CFG{gpg_private_key_id}
                             , passphrase => $CFG{gpg_private_key_passphrase}
                             };
                $entry{password} = $q->param('password');
            }
        }
        else {
            # Unknown type
            return $self->redirect('./');
        }
        $entry{isactive} = $q->param('isactive') // 1;
        $entry{description} = $q->param('description') // undef;

        unless ($error) {
            my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
            $fp->domain->get ($d, -die => 404, -assert_exist => 1);
            $error = $fp->$t->add( \%entry, -concat => "(\n|\x{0D}\x{0A})", %rest);
            $fp->done;
            return $self->redirect('./') unless $error;
        }
    }

    my $template = $self->load_tmpl( "add-$t.html", cache => 1 );
    $template->param( $self->userInfo );
    $template->param( domain => encode_entities($d) );
    if ($error) {
        # Preserve the (incorrect) form, except the passwords
        if ($t eq 'user') {
            $template->param( user => $q->param('user') // undef
                            , forwards => $q->param('forwards') // undef );
        }
        elsif ($t eq 'alias') {
            $template->param( alias => $q->param('alias') // undef
                            , maildrop => $q->param('maildrop') // undef );
        }
        elsif ($t eq 'list') {
            $template->param( list => $q->param('list') // undef
                            , isenc => $q->param('transport') eq 'schleuder' );
        }
        else {
            # Unknown type
            return $self->redirect('./');
        }
        $template->param( isactive => $q->param('isactive') // 1
                        , description => $q->param('description') // undef
                        , error => encode_entities ($error) );
    }
    else {
        $template->param( isactive => 1 );
    }
    return $template->output;
}

sub mkURL {
    my $host = shift;
    my @path = map { encodeURIComponent($_) } @_;
    join '/', ($host, @path);
}

sub mkLink {
    my $k = shift;
    my $d = shift;
    ( $k => encode_entities($d),
      $k.'URI' => &mkURL('.', $d) )
}

sub userInfo {
    my $self = shift;
    my ($l,$d) = split_addr( $self->authen->username, -encode => 'unicode' );
    my $root = $ENV{SCRIPT_NAME} // $self->cfg->{'cgi-bin'} // '';
    $root =~ s@/$@@s;

    ( user_localpart => encode_entities($l)
    , user_domainpart => encode_entities($d)
    , userURI => &mkURL ($root, $d, $l)
    )
}

sub mkFormContentE {
    &mkFormContent (map { encode_entities ($_) } @_);
}

sub mkFormContent {
    join ("\x{0D}\x{0A}", @_);
}

sub mkDesc {
    my $desc = shift // return '';
    join '<br>', map {encode_entities($_)} @$desc;
}

=head1 AUTHOR

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

=head1 COPYRIGHT

Copyright 2012,2013 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__