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( -concat => "\n", -die => 403); $fp->done; my $template = $self->load_tmpl( 'list-domains.html', cache => 1, , loop_context_vars => 1 ); $template->param( $self->userInfo ); $template->param( domains => [ map { { &mkLink( domain => $_->{domain}) , isactive => $_->{isactive} , ispending => $_->{ispending} , description => $_->{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')) { $fp->domain->unlock( $d, $q->param('unlock') ) 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 catchalls, 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 $error = $fp->domain->replace({ domain => $d, 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 }, -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, , 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, -attrs => []); 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; } $error = $fp->domain->add({ domain => $domain, send_token_to => $q->param('postmaster') // undef, isactive => $q->param('isactive') // 1, description => $q->param('description') // undef, catchalls => $q->param('catchalls') // undef }, -concat => "(\n|\x{0D}\x{0A})", '-dry-run' => not (defined $q->param('postmaster')), -domainurl => $q->url.'/'.encode_entities($domain).'/' # TODO: try that in nginx ) unless $error; } $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_postmasters($domain); } 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, -attrs => []); $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}", @_); } =head1 AUTHOR Guilhem Moulin C<< >> =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__