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 $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); my $q = $self->query; 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 $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); my $q = $self->query; 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; 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<< >> =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__