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::Schema::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 # visible 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( undef, -sort => 1, -keys => [qw/name isActive isPending description/]); my $canIAdd = $fp->domain->domain->canIAdd; $fp->done; my $template = $self->load_tmpl( 'list-domains.html', cache => 1 , loop_context_vars => 1 ); $template->param( $self->userInfo ); $template->param( canIAddDomain => $canIAdd ); $template->param( domains => [ map { { &fill_HTML_template_from_entry($_) , URL => &mkURL('.', $_->{name}) , isPending => $_->{isPending} // 0 } } @domains ] ); return $template->output; } # Add a new (locked) domain. sub AddDomain : Runmode { my $self = shift; my %CFG = $self->cfg; my $q = $self->query; return $self->redirect('./') if defined $q->param('cancel'); # Cancellation my $domainname = $q->param('name'); Encode::_utf8_on($domainname) if defined $domainname; my $session_param; $session_param = 'AddDomain-Owner-Emails-'.domain_to_ascii($domainname) if defined $domainname; my $error; # Tells whether the change submission has failed. if (defined $q->param('submit')) { # Changes have been submitted: process them my $fp = Fripost::Schema::->SASLauth( $self->authen->username, \%CFG ); if (defined $q->param('owner') and defined $session_param) { # Ensure that the user didn't spoof the domain ownership. my @owners = split "\0", $self->session->param($session_param); $error = "‘".$q->param('owner'). "’ was not listed among the domain owners" unless defined $self->session->param($session_param) and grep { $q->param('owner') eq $_ } @owners; } $fp->domain->add( &parse_CGI_query ($q) , '-send-confirmation-token' => $q->param('owner') // undef , '-dry-run' => not (defined $q->param('owner')) , -error => \$error ); $fp->done; } # Confirmation token sent, everything went fine. return $self->redirect('./') if !$error and defined $q->param('owner'); my $tmpl_file; my @owners; if (!$error and defined $domainname) { $tmpl_file = 'add-domain-2.html'; my @exclude = qw/fripost.org/; @owners = Fripost::Schema::Domain::->list_owner_emails ( $domainname, -error => \$error ,'-ignore-MX' => \@exclude ); undef $tmpl_file if $error; } # Something went wrong, or the domain is unknown $tmpl_file //= 'add-domain-1.html'; 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( &fill_HTML_template_from_query ($q) ); if (@owners) { # Store the list we font, to ensure the user doesn't send back a # spoofed email. $self->session->param( $session_param, join("\0", @owners) ); $self->session->flush; $template->param( owners => [ map {{owner => encode_entities $_}} @owners ] ) } return $template->output; } # On this page, authenticated users can edit the domain description and # catch-alls, and toggle activation (if they have the permission). sub EditDomain : Runmode { my $self = shift; my %CFG = $self->cfg; my $q = $self->query; return $self->redirect('./') if defined $q->param('cancel'); # Cancellation # Get the domain name from the URL. my $domainname = ($self->split_path)[1]; 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 $fp->domain->replace( &parse_CGI_query ($q, name => $domainname), -error => \$error ); } # We don't want allow edition of pending (locked) domains. my $domain = $fp->domain->search( $domainname, -filter => 'unlocked' ) // die "404\n"; $fp->done; my $template = $self->load_tmpl( 'edit-domain.html', cache => 1 , loop_context_vars => 1 ); $template->param( $self->userInfo ); $template->param( isPostmaster => $domain->{permissions} =~ /p/ ); if ($error) { # Preserve the (incorrect) form $template->param( &fill_HTML_template_from_query ($q) , name => encode_entities($domainname) , error => encode_entities ($error) ); } else { # Fill the template with what we got from the database. $template->param( &fill_HTML_template_from_entry ($domain) ); } $template->param( newChanges => defined $q->param('submit') ); return $template->output; } # On this page, authenticated users can list the virtual users, aliases # and lists under the current domain. sub ListLocals : Runmode { my $self = shift; my %CFG = $self->cfg; my $q = $self->query; return $self->redirect('./') if defined $q->param('cancel'); # Cancellation # Get the domain name from the URL. my $domainname = ($self->split_path)[1]; my $fp = Fripost::Schema::->SASLauth( $self->authen->username, \%CFG ); if (defined $q->param('unlock')) { # Unlock the domain, and come back to the home page. # Errors are thrown away. $fp->pending->unlock( $domainname, $q->param('unlock'), -error => undef ) if $q->param('unlock') ne ''; $fp->done; return $self->redirect('../'); } if (defined $q->param('a') and $q->param('a') eq 'delete') { # Delete the domain. $fp->local->delete($domainname, -error => undef ); $fp->done; return $self->redirect('../'); } # Query *the* matching domain, or 404. my $domain = $fp->domain->search( $domainname, -filter => 'unlocked' ) // die "404\n"; # Query the users, aliases and lists under the given domain. my @locals = $fp->local->search ( $domainname, sort => 1); $fp->done; map { $_->{name}= (split_addr $_->{name})[0]; # Remove the domainpart $_->{URL} = &mkURL('.', $_->{name}) }# Add a URL @locals; my @users = grep { $_->{type} eq 'user' } @locals; my @aliases = grep { $_->{type} eq 'alias'} @locals; my @lists = grep { $_->{type} eq 'list' } @locals; # Add a link to the list (external) homepage. map { $_->{list_URL} = $CFG{'listurl_'.$_->{transport}}. email_to_ascii($_->{name}.'@'.$domainname) } @lists; my $template = $self->load_tmpl( 'list-locals.html', cache => 1 , loop_context_vars => 1 ); $template->param( $self->userInfo ); $template->param( &fill_HTML_template_from_entry ($domain, -loop => ['catchAll'] ) , CAodd => not $#aliases % 2 ); # Can the user edit the domain (change description, toggle # activation, modify catch-alls?) $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 { {&fill_HTML_template_from_entry ($_, -loop => ['forward'])} } @users ]); # Can the user add aliases? $template->param( canAddalias => $domain->{permissions} =~ /[aop]/ ); $template->param( listCanAddAlias => [ map { {item => encode_entities $_} } @{$domain->{canAddAlias}} ] ) if $domain->{permissions} =~ /[op]/; # Should we list aliases? $template->param( listAliases => $#aliases >= 0 || $domain->{permissions} =~ /[aop]/ ); $template->param( aliases => [ map { {&fill_HTML_template_from_entry ($_, -loop => ['destination'])} } @aliases ]); # Can the user add lists? $template->param( canAddList => $domain->{permissions} =~ /[lop]/ ); $template->param( listCanAddList => [ map { {item => encode_entities $_} } @{$domain->{canAddList}} ] ) if $domain->{permissions} =~ /[op]/; # Should we list lists? $template->param( listLists => $#lists >= 0 || $domain->{permissions} =~ /[lop]/ ); $template->param( lists => [ map { { &fill_HTML_template_from_entry ($_, -loop => ['destination'] ) , isPending => $_->{isPending} } } @lists ]); 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'); # Cancellation # Get the domain name from the URL. my $domainname = ($self->split_path)[1]; my $t = $q->param('t') or return $self->redirect('./'); return $self->redirect('./') unless grep { $t eq $_ } qw/user alias list/; 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 $local = &parse_CGI_query($q); $local->{type} = $q->param('t'); $local->{name} = $q->param('name').'@'.$domainname; my %rest; if ($q->param('password') || $q->param('password2')) { if ($q->param('password') ne $q->param('password2')) { $error = "Passwords do not match"; } # TODO: ! move that to Password.pm elsif (length $q->param('password') < $CFG{password_min_length}) { $error = "Password should be at least " .$CFG{password_min_length} ." characters long."; } else { $local->{password} = Fripost::Schema::Password::hash($q->param('password')); } # TODO: inherit the user quota from the postmaster's? } # Password needs special care $local->{password} = $q->param('password') if $t eq 'list'; $rest{gpg} = { use_agent => 0 , keydir => $CFG{gpghome} , key => $CFG{gpg_private_key_id} , passphrase => $CFG{gpg_private_key_passphrase} }; unless ($error) { my $fp = Fripost::Schema::->SASLauth( $self->authen->username, \%CFG ); $fp->domain->search ($domainname, -filter => 'unlocked', -count => 1) or die "404\n"; $fp->local->add( $local, %rest, -error => \$error ); $fp->done; return $self->redirect('./') unless $error; } } # Do not send passwords back to the sender. $q->delete(qw/password password2/); my $template = $self->load_tmpl( "add-$t.html", cache => 1 ); $template->param( $self->userInfo , domainname => encode_entities($domainname) , &fill_HTML_template_from_query ($q)); $template->param( transport => [ map { { item => $_ , name => ucfirst $_ , selected => (defined $q->param('transport') and $q->param('transport') eq $_) } } (keys %Fripost::Schema::Local::list_commands) ] ) if $t eq 'list'; $template->param( error => encode_entities ($error) ) if $error; 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'); # Cancellation # Get the domain name from the URL. my ($localname,$domainname) = ($self->split_path)[2,1]; my $name = $localname.'@'.$domainname; my $fp = Fripost::Schema::->SASLauth( $self->authen->username, \%CFG ); # Search for *the* matching user, alias or list. $fp->domain->search ($domainname, -filter => 'unlocked', -count => 1) or die "404\n"; my $error; # Tells whether the change submission has failed. if (defined $q->param('a') and $q->param('a') eq 'delete') { # Delete the entry $fp->local->delete($name, -error => \$error ); unless ($error) { $fp->done; return $self->redirect('../'); } } my $local = $fp->local->search ($name, -filter => 'unlocked') or die "404\n"; my $t = $local->{type}; if (defined $q->param('submit')) { # Changes have been submitted: process them my $local = &parse_CGI_query($q); $local->{name} = $name; $local->{type} = $t; my %rest; if ($q->param('password') || $q->param('password2')) { if ($q->param('password') ne $q->param('password2')) { $error = "Passwords do not match"; } # TODO: ! move that to Password.pm # TODO: change password elsif (length $q->param('password') < $CFG{password_min_length}) { $error = "Password should be at least " .$CFG{password_min_length} ." characters long."; } else { $local->{password} = Fripost::Password::hash($q->param('password')); } } $fp->local->replace($local, -error => \$error); } $fp->done; # Do not send passwords back to the sender. $q->delete(qw/password password2/); my $template = $self->load_tmpl( "edit-$t.html", cache => 1 ); $template->param( $self->userInfo , localpart => encode_entities($localname) , domainpart => encode_entities($domainname) , name => encode_entities($name) ); $template->param( &fill_HTML_template_from_query ($q) ); 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( list_URL => $CFG{'listurl_'.$local->{transport}}. email_to_ascii($name) ) if $t eq 'list'; $q->delete('a'); return $template->output; } sub mkURL { my $host = shift; my @path = map { encodeURIComponent($_) } @_; join '/', ($host, @path); } 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) , user_URL => &mkURL ($root, $d, $l) ) } my @single_valued_keys = qw/isActive quota/; my @multi_valued_keys = qw/description catchAll canAddAlias canAddList forward destination/; sub fill_HTML_template_from_entry { my $entry = shift; my %options = @_; my %vars; foreach my $key (keys %$entry) { next if $options{'-hide'} and grep { $key eq $_ } @{$options{'-hide'}}; if ($key eq 'name') { $vars{$key} = encode_entities($entry->{$key}); } elsif (grep {$key eq $_} (qw/URL list_URL transport/, @single_valued_keys)) { $vars{$key} = encode_entities($entry->{$key}); } elsif (grep {$key eq $_} @multi_valued_keys) { my @array = map { encode_entities ($_) } @{$entry->{$key}}; if ($options{'-loop'} and grep { $key eq $_ } @{$options{'-loop'}}) { $vars{$key} = [ map {{item => $_}} @array ]; } else { $vars{$key} = join "\x{0D}\x{0A}", @array; } } } return %vars; } sub fill_HTML_template_from_query { my %params = shift->Vars; my %rest = @_; my %vars; $params{$_} = $rest{$_} for keys %rest; foreach my $key (keys %params) { next unless defined $params{$key}; Encode::_utf8_on($params{$key}); $vars{$key} = encode_entities($params{$key}) if grep { $key eq $_ } ('name', @single_valued_keys, @multi_valued_keys); } $vars{isActive} //= 1; return %vars; } sub parse_CGI_query { my %params = shift->Vars; my %rest = @_; my $entry; $params{$_} = $rest{$_} for keys %rest; foreach my $key (keys %params) { next unless defined $params{$key}; Encode::_utf8_on($params{$key}) if defined $params{$key}; if (grep { $key eq $_ } qw/name transport/) { $entry->{$key} = $params{$key}; } elsif (grep {$key eq $_} @single_valued_keys) { $entry->{$key} = $params{$key}; } elsif (grep {$key eq $_} @multi_valued_keys) { $entry->{$key} = $params{$key} ? [ split "\x{0D}\x{0A}", $params{$key} ] : []; $entry->{$key} = [ grep {$_} @{$entry->{$key}} ]; } } $entry->{isActive} //= 1; return $entry; } =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__