lib/FPanel/ → lib/Fripost/Panel/

1 files changed, 0 insertions, 437 deletions

diff --git a/lib/FPanel/Interface.pm b/lib/FPanel/Interface.pm
deleted file mode 100644
index 053e1a2..0000000
--- a/lib/FPanel/Interface.pm
+++ /dev/null
@@ -1,437 +0,0 @@
-package FPanel::Interface;
-
-use 5.010_000;
-use strict;
-use warnings;
-use utf8;
-
-=head1 NAME
-
-Interface.pm -
-
-=cut
-
-use Fripost::Schema;
-use Fripost::Password;
-use parent 'FPanel::Login';
-use HTML::Entities;
-
-
-# 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 ($ul,$ud) = split /\@/, $self->authen->username, 2;
-
-    my $fp = Fripost::Schema->SASLauth( $self->authen->username, %CFG );
-    my @domains = $fp->domain->search( -concat => "\n", -die => 403);
-    $fp->done;
-
-    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
-                    , user_localpart => $ul
-                    , user_domainpart => $ud
-                    , domains => [ @domains ]
-    );
-    return $template->output;
-}
-
-
-# This Run Mode lists the known mailboxes, aliases and lists under the current
-# domain.
-sub ListLocals : Runmode {
-    my $self = shift;
-    my %CFG = $self->cfg;
-
-    my ($ul,$ud) = split /\@/, $self->authen->username, 2;
-    my $d = (split /\//, $ENV{PATH_INFO}, 3)[1];
-    my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
-
-    # Query *the* matching domain
-    my %domain = $fp->domain->get( $d, -die => 404 );
-
-    # Query the mailboxes, 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 @mailboxes = $fp->mailbox->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, utf8 => 1
-                                   , loop_context_vars => 1
-                                   , global_vars => 1 );
-
-    $template->param( url => $self->query->url
-                    , user_localpart => $ul
-                    , user_domainpart => $ud
-    );
-    $template->param( domain => $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 mailboxes?
-    $template->param( canAddMailbox => $domain{permissions} =~ /p/ );
-    # Should we list mailboxes?
-    $template->param( listMailboxes => $#mailboxes >= 0 ||
-                                       $domain{permissions} =~ /p/ );
-    $template->param( mailboxes => [
-        map { { user => $_->{user}
-              , description => join ("\n", @{$_->{description}})
-              , isactive => $_->{isactive}
-              , forwards => [ map { {forward => $_} } @{$_->{forwards}} ]
-              , quota => $_->{quota}
-              };
-            }
-            @mailboxes
-    ]);
-
-    # Can the user add aliases?
-    $template->param( canAddalias => $domain{permissions} =~ /[aop]/ );
-    # Should we list aliases?
-    $template->param( listAliases => $#aliases >= 0 ||
-                                     $domain{permissions} =~ /[aop]/ );
-    $template->param( aliases => [
-        map { { alias => $_->{alias}
-              , description => join ("\n", @{$_->{description}})
-              , isactive => $_->{isactive}
-              , destinations => [ map { {destination => $_} }
-                                      @{$_->{maildrop}} ]
-              };
-            }
-            @aliases
-    ]);
-    $template->param( catchalls => [ map { {catchall => $_} }
-                                         @{$domain{catchalls}} ]
-                    , CAodd => not $#aliases % 2);
-
-    # Can the user add lists?
-    $template->param( canAddList => $domain{permissions} =~ /[lop]/ );
-    # Should we list lists?
-    $template->param( listLists => $#lists >= 0 || $domain{permissions} =~ /[lop]/ );
-    $template->param( lists => [
-        map { { list => $_->{list}
-              , description => join ("\n", @{$_->{description}})
-              , isactive => $_->{isactive}
-              , transport => $_->{transport}
-              };
-            }
-            @lists
-    ]);
-    return $template->output;
-}
-
-
-# In this Run Mode authenticated users can edit the domain description
-# and catchalls, and toggle activation (if they have the permission).
-sub EditDomain : Runmode {
-    my $self = shift;
-    my %CFG = $self->cfg;
-
-    my ($ul,$ud) = split /\@/, $self->authen->username, 2;
-    my $d = (split /\//, $ENV{PATH_INFO}, 3)[1];
-
-    my $q = $self->query;
-    return $self->redirect($q->url .'/') 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
-        $error = $fp->domain->replace({
-                     domain => $d,
-                     isactive => $q->param('isactive'),
-                     description => $q->param('description'),
-                     catchalls => $q->param('catchalls')
-        }, -concat => "(\n|\x{0D}\x{0A})");
-    }
-    my %domain = $fp->domain->get( $d, -die => 404 );
-    $fp->done;
-
-    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
-                    , user_localpart => $ul
-                    , user_domainpart => $ud
-                    , domain => $d
-    );
-    if ($error) {
-        # Preserve the (incorrect) form
-        $template->param( isactive => $q->param('isactive')
-                        , description => $q->param('description')
-                        , catchalls => $q->param('catchalls')
-                        , error => encode_entities ($error, "‘‘") );
-    }
-    else {
-        $template->param( isactive => $domain{isactive}
-                        , description => join ("\x{0D}\x{0A}",
-                                               @{$domain{description}})
-                        , catchalls => join ("\x{0D}\x{0A}",
-                                             @{$domain{catchalls}}) );
-    }
-    $template->param( newChanges => defined $self->query->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 ($ul,$ud) = split /\@/, $self->authen->username, 2;
-    my ($null,$d,$l,$crap) = split /\//, $ENV{PATH_INFO}, 4;
-
-    my $q = $self->query;
-    return $self->redirect($q->url.'/'.$d.'/') 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
-        my $t = $q->param('t') // die "Undefined type";
-        my %entry;
-        if ($t eq 'mailbox') {
-            $entry{user} = $l.'@'.$d;
-            $entry{forwards} = $q->param('forwards');
-
-            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 {
-                        $fp = Fripost::Schema::->auth(
-                                  $self->authen->username,
-                                  $q->param('oldpw'),
-                                  ldap_uri => $CFG{ldap_uri},
-                                  ldap_suffix => $CFG{ldap_suffix},
-                                  -die => "Wrong password (for ‘"
-                                          .$self->authen->username."‘)." );
-                    };
-                    $error = $@ || $fp->mailbox->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');
-        }
-        elsif ($t eq 'list') {
-            $entry{list} = $l.'@'.$d;
-            $entry{transport} = $q->param('transport');
-        }
-        else {
-            # Unknown type
-            return $self->redirect($q->url .'/'. $d .'/');
-        }
-        $entry{isactive} = $q->param('isactive');
-        $entry{description} = $q->param('description');
-        $error = $fp->$t->replace( \%entry, -concat => "(\n|\x{0D}\x{0A})")
-            unless $error;
-    }
-
-    # Search for *the* matching mailbox, alias or list.
-    my %local = $fp->local->get ($l, $d, -die => 404,
-                                         -concat => "\x{0D}\x{0A}");
-    $fp->done;
-
-    my $template = $self->load_tmpl( "edit-$local{type}.html",
-                                     cache => 1, utf8 => 1 );
-    $template->param( url => $self->query->url
-                    , user_localpart => $ul
-                    , user_domainpart => $ud
-                    , domain => $d
-    );
-    if ($error) {
-        # Preserve the (incorrect) form, except the passwords
-        if ($local{type} eq 'mailbox') {
-            $template->param( user => $l
-                            , forwards => $q->param('forwards') );
-        }
-        elsif ($local{type} eq 'alias') {
-            $template->param( alias => $l
-                            , maildrop => $q->param('maildrop') );
-        }
-        elsif ($local{type} eq 'list') {
-            $template->param( list => $l );
-        }
-        else {
-            # Unknown type
-            return $self->redirect($q->url.'/'.$d.'/');
-        }
-        $template->param( isactive => $q->param('isactive')
-                        , description => $q->param('description')
-                        , error => encode_entities ($error, "‘‘") );
-    }
-    else {
-        if ($local{type} eq 'mailbox') {
-            $template->param( user => $local{user}
-                            , forwards => $local{forwards} );
-        }
-        elsif ($local{type} eq 'alias') {
-            $template->param( alias => $local{alias}
-                            , maildrop => $local{maildrop} );
-        }
-        elsif ($local{type} eq 'list') {
-            $template->param( list => $local{list} );
-        }
-        else {
-            # Unknown type
-            return $self->redirect($q->url.'/'.$d.'/');
-        }
-        $template->param( isactive => $local{isactive}
-                        , description => $local{description} );
-    }
-    $template->param( newChanges => defined $self->query->param('submit') );
-    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 ($ul,$ud) = split /\@/, $self->authen->username, 2;
-    my $d = (split /\//, $ENV{PATH_INFO}, 3)[1];
-
-    my $q = $self->query;
-    return $self->redirect($q->url.'/'.$d.'/') if defined $q->param('cancel');
-
-    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;
-        if ($t eq 'mailbox') {
-            $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');
-        }
-        else {
-            # Unknown type
-            return $self->redirect($q->url.'/'.$d.'/');
-        }
-        $entry{isactive} = $q->param('isactive');
-        $entry{description} = $q->param('description');
-
-        unless ($error) {
-            my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
-            $error = $fp->$t->add( \%entry, -concat => "(\n|\x{0D}\x{0A})");
-            $fp->done;
-            return $self->redirect($q->url.'/'.$d.'/') unless $error;
-        }
-    }
-
-    my $template = $self->load_tmpl( "add-$t.html", cache => 1, utf8 => 1 );
-    $template->param( url => $self->query->url
-                    , user_localpart => $ul
-                    , user_domainpart => $ud
-                    , domain => $d
-    );
-    if ($error) {
-        # Preserve the (incorrect) form, except the passwords
-        if ($t eq 'mailbox') {
-            $template->param( user => $q->param('user')
-                            , forwards => $q->param('forwards') );
-        }
-        elsif ($t eq 'alias') {
-            $template->param( alias => $q->param('alias')
-                            , maildrop => $q->param('maildrop') );
-        }
-        elsif ($t eq 'list') {
-            $template->param( list => $q->param('list')
-                            , isenc => $q->param('transport') eq 'schleuder' );
-        }
-        else {
-            # Unknown type
-            return $self->redirect($q->url.'/'.$d.'/');
-        }
-        $template->param( isactive => $q->param('isactive')
-                        , description => $q->param('description')
-                        , error => encode_entities ($error, "‘‘") );
-    }
-    else {
-        $template->param( isactive => 1 );
-    }
-    return $template->output;
-}
-
-
-=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__