aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost/Panel
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Fripost/Panel')
-rw-r--r--lib/Fripost/Panel/Interface.pm88
-rw-r--r--lib/Fripost/Panel/Login.pm9
2 files changed, 53 insertions, 44 deletions
diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm
index 7f7d770..b2ad686 100644
--- a/lib/Fripost/Panel/Interface.pm
+++ b/lib/Fripost/Panel/Interface.pm
@@ -15,7 +15,7 @@ use parent 'Fripost::Panel::Login';
use Fripost::Schema;
use Fripost::Schema::Util 'split_addr';
-use Fripost::Password;
+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/;
@@ -72,7 +72,7 @@ sub AddDomain : Runmode {
Encode::_utf8_on($domainname) if defined $domainname;
my $session_param;
- $session_param = 'AddDomain-owner-emails-'.domain_to_ascii($domainname)
+ $session_param = 'AddDomain-Owner-Emails-'.domain_to_ascii($domainname)
if defined $domainname;
my $error; # Tells whether the change submission has failed.
@@ -83,7 +83,8 @@ sub AddDomain : Runmode {
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."
+ $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;
}
@@ -107,14 +108,16 @@ sub AddDomain : Runmode {
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 );
+ ( $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,
+ 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;
@@ -125,7 +128,8 @@ sub AddDomain : Runmode {
# spoofed email.
$self->session->param( $session_param, join("\0", @owners) );
$self->session->flush;
- $template->param( owners => [ map {{owner => $_}} @owners ] )
+ $template->param( owners =>
+ [ map {{owner => encode_entities $_}} @owners ] )
}
return $template->output;
@@ -158,7 +162,7 @@ sub EditDomain : Runmode {
// die "404\n";
$fp->done;
- my $template = $self->load_tmpl( 'edit-domain.html', cache => 1,
+ my $template = $self->load_tmpl( 'edit-domain.html', cache => 1
, loop_context_vars => 1 );
$template->param( $self->userInfo );
$template->param( isPostmaster => $domain->{permissions} =~ /p/ );
@@ -194,11 +198,17 @@ sub ListLocals : Runmode {
if (defined $q->param('unlock')) {
# Unlock the domain, and come back to the home page.
# Errors are thrown away.
- $fp->domain->unlock( $domainname, $q->param('unlock'), -error => undef )
+ $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' )
@@ -207,8 +217,8 @@ sub ListLocals : Runmode {
# 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
+ map { $_->{name}= (split_addr $_->{name})[0]; # Remove the domainpart
+ $_->{URL} = &mkURL('.', $_->{name}) }# Add a URL
@locals;
my @users = grep { $_->{type} eq 'user' } @locals;
@@ -220,7 +230,7 @@ sub ListLocals : Runmode {
email_to_ascii($_->{name}.'@'.$domainname) }
@lists;
- my $template = $self->load_tmpl( 'list-locals.html', cache => 1,
+ my $template = $self->load_tmpl( 'list-locals.html', cache => 1
, loop_context_vars => 1 );
$template->param( $self->userInfo );
@@ -243,7 +253,7 @@ sub ListLocals : Runmode {
# Can the user add aliases?
$template->param( canAddalias => $domain->{permissions} =~ /[aop]/ );
- $template->param( listCanAddAlias => [ map { {item => encode_entities($_)} }
+ $template->param( listCanAddAlias => [ map { {item => encode_entities $_} }
@{$domain->{canAddAlias}} ] )
if $domain->{permissions} =~ /[op]/;
# Should we list aliases?
@@ -255,7 +265,7 @@ sub ListLocals : Runmode {
# Can the user add lists?
$template->param( canAddList => $domain->{permissions} =~ /[lop]/ );
- $template->param( listCanAddList => [ map { {item => encode_entities($_)} }
+ $template->param( listCanAddList => [ map { {item => encode_entities $_} }
@{$domain->{canAddList}} ] )
if $domain->{permissions} =~ /[op]/;
# Should we list lists?
@@ -282,7 +292,7 @@ sub AddLocal : Runmode {
# Get the domain name from the URL.
my $domainname = ($self->split_path)[1];
- my $t = $q->param('t') // return $self->redirect('./');
+ 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 );
@@ -305,10 +315,12 @@ sub AddLocal : Runmode {
." characters long.";
}
else {
- $local->{password} = Fripost::Password::hash($q->param('password'));
+ $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
@@ -334,11 +346,14 @@ sub AddLocal : Runmode {
$template->param( $self->userInfo
, domainname => encode_entities($domainname)
, &fill_HTML_template_from_query ($q));
- $template->param( transport =>
- [ { item => 'mailman', selected => $q->param('transport') eq 'mailman', name => 'GNU Mailman' }
- , { item => 'schleuder', selected => $q->param('transport') eq 'schleuder', name => 'Schleuder' }
- ]) # TODO ugly
- if $t eq 'list' and defined $q->param('transport');
+ $template->param( transport => [
+ map { { item => $_
+ , name => ucfirst $_
+ , selected => $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;
}
@@ -361,8 +376,6 @@ sub EditLocal : Runmode {
# Search for *the* matching user, alias or list.
$fp->domain->search ($domainname, -filter => 'unlocked', -count => 1)
or die "404\n";
- my $local = $fp->local->search ($name, -filter => 'unlocked')
- or die "404\n";
my $error; # Tells whether the change submission has failed.
if (defined $q->param('a') and $q->param('a') eq 'delete') {
@@ -373,13 +386,15 @@ sub EditLocal : Runmode {
return $self->redirect('../');
}
}
- $fp->done;
+ 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->{type} = $q->param('t');
$local->{name} = $name;
+ $local->{type} = $t;
my %rest;
if ($q->param('password') || $q->param('password2')) {
@@ -397,26 +412,18 @@ sub EditLocal : Runmode {
$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 $t = $local->{type};
my $template = $self->load_tmpl( "edit-$t.html", cache => 1 );
$template->param( $self->userInfo
, localpart => encode_entities($localname)
, domainpart => encode_entities($domainname) );
-
- if ($error) {
- # Preserve the (incorrect) form, except the passwords
- $template->param( &fill_HTML_template_from_query ($q) );
- }
- else {
- $template->param( &fill_HTML_template_from_entry ($local,
- -hide => [qw/quota transport/]) );
- }
- # TODO: submit
+ $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 );
@@ -471,7 +478,7 @@ sub fill_HTML_template_from_entry {
}
elsif (grep {$key eq $_} (qw/URL list_URL transport/,
@single_valued_keys)) {
- $vars{$key} = $entry->{$key};
+ $vars{$key} = encode_entities($entry->{$key});
}
elsif (grep {$key eq $_} @multi_valued_keys) {
my @array = map { encode_entities ($_) } @{$entry->{$key}};
@@ -492,9 +499,11 @@ sub fill_HTML_template_from_query {
my %rest = @_;
my %vars;
- $params{$_} = encode_entities ($rest{$_}) for keys %rest;
+ $params{$_} = $rest{$_} for keys %rest;
foreach my $key (keys %params) {
- $vars{$key} = $params{$key} // undef
+ 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;
@@ -508,8 +517,9 @@ sub parse_CGI_query {
$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 ($key eq 'name') {
+ if (grep { $key eq $_ } qw/name transport/) {
$entry->{$key} = $params{$key};
}
elsif (grep {$key eq $_} @single_valued_keys) {
diff --git a/lib/Fripost/Panel/Login.pm b/lib/Fripost/Panel/Login.pm
index 22a870a..3b2846a 100644
--- a/lib/Fripost/Panel/Login.pm
+++ b/lib/Fripost/Panel/Login.pm
@@ -19,7 +19,6 @@ use CGI::Application::Plugin::Redirect;
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';
@@ -60,8 +59,8 @@ sub cgiapp_init {
$CFG{default_realm} // return 0;
$u .= '@'.$CFG{default_realm};
}
- my $fp = Fripost::Schema::->auth($u, $p, %CFG, -die => 0);
- return 0 unless defined $fp;
+ my $fp = Fripost::Schema::->auth($u, $p, %CFG, -error => undef)
+ // return 0;
$fp->done;
return $u;
} ],
@@ -223,8 +222,8 @@ sub split_path {
$script =~ s@/$@@s; # Strip the trailing '/' off the script name
my $uri = $self->query->request_uri;
- $uri =~ s/^$script//s; # Strip the facing CGI script name
- $uri =~ s/\?.*//s; # Strip the query
+ $uri =~ s/^\Q$script\E\b//s; # Strip the facing CGI script name
+ $uri =~ s/\?.*//s; # Strip the query
map { my $x = decodeURIComponent($_); Encode::_utf8_on($x); $x }
(split '/', $uri);
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 02:07:43 +0000