diff options
Diffstat (limited to 'lib/Fripost/Panel/Interface.pm')
| -rw-r--r-- | lib/Fripost/Panel/Interface.pm | 437 |
1 files changed, 437 insertions, 0 deletions
diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm new file mode 100644 index 0000000..b636861 --- /dev/null +++ b/lib/Fripost/Panel/Interface.pm @@ -0,0 +1,437 @@ +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::Password; +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__ |