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; use Net::IDN::Encode qw/email_to_unicode/; # 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 /\@/, email_to_unicode($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 => encode_entities($ul) , user_domainpart => encode_entities($ud) , domains => [ map { { domain => encode_entities($_->{domain}) , isactive => $_->{isactive} , description => $_->{description} } } @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 /\@/, email_to_unicode($self->authen->username), 2; my $d = decode_entities ((split /\//, $ENV{PATH_INFO}, 3)[1]); Encode::_utf8_on($d); 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, -is_pending => 0 ); $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 => encode_entities($ul) , user_domainpart => encode_entities($ud) ); $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 mailboxes? $template->param( canAddMailbox => $domain{permissions} =~ /p/ ); # Should we list mailboxes? $template->param( listMailboxes => $#mailboxes >= 0 || $domain{permissions} =~ /p/ ); $template->param( mailboxes => [ map { { user => encode_entities($_->{user}) , description => join ("\n", @{$_->{description}}) , isactive => $_->{isactive} , forwards => [ map { {forward => encode_entities($_)} } @{$_->{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 => encode_entities($_->{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]/ ); # Should we list lists? $template->param( listLists => $#lists >= 0 || $domain{permissions} =~ /[lop]/ ); $template->param( lists => [ map { { list => encode_entities($_->{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 /\@/, email_to_unicode($self->authen->username), 2; my $d = decode_entities ((split /\//, $ENV{PATH_INFO}, 3)[1]); Encode::_utf8_on($d); 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 => $q->url , user_localpart => encode_entities($ul) , user_domainpart => encode_entities($ud) , domain => encode_entities($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}", map { encode_entities ($_) } @{$domain{catchalls}}) ); } $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 ($ul,$ud) = split /\@/, email_to_unicode($self->authen->username), 2; my ($null,$d,$l,$crap) = split /\//, $ENV{PATH_INFO}, 4; my $du = decode_entities ($d); Encode::_utf8_on($du); my $lu = decode_entities ($l); Encode::_utf8_on($lu); my $q = $self->query; return $self->redirect($q->url.'/'.$d.'/') if defined $q->param('cancel'); my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); # Search for *the* matching mailbox, alias or list. my %local = $fp->local->get ($lu.'@'.$du, -die => 404, -concat => "\x{0D}\x{0A}" ); die "Unknown type" unless grep { $local{type} eq $_ } qw/mailbox alias list/; 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($lu.'@'.$du, -die => 0); unless ($error) { $fp->done; return $self->redirect($q->url .'/'. $d .'/'); } } if (defined $q->param('submit')) { # Changes have been submitted: process them my %entry; if ($t eq 'mailbox') { $entry{user} = $lu.'@'.$du; $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 { my $u = email_to_unicode($self->authen->username); $fp = Fripost::Schema::->auth( $u, $q->param('oldpw'), ldap_uri => $CFG{ldap_uri}, ldap_suffix => $CFG{ldap_suffix}, -die => "Wrong password (for ‘" .encode_entities($u)."‘)." ); }; $error = $@ || $fp->mailbox->passwd( $entry{user}, Fripost::Password::hash($q->param('newpw')) ); $fp->done if defined $fp; } } } elsif ($t eq 'alias') { $entry{alias} = $lu.'@'.$du; $entry{maildrop} = $q->param('maildrop'); } elsif ($t eq 'list') { $entry{list} = $lu.'@'.$du; $entry{transport} = $q->param('transport'); } $entry{isactive} = $q->param('isactive'); $entry{description} = $q->param('description'); $error = $fp->$t->replace( \%entry, -concat => "(\n|\x{0D}\x{0A})") unless $error; } my $template = $self->load_tmpl( "edit-$t.html", cache => 1, utf8 => 1 ); $template->param( url => $q->url , user_localpart => encode_entities($ul) , user_domainpart => encode_entities($ud) , domain => encode_entities($du) ); if ($error and defined $q->param('submit')) { # Preserve the (incorrect) form, except the passwords if ($t eq 'mailbox') { $template->param( user => encode_entities($l) , forwards => $q->param('forwards') ); } elsif ($t eq 'alias') { $template->param( alias => encode_entities($l) , maildrop => $q->param('maildrop') ); } elsif ($t eq 'list') { $template->param( list => encode_entities($l) ); } $template->param( isactive => $q->param('isactive') , description => $q->param('description') ); } else { %local = $fp->local->get ($lu.'@'.$du, -die => 404, -concat => "\x{0D}\x{0A}" ); if ($t eq 'mailbox') { $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 ); # TODO $q->delete('a'); 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 /\@/, email_to_unicode($self->authen->username), 2; my $d = (split /\//, $ENV{PATH_INFO}, 3)[1]; my $du = decode_entities ($d); Encode::_utf8_on($du); 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').'@'.$du; $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').'@'.$du; $entry{maildrop} = $q->param('maildrop'); } elsif ($t eq 'list') { $entry{list} = $q->param('list').'@'.$du; $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 => $q->url , user_localpart => encode_entities($ul) , user_domainpart => encode_entities($ud) , domain => encode_entities($du) ); 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__