aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost/Panel
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Fripost/Panel')
-rw-r--r--lib/Fripost/Panel/Interface.pm142
-rw-r--r--lib/Fripost/Panel/Login.pm30
2 files changed, 93 insertions, 79 deletions
diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm
index f150a39..b9a9500 100644
--- a/lib/Fripost/Panel/Interface.pm
+++ b/lib/Fripost/Panel/Interface.pm
@@ -15,9 +15,9 @@ use parent 'Fripost::Panel::Login';
use Fripost::Schema;
use Fripost::Password;
-use HTML::Entities;
+use HTML::Entities 'encode_entities';
+use URI::Escape::XS 'encodeURIComponent';
use Net::IDN::Encode qw/email_to_unicode domain_to_ascii/;
-use CGI::Util qw/escape unescape/;
# This method is called right before the 'setup' method below. It
@@ -43,13 +43,11 @@ sub ListDomains : StartRunmode {
my @domains = $fp->domain->search( -concat => "\n", -die => 403);
$fp->done;
- my $template = $self->load_tmpl( 'list-domains.html', cache => 1, utf8 => 1
+ my $template = $self->load_tmpl( 'list-domains.html', cache => 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})
+ $template->param( $self->userInfo );
+ $template->param( domains => [ map { { &mkLink( domain => $_->{domain})
, isactive => $_->{isactive}
, description => $_->{description} } }
@domains ]
@@ -65,8 +63,7 @@ sub ListLocals : Runmode {
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 $d = ($self->split_path)[1];
my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
# Query *the* matching domain
@@ -77,18 +74,15 @@ sub ListLocals : Runmode {
# crash.
my @mailboxes = $fp->mailbox->search( $d );
my @aliases = $fp->alias->search( $d );
- my @lists = $fp->list->search( $d, -is_pending => 0 );
+ my @lists = $fp->list->search( $d );
$fp->done;
- my $template = $self->load_tmpl( 'list-locals.html', cache => 1, utf8 => 1
+ my $template = $self->load_tmpl( 'list-locals.html', cache => 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( $self->userInfo );
$template->param( domain => encode_entities($domain{domain})
, isactive => $domain{isactive}
, description => join ("\n", @{$domain{description}}) );
@@ -102,7 +96,7 @@ sub ListLocals : Runmode {
$template->param( listMailboxes => $#mailboxes >= 0 ||
$domain{permissions} =~ /p/ );
$template->param( mailboxes => [
- map { { user => encode_entities($_->{user})
+ map { { &mkLink(user => $_->{user})
, description => join ("\n", @{$_->{description}})
, isactive => $_->{isactive}
, forwards => [ map { {forward => encode_entities($_)} }
@@ -119,9 +113,7 @@ sub ListLocals : Runmode {
$template->param( listAliases => $#aliases >= 0 ||
$domain{permissions} =~ /[aop]/ );
$template->param( aliases => [
- map { my $a = escape(encode_entities($_->{alias})); # TODO
- { aliasurl => escape($a)
- , alias => $a
+ map { { &mkLink(alias => $_->{alias})
, description => join ("\n", @{$_->{description}})
, isactive => $_->{isactive}
, destinations => [ map { {destination => encode_entities($_)} }
@@ -139,11 +131,13 @@ sub ListLocals : Runmode {
# Should we list lists?
$template->param( listLists => $#lists >= 0 || $domain{permissions} =~ /[lop]/ );
$template->param( lists => [
- map { { list => encode_entities($_->{list})
+ map { { &mkLink(list => $_->{list})
, description => join ("\n", @{$_->{description}})
, isactive => $_->{isactive}
+ , ispending => $_->{ispending}
, transport => $_->{transport}
- , listurl => $CFG{'listurl_'.$_->{transport}}.$_->{list}.'@'.domain_to_ascii($d)
+ , listURL => $CFG{'listurl_'.$_->{transport}}.$_->{list}.
+ '@'.domain_to_ascii($d)
};
}
@lists
@@ -159,11 +153,10 @@ sub EditDomain : Runmode {
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 $d = ($self->split_path)[1];
my $q = $self->query;
- return $self->redirect($q->url .'/') if defined $q->param('cancel');
+ return $self->redirect('./') if defined $q->param('cancel');
my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
@@ -180,14 +173,11 @@ sub EditDomain : Runmode {
my %domain = $fp->domain->get( $d, -die => 404 );
$fp->done;
- my $template = $self->load_tmpl( 'edit-domain.html', cache => 1, utf8 => 1
+ my $template = $self->load_tmpl( 'edit-domain.html', cache => 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)
- );
+ $template->param( $self->userInfo );
+ $template->param( domain => encode_entities($d) );
if ($error) {
# Preserve the (incorrect) form
$template->param( isactive => $q->param('isactive')
@@ -214,38 +204,35 @@ 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');
+ return $self->redirect('../') 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}" );
+ my ($d,$l) = ($self->split_path)[1,2];
+ my %local = $fp->local->get ($l.'@'.$d, -die => 404,
+ -concat => "\x{0D}\x{0A}" );
die "Unknown type" unless grep { $local{type} eq $_ }
qw/mailbox 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($lu.'@'.$du, -die => 0);
+ $error = $fp->$t->delete($l.'@'.$d, -die => 0);
unless ($error) {
$fp->done;
- return $self->redirect($q->url .'/'. $d .'/');
+ return $self->redirect('../');
}
}
if (defined $q->param('submit')) {
# Changes have been submitted: process them
my %entry;
if ($t eq 'mailbox') {
- $entry{user} = $lu.'@'.$du;
+ $entry{user} = $l.'@'.$d;
$entry{forwards} = $q->param('forwards');
if ($q->param('oldpw') ne '' or
@@ -282,11 +269,11 @@ sub EditLocal : Runmode {
}
}
elsif ($t eq 'alias') {
- $entry{alias} = $lu.'@'.$du;
+ $entry{alias} = $l.'@'.$d;
$entry{maildrop} = $q->param('maildrop');
}
elsif ($t eq 'list') {
- $entry{list} = $lu.'@'.$du;
+ $entry{list} = $l.'@'.$d;
$entry{transport} = $q->param('transport');
}
$entry{isactive} = $q->param('isactive');
@@ -295,13 +282,10 @@ sub EditLocal : Runmode {
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)
- );
+ 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 'mailbox') {
@@ -319,8 +303,8 @@ sub EditLocal : Runmode {
, description => $q->param('description') );
}
else {
- %local = $fp->local->get ($lu.'@'.$du, -die => 404,
- -concat => "\x{0D}\x{0A}" );
+ %local = $fp->local->get ($l.'@'.$d, -die => 404,
+ -concat => "\x{0D}\x{0A}" );
if ($t eq 'mailbox') {
$template->param( user => encode_entities($local{user})
, forwards => encode_entities($local{forwards}) );
@@ -340,8 +324,8 @@ sub EditLocal : Runmode {
(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'; # TODO
- $template->param( listurl => $CFG{'listurl_'.$local{transport}}.$l.'@'.$d )
+ $template->param( canDelete => 1 ) if $t eq 'alias';
+ $template->param( listURL => $CFG{'listurl_'.$local{transport}}.$l.'@'.$d )
if $t eq 'list';
$q->delete('a');
return $template->output;
@@ -354,13 +338,10 @@ 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');
+ 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')) {
@@ -368,7 +349,7 @@ sub AddLocal : Runmode {
my %entry;
my %rest;
if ($t eq 'mailbox') {
- $entry{user} = $q->param('user').'@'.$du;
+ $entry{user} = $q->param('user').'@'.$d;
$entry{forwards} = $q->param('forwards');
if ($q->param('password') ne $q->param('password2')) {
$error = "Passwords do not match";
@@ -384,11 +365,11 @@ sub AddLocal : Runmode {
# TODO: inherit the quota from the postmaster's?
}
elsif ($t eq 'alias') {
- $entry{alias} = $q->param('alias').'@'.$du;
+ $entry{alias} = $q->param('alias').'@'.$d;
$entry{maildrop} = $q->param('maildrop');
}
elsif ($t eq 'list') {
- $entry{list} = $q->param('list').'@'.$du;
+ $entry{list} = $q->param('list').'@'.$d;
$entry{transport} = $q->param('transport');
if ($q->param('password') ne $q->param('password2')) {
$error = "Passwords do not match";
@@ -409,7 +390,7 @@ sub AddLocal : Runmode {
}
else {
# Unknown type
- return $self->redirect($q->url.'/'.$d.'/');
+ return $self->redirect('./');
}
$entry{isactive} = $q->param('isactive');
$entry{description} = $q->param('description');
@@ -418,16 +399,13 @@ sub AddLocal : Runmode {
my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
$error = $fp->$t->add( \%entry, -concat => "(\n|\x{0D}\x{0A})", %rest);
$fp->done;
- return $self->redirect($q->url.'/'.$d.'/') unless $error;
+ return $self->redirect('./') 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)
- );
+ 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 'mailbox') {
@@ -444,7 +422,7 @@ sub AddLocal : Runmode {
}
else {
# Unknown type
- return $self->redirect($q->url.'/'.$d.'/');
+ return $self->redirect('./');
}
$template->param( isactive => $q->param('isactive')
, description => $q->param('description')
@@ -456,6 +434,28 @@ sub AddLocal : Runmode {
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 /\@/, email_to_unicode($self->authen->username), 2;
+
+ ( user_localpart => encode_entities($l)
+ , user_domainpart => encode_entities($d)
+ , userURI => &mkURL ($ENV{SCRIPT_NAME}, $d, $l)
+ )
+}
=head1 AUTHOR
diff --git a/lib/Fripost/Panel/Login.pm b/lib/Fripost/Panel/Login.pm
index 86b3e66..810f9e1 100644
--- a/lib/Fripost/Panel/Login.pm
+++ b/lib/Fripost/Panel/Login.pm
@@ -20,8 +20,9 @@ use CGI::Application::Plugin::Redirect;
use CGI::Application::Plugin::ConfigAuto 'cfg';
use Fripost::Schema;
-use HTML::Entities;
-use Net::IDN::Encode qw/email_to_ascii/;
+use HTML::Entities 'encode_entities';
+use URI::Escape::XS 'decodeURIComponent';
+use Net::IDN::Encode 'email_to_ascii';
# This method is called right before the 'setup' method below. It
@@ -62,7 +63,7 @@ sub cgiapp_init {
$u .= '@'.$CFG{default_realm};
}
Encode::_utf8_on($u);
- $u = Net::IDN::Encode::email_to_ascii($u);
+ $u = email_to_ascii($u);
my $fp = Fripost::Schema::->auth($u, $p,
ldap_uri => $CFG{ldap_uri},
ldap_suffix => $CFG{ldap_suffix},
@@ -80,7 +81,7 @@ sub cgiapp_init {
);
# The run modes that require authentication
- $self->authen->protected_runmodes( qw /okay error_rm/ );
+ $self->authen->protected_runmodes( qw/okay error_rm/ );
}
@@ -105,7 +106,7 @@ sub setup {
return 'logout' if defined $a and $a eq 'logout';
# /domain/{user,alias,list}/?query_url
- my ($null,$domain,$local,$crap) = split /\//, $ENV{PATH_INFO};
+ my ($null,$domain,$local,$crap) = $self->split_path;
return 'ListDomains' unless (defined $null) and $null eq '';
@@ -164,7 +165,7 @@ sub login : Runmode {
sub login_box {
my $self = shift;
- my $template = $self->load_tmpl( 'login.html', cache => 1, utf8 => 1 );
+ my $template = $self->load_tmpl( 'login.html', cache => 1 );
$template->param( error => $self->authen->login_attempts );
$template->param( redirect => $self->query->param('redirect') );
@@ -199,7 +200,7 @@ sub error_rm : ErrorRunmode {
# HTTP client error.
chomp $error;
$self->header_props ( -status => $error );
- my $template = $self->load_tmpl( 'error_http.html', cache => 1, utf8 => 1 );
+ my $template = $self->load_tmpl( 'error_http.html', cache => 1 );
my $mesg;
if ($error eq '403' ) {
$mesg = 'Forbidden'
@@ -214,7 +215,7 @@ sub error_rm : ErrorRunmode {
else {
# Users are not supposed to see that unless the CGI crashes :P
- my $template = $self->load_tmpl( 'error.html', cache => 1, utf8 => 1 );
+ my $template = $self->load_tmpl( 'error.html', cache => 1 );
$template->param( email => $self->cfg('report_email') );
$template->param( message => $error );
$template->param( url => $self->query->url . '/');
@@ -222,6 +223,19 @@ sub error_rm : ErrorRunmode {
}
}
+sub split_path {
+ my $self = shift;
+ my %options = @_;
+
+ my $script = $ENV{SCRIPT_NAME} // '';
+ my $uri = $self->query->request_uri;
+ $uri =~ s/^$script//s;
+ $uri =~ s/\?.*//s;
+
+ map { my $x = decodeURIComponent($_); Encode::_utf8_on($x); $x }
+ (split /\//, $uri);
+}
+
=head1 AUTHOR
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 02:15:01 +0000