aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Fripost')
-rw-r--r--lib/Fripost/Panel/Interface.pm341
-rw-r--r--lib/Fripost/Panel/Login.pm14
-rw-r--r--lib/Fripost/Schema/Domain.pm12
3 files changed, 206 insertions, 161 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);
}
diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm
index 5e25c22..738df0c 100644
--- a/lib/Fripost/Schema/Domain.pm
+++ b/lib/Fripost/Schema/Domain.pm
@@ -383,11 +383,13 @@ sub canIAdd {
-=item B<list_admin_emails> (I<domainname>, I<OPTIONS>)
+=item B<list_owner_emails> (I<domainname>, I<OPTIONS>)
-Search for postmaster e-mail addresses for I<domainname>. For
-I<domainname> itself and each of its parents, this routine searches for
-a valid WHOIS containing e-mails, and lists postmaster@hostname (RFC
+Search for the e-mail addresses of the person(s) who registered
+I<domainname> to a registar, hence who can claim "owning" this domain.
+
+For I<domainname> itself and each of its parents, this routine searches
+for a valid WHOIS containing e-mails, and lists postmaster@hostname (RFC
822, appendix C.6) if hostname has a MX record and does not use ours
yet.
@@ -396,7 +398,7 @@ B<Fripost::Schema::Util> for details.
=cut
-sub list_admin_emails {
+sub list_owner_emails {
my $self = shift;
my $domainname = shift;
my %options = @_;
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 08:55:53 +0000