diff options
Diffstat (limited to 'lib/Fripost/Panel')
| -rw-r--r-- | lib/Fripost/Panel/Interface.pm | 341 | ||||
| -rw-r--r-- | lib/Fripost/Panel/Login.pm | 14 |
2 files changed, 199 insertions, 156 deletions
diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm index b0deeb0..bb77ad6 100644 --- a/lib/Fripost/Panel/Interface.pm +++ b/lib/Fripost/Panel/Interface.pm @@ -33,14 +33,15 @@ sub cgiapp_init { } -# This is the first page seen by authenticated users. It lists the known -# domains. + +# 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, -die => 403, -sort => 1, + my @domains = $fp->domain->search( undef, -sort => 1, -keys => [qw/name isActive isPending description/]); my $canIAdd = $fp->domain->domain->canIAdd; $fp->done; @@ -49,19 +50,135 @@ sub ListDomains : StartRunmode { , loop_context_vars => 1 ); $template->param( $self->userInfo ); $template->param( canIAddDomain => $canIAdd ); - $template->param( domains => [ - map { - { &mkLink( domain => $_->{name}) - , isActive => $_->{isActive} - , isPending => $_->{isPending} - , description => &mkDesc($_->{description}) - } } - @domains ] - ); + $template->param( domains => [ map { { &fill_HTML_template_from_entry($_) + , URI => &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 + , webapp_url => $self->cfg('webapp_url') + , tmpl_path => $self->cfg('tmpl_path') + , email_from => $self->cfg('email_from') + ); + $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'; + @owners = Fripost::Schema::Domain::->list_owner_emails + ( $domainname, -error => \$error ); + 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( &parse_CGI_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 => $_}} @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; + + # Get the domain name from the URL. + my $domainname = ($self->split_path)[1]; + + my $q = $self->query; + return $self->redirect('./') if defined $q->param('cancel'); # Cancellation + + 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; } + + + # This Run Mode lists the known users, aliases and lists under the current # domain. sub ListLocals : Runmode { @@ -164,61 +281,6 @@ sub ListLocals : Runmode { } -# In this Run Mode 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 $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 - $fp->domain->replace({ - name => $d, - isActive => $q->param('isActive') // 1, - description => $q->param('description'), - catchAlls => [ split /\x{0D}\x{0A}/, ($q->param('catchAlls')//'') ], -# canAddAlias => [ split /\x{0D}\x{0A}/, ($q->param('canAddAlias')//'') ], -# canAddList => [ split /\x{0D}\x{0A}/, ($q->param('canAddList')//'') ] - # ^ TODO: if postmaster - }, -error => \$error); - } - my $domain = $fp->domain->search( $d, -die => 403, -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( 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). @@ -354,87 +416,6 @@ sub EditLocal : Runmode { 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; - } - - $fp->domain->add({ - name => $domain, - isActive => $q->param('isActive') // 1, -# description => $q->param('description') // undef, -# catchAlls => [ split /\x{0D}\x{0A}/, $q->param('catchAlls') ] - }, - '-send-confirmation-token' => $q->param('postmaster') // undef, - '-dry-run' => not (defined $q->param('postmaster')), - -error => \$error, - webapp_url => $self->cfg('webapp_url'), - tmpl_path => $self->cfg('tmpl_path'), - email_from => $self->cfg('email_from') - ); - } - $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_admin_emails( - $domain, -error => \$error - ); - $tmpl_file = 'add-domain-1.html' if $error; - } - - 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 @@ -578,6 +559,70 @@ sub mkDesc { join '<br>', map {encode_entities($_)} @$desc; } +my @single_valued_keys = qw/isActive/; +my @multi_valued_keys = qw/description catchAlls + canAddAlias canAddList/; + +sub fill_HTML_template_from_entry { + my $entry = shift; + my %vars; + + foreach my $key (keys %$entry) { + if ($key eq 'name') { + $vars{$key} = encode_entities($entry->{$key}); + } + elsif (grep {$key eq $_} @single_valued_keys) { + $vars{$key} = $entry->{$key}; + } + elsif (grep {$key eq $_} @multi_valued_keys) { + $vars{$key} = join "\x{0D}\x{0A}", map { encode_entities ($_) } + @{$entry->{$key}}; + } + } + return %vars; +} + +sub fill_HTML_template_from_query { + my %params = shift->Vars; + my %rest = @_; + my %vars; + + my @ok = qw/name isActive description catchAlls + canAddAlias canAddList owner postmaster/; + + $params{$_} = encode_entities ($rest{$_}) for keys %rest; + foreach my $key (keys %params) { + $vars{$key} = $params{$key} // undef + if grep { $key eq $_ } (@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) { + if ($key eq 'name') { + $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<< <guilhem at fripost.org> >> diff --git a/lib/Fripost/Panel/Login.pm b/lib/Fripost/Panel/Login.pm index 736207d..09520a4 100644 --- a/lib/Fripost/Panel/Login.pm +++ b/lib/Fripost/Panel/Login.pm @@ -12,7 +12,6 @@ Login.pm - Authentication subroutines for the Web Interface. =cut use parent 'CGI::Application'; - use CGI::Application::Plugin::AutoRunmode; use CGI::Application::Plugin::Session; use CGI::Application::Plugin::Authentication; @@ -21,10 +20,10 @@ use CGI::Application::Plugin::ConfigAuto 'cfg'; use Fripost::Schema; use Fripost::Schema::Util 'split_addr'; + use HTML::Entities 'encode_entities'; use URI::Escape::XS 'decodeURIComponent'; -use Net::IDN::Encode 'email_to_ascii'; - +use Encode; # This method is called right before the 'setup' method below. It # initializes the session and authentication configurations. @@ -143,7 +142,7 @@ sub login : Runmode { $self->authen->logout if $self->authen->is_authenticated; # Do not come back here on the next Run Mode - $self->query->delete('a') if (defined $self->query->param('a')) and + $self->query->delete('a') if defined $self->query->param('a') and $self->query->param('a') eq 'login'; # Where the users wants to go @@ -178,8 +177,8 @@ sub logout : Runmode { } # Do not come back here on the next Run Mode - $self->query->delete('a') if (defined $self->query->param('a')) and - $self->query->param('a') eq 'logout'; + $self->query->delete('a') if defined $self->query->param('a') and + $self->query->param('a') eq 'logout'; return $self->redirect( ($ENV{SCRIPT_NAME} // $self->query->url).'/' ); } @@ -229,8 +228,7 @@ sub split_path { $uri =~ s/^$script//s; # Strip the facing CGI script name $uri =~ s/\?.*//s; # Strip the query - map { decodeURIComponent($_); Encode::_utf8_on($_); $_ } - (split /\//, $uri); + map { decodeURIComponent($_); Encode::_utf8_on($_); $_ } (split /\//, $uri); } |