aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--INSTALL3
-rw-r--r--README132
-rw-r--r--TODO.org18
-rw-r--r--lib/Fripost/Panel/Interface.pm128
-rw-r--r--lib/Fripost/Panel/Login.pm25
-rw-r--r--lib/Fripost/Schema.pm6
-rw-r--r--lib/Fripost/Schema/Alias.pm24
-rw-r--r--lib/Fripost/Schema/Domain.pm20
-rw-r--r--lib/Fripost/Schema/List.pm20
-rw-r--r--lib/Fripost/Schema/Local.pm20
-rw-r--r--lib/Fripost/Schema/Mailbox.pm28
-rw-r--r--lib/Fripost/Schema/Misc.pm5
-rwxr-xr-xserver.pl2
13 files changed, 296 insertions, 135 deletions
diff --git a/INSTALL b/INSTALL
index 6782035..0ffeb21 100644
--- a/INSTALL
+++ b/INSTALL
@@ -15,4 +15,5 @@ apt-get install libnet-ldap-perl \
libauthen-sasl-perl \
libemail-valid-perl \
libdigest-perl \
- libstring-mkpasswd-perl
+ libstring-mkpasswd-perl \
+ libnet-idn-encode-perl
diff --git a/README b/README
new file mode 100644
index 0000000..0066727
--- /dev/null
+++ b/README
@@ -0,0 +1,132 @@
+This is the Administrator Panel used by Fripost - the Free E-mail
+Association.
+
+Visit our website for more information:
+https://fripost.org/
+
+Please send patches, bug reports and comments to:
+guilhem@fripost.org
+
+* Installation
+
+Read installation file INSTALL and follow those instructions.
+
+** LDAP
+
+The panel, or rather the Fripost::Schema library itself, requires
+Fripost's LDAP schema, and base directory. See our other repository
+
+ git clone gitolite@git.fripost.org:fripost-admin.git
+
+for how to install those.
+
+** Configuration
+
+The configuration file 'default.in' is not to be modified. (Also, some of
+the keys defined there are required.) Instead use the 'config.in' for
+custom modifications.
+Both files are equal separated (e.g., key=value) configuration file.
+Comments (prefixed with a hash #) and blank/empty lines are ignored.
+
+** Web server
+
+TODO: instructions for Apache and Nginx.
+
+** Development
+
+For testing purposes, the developers may want to install
+HTTP::Server::Simple and use our custom clone of
+CGI::Application::Server.
+./server.pl will start a server listening to localhost:8080.
+Visit http://127.0.0.1:8080/cgi-bin/ to log in and browse the panel.
+
+* Usage
+
+** URL formats.
+
+The following URL formats are accepted. (The user needs to be logged in
+to browse those.)
+
+*** /cgi-bin/
+
+List domains known (visible) by the logged in user.
+
+*** /cgi-bin/?a=add
+
+Add a domain
+
+*** /cgi-bin/example.org/
+
+List mailboxes, aliases and mailing lists under the domain 'example.org'.
+
+*** /cgi-bin/example.org/?a=edit
+
+Edit domain 'example.org'.
+
+*** /cgi-bin/example.org/?a=add&t=mailbox
+
+Add a new mailbox under the domain 'example.org'.
+
+*** /cgi-bin/example.org/?a=add&t=alias
+
+Add a new alias under the domain 'example.org'.
+
+*** /cgi-bin/example.org/?a=add&t=list
+
+Add a new mailing list under the domain 'example.org'.
+
+*** /cgi-bin/example.org/test/
+
+Edit the mailbox, alias or mailing list 'test@example.org'.
+
+*** /cgi-bin/example.org/test/?a=delete
+
+Delete the mailbox, alias or mailing list 'test@example.org'.
+
+*** /...?a=login
+
+Login. (Force logout first).
+
+*** /...?a=logout
+
+Logout.
+
+** Passwords
+
+When a someone wants to change a password, the authenticated user
+(either the owner of the password, or his/her postmaster) has to bind
+with his/her own credential first. The reason is, we want to prevent an
+attacker from changing a password, for instance on a session that was
+left open, and browse the e-mail afterwards.
+
+No one should have read access to the (hashed) passwords, not even its
+owner.
+
+** Internationalization
+
+UTF-8 is handled smoothly by the library, as far as descriptions are
+concerned.
+
+Internationalized Domain Names (IDN) are also allowed, but are stored
+punycode-encoded. This is because Postfix itself doesn't accept IDNs
+(SMTP is a ASCII protocol), and requires the client to do the
+transformation itself. Our library takes/returns unicode data, and does
+the conversion under the hood. The owner of a IDN mailbox (e.g.,
+peace@☮.net) can login to the panel using unicode or punycode, but other
+services (Webmail, IMAP, SASL,...) may require him/her to use the punycode
+version.
+
+*** Limitations
+
+Net::IDN::Encode is used for the conversion from unicode to punycode and
+back (RFC 2821/2822). As of version 1.102 it does not support
+internationalization of the local-part, so our panel does not either.
+
+Email::Valid is used to check the validity of email (RFC 822), which in
+turns uses Net::Domain::TLD to check the validity of top level domains.
+However, as of version 1.69, Net::Domain::TLD does not support
+internationalized TLDs (neither unicode nor punycode), so our panel does
+not either. See also:
+ - https://rt.cpan.org/Public/Bug/Display.html?id=62964
+ - https://en.wikipedia.org/wiki/Tld#IDN_test_domains
+
diff --git a/TODO.org b/TODO.org
index 2d57048..a9e6b57 100644
--- a/TODO.org
+++ b/TODO.org
@@ -1,23 +1,27 @@
-* Email::Valid does not accept UTF-8 emails adresses (e.g., test@ƛ.net).
+* DONE Email::Valid does not accept UTF-8 emails adresses (e.g., test@ƛ.net).
LDAP doesn't allow UTF-8 in the DNs anyway, so maybe convert the
domains/emails to Punycode internally?
-* What to do when a user wants to add a domain? Is it worth it to send a confirmation e-mail?
+* TODO What to do when a user wants to add a domain? Is it worth it to send a confirmation e-mail?
-* Better check for existing lists (commands).
+* TODO Better check for existing lists (commands).
- When adding a new alias/mailbox 'test', check for existing alias/mailbox 'test', and list 'test'.
- When adding a new alias/mailbox 'test-request', check for existing alias/mailbox 'test-request', list 'test-request' *and* list 'test'. (The same for other list commands.)
- When adding a new list 'test', check for existing alias/mailbox/list 'test', 'test-request',...
- When adding a new list 'test-request', check for existing alias/mailbox/list 'test-request', 'test-request-request',... *and* list 'test'. (The same for other list commands.)
-* Check for cycles when creating new aliases?
+* TODO Check for cycles when creating new aliases?
(It is impossible since the authenticated user may not have full read access on the graph)
Hopefully Postfix checks it and warns the postmaster.
-* Write a script to check every runmode against the W3 validator.
+* TODO Write a script to check every runmode against the W3 validator.
-* Use FastCGI. References
+* TODO Use FastCGI. References
- http://search.cpan.org/~naoya/CGI-Application-FastCGI-0.02/lib/CGI/Application/FastCGI.pm
- http://stackoverflow.com/questions/11771564/nginx-fastcgi-configuration-for-cgiapplication-app
-* Use HTML::Template::Pro. Not sure it's really worth it, though.
+* TODO Use HTML::Template::Pro. Not sure it's really worth it, though.
+
+* TODO Forbid `/' and `\0' to appear in the domain/user name.
+
+* TODO How should we encode the URL for internationalized domain names? Punicode vs. unicode vs. HTML entities?
diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm
index 6859e57..0b7860e 100644
--- a/lib/Fripost/Panel/Interface.pm
+++ b/lib/Fripost/Panel/Interface.pm
@@ -15,6 +15,7 @@ use parent 'Fripost::Panel::Login';
use Fripost::Schema;
use Fripost::Password;
use HTML::Entities;
+use Net::IDN::Encode qw/email_to_unicode/;
# This method is called right before the 'setup' method below. It
@@ -34,7 +35,7 @@ sub ListDomains : StartRunmode {
my $self = shift;
my %CFG = $self->cfg;
- my ($ul,$ud) = split /\@/, $self->authen->username, 2;
+ my ($ul,$ud) = split /\@/, email_to_unicode($self->authen->username), 2;
my $fp = Fripost::Schema->SASLauth( $self->authen->username, %CFG );
my @domains = $fp->domain->search( -concat => "\n", -die => 403);
@@ -44,9 +45,12 @@ sub ListDomains : StartRunmode {
, loop_context_vars => 1
, global_vars => 1 );
$template->param( url => $self->query->url
- , user_localpart => $ul
- , user_domainpart => $ud
- , domains => [ @domains ]
+ , user_localpart => encode_entities($ul)
+ , user_domainpart => encode_entities($ud)
+ , domains => [ map { { domain => encode_entities($_->{domain})
+ , isactive => $_->{isactive}
+ , description => $_->{description} } }
+ @domains ]
);
return $template->output;
}
@@ -58,8 +62,9 @@ sub ListLocals : Runmode {
my $self = shift;
my %CFG = $self->cfg;
- my ($ul,$ud) = split /\@/, $self->authen->username, 2;
- my $d = (split /\//, $ENV{PATH_INFO}, 3)[1];
+ 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 $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
# Query *the* matching domain
@@ -79,10 +84,10 @@ sub ListLocals : Runmode {
, global_vars => 1 );
$template->param( url => $self->query->url
- , user_localpart => $ul
- , user_domainpart => $ud
+ , user_localpart => encode_entities($ul)
+ , user_domainpart => encode_entities($ud)
);
- $template->param( domain => $domain{domain}
+ $template->param( domain => encode_entities($domain{domain})
, isactive => $domain{isactive}
, description => join ("\n", @{$domain{description}}) );
# Can the user edit the domain (change description, toggle
@@ -95,10 +100,11 @@ sub ListLocals : Runmode {
$template->param( listMailboxes => $#mailboxes >= 0 ||
$domain{permissions} =~ /p/ );
$template->param( mailboxes => [
- map { { user => $_->{user}
+ map { { user => encode_entities($_->{user})
, description => join ("\n", @{$_->{description}})
, isactive => $_->{isactive}
- , forwards => [ map { {forward => $_} } @{$_->{forwards}} ]
+ , forwards => [ map { {forward => encode_entities($_)} }
+ @{$_->{forwards}} ]
, quota => $_->{quota}
};
}
@@ -111,16 +117,16 @@ sub ListLocals : Runmode {
$template->param( listAliases => $#aliases >= 0 ||
$domain{permissions} =~ /[aop]/ );
$template->param( aliases => [
- map { { alias => $_->{alias}
+ map { { alias => encode_entities($_->{alias})
, description => join ("\n", @{$_->{description}})
, isactive => $_->{isactive}
- , destinations => [ map { {destination => $_} }
+ , destinations => [ map { {destination => encode_entities($_)} }
@{$_->{maildrop}} ]
};
}
@aliases
]);
- $template->param( catchalls => [ map { {catchall => $_} }
+ $template->param( catchalls => [ map { {catchall => encode_entities($_)} }
@{$domain{catchalls}} ]
, CAodd => not $#aliases % 2);
@@ -129,7 +135,7 @@ sub ListLocals : Runmode {
# Should we list lists?
$template->param( listLists => $#lists >= 0 || $domain{permissions} =~ /[lop]/ );
$template->param( lists => [
- map { { list => $_->{list}
+ map { { list => encode_entities($_->{list})
, description => join ("\n", @{$_->{description}})
, isactive => $_->{isactive}
, transport => $_->{transport}
@@ -147,8 +153,9 @@ sub EditDomain : Runmode {
my $self = shift;
my %CFG = $self->cfg;
- my ($ul,$ud) = split /\@/, $self->authen->username, 2;
- my $d = (split /\//, $ENV{PATH_INFO}, 3)[1];
+ 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 $q = $self->query;
return $self->redirect($q->url .'/') if defined $q->param('cancel');
@@ -172,9 +179,9 @@ sub EditDomain : Runmode {
, loop_context_vars => 1
, global_vars => 1 );
$template->param( url => $q->url
- , user_localpart => $ul
- , user_domainpart => $ud
- , domain => $d
+ , user_localpart => encode_entities($ul)
+ , user_domainpart => encode_entities($ud)
+ , domain => encode_entities($d)
);
if ($error) {
# Preserve the (incorrect) form
@@ -188,7 +195,8 @@ sub EditDomain : Runmode {
, description => join ("\x{0D}\x{0A}",
@{$domain{description}})
, catchalls => join ("\x{0D}\x{0A}",
- @{$domain{catchalls}}) );
+ map { encode_entities ($_) }
+ @{$domain{catchalls}}) );
}
$template->param( newChanges => defined $q->param('submit') );
return $template->output;
@@ -201,8 +209,10 @@ sub EditLocal : Runmode {
my $self = shift;
my %CFG = $self->cfg;
- my ($ul,$ud) = split /\@/, $self->authen->username, 2;
+ 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');
@@ -210,8 +220,8 @@ sub EditLocal : Runmode {
my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
# Search for *the* matching mailbox, alias or list.
- my %local = $fp->local->get ($l, $d, -die => 404,
- -concat => "\x{0D}\x{0A}");
+ my %local = $fp->local->get ($lu.'@'.$du, -die => 404,
+ -concat => "\x{0D}\x{0A}");
die "Unknown type" unless grep { $local{type} eq $_ }
qw/mailbox alias list/;
@@ -220,17 +230,17 @@ sub EditLocal : Runmode {
if (defined $q->param('a') and $q->param('a') eq 'delete') {
# Delete the entry
- $error = $fp->$t->delete($l, $d, -die => 0);
+ $error = $fp->$t->delete($lu.'@'.$du, -die => 0);
unless ($error) {
$fp->done;
return $self->redirect($q->url .'/'. $d .'/');
}
}
- elsif (defined $q->param('submit')) {
+ if (defined $q->param('submit')) {
# Changes have been submitted: process them
my %entry;
if ($t eq 'mailbox') {
- $entry{user} = $l.'@'.$d;
+ $entry{user} = $lu.'@'.$du;
$entry{forwards} = $q->param('forwards');
if ($q->param('oldpw') ne '' or
@@ -250,13 +260,14 @@ sub EditLocal : Runmode {
else {
my $fp;
eval {
+ my $u = email_to_unicode($self->authen->username);
$fp = Fripost::Schema::->auth(
- $self->authen->username,
+ $u,
$q->param('oldpw'),
ldap_uri => $CFG{ldap_uri},
ldap_suffix => $CFG{ldap_suffix},
-die => "Wrong password (for ‘"
- .$self->authen->username."‘)." );
+ .encode_entities($u)."‘)." );
};
$error = $@ || $fp->mailbox->passwd(
$entry{user},
@@ -267,66 +278,60 @@ sub EditLocal : Runmode {
}
}
elsif ($t eq 'alias') {
- $entry{alias} = $l.'@'.$d;
+ $entry{alias} = $lu.'@'.$du;
$entry{maildrop} = $q->param('maildrop');
}
elsif ($t eq 'list') {
- $entry{list} = $l.'@'.$d;
+ $entry{list} = $lu.'@'.$du;
$entry{transport} = $q->param('transport');
}
- else {
- # Unknown type
- return $self->redirect($q->url .'/'. $d .'/');
- }
$entry{isactive} = $q->param('isactive');
$entry{description} = $q->param('description');
$error = $fp->$t->replace( \%entry, -concat => "(\n|\x{0D}\x{0A})")
unless $error;
}
- $fp->done;
-
my $template = $self->load_tmpl( "edit-$t.html",
cache => 1, utf8 => 1 );
$template->param( url => $q->url
- , user_localpart => $ul
- , user_domainpart => $ud
- , domain => $d
+ , user_localpart => encode_entities($ul)
+ , user_domainpart => encode_entities($ud)
+ , domain => encode_entities($du)
);
if ($error and defined $q->param('submit')) {
# Preserve the (incorrect) form, except the passwords
- if ($local{type} eq 'mailbox') {
- $template->param( user => $l
+ if ($t eq 'mailbox') {
+ $template->param( user => encode_entities($l)
, forwards => $q->param('forwards') );
}
- elsif ($local{type} eq 'alias') {
- $template->param( alias => $l
+ elsif ($t eq 'alias') {
+ $template->param( alias => encode_entities($l)
, maildrop => $q->param('maildrop') );
}
- elsif ($local{type} eq 'list') {
- $template->param( list => $l );
- }
- else {
- die "Unknown type";
+ elsif ($t eq 'list') {
+ $template->param( list => encode_entities($l) );
}
$template->param( isactive => $q->param('isactive')
, description => $q->param('description') );
}
else {
+ %local = $fp->local->get ($lu.'@'.$du, -die => 404,
+ -concat => "\x{0D}\x{0A}");
if ($t eq 'mailbox') {
- $template->param( user => $local{user}
- , forwards => $local{forwards} );
+ $template->param( user => encode_entities($local{user})
+ , forwards => encode_entities($local{forwards}) );
}
elsif ($t eq 'alias') {
- $template->param( alias => $local{alias}
- , maildrop => $local{maildrop} );
+ $template->param( alias => encode_entities($local{alias})
+ , maildrop => encode_entities($local{maildrop}) );
}
elsif ($t eq 'list') {
- $template->param( list => $local{list} );
+ $template->param( list => encode_entities($local{list}) );
}
$template->param( isactive => $local{isactive}
, description => $local{description} );
}
+ $fp->done;
my $news = (defined $q->param('submit') or
(defined $q->param('a') and $q->param('a') eq 'delete'));
$template->param( newChanges => $news );
@@ -343,8 +348,9 @@ sub AddLocal : Runmode {
my $self = shift;
my %CFG = $self->cfg;
- my ($ul,$ud) = split /\@/, $self->authen->username, 2;
+ 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');
@@ -355,7 +361,7 @@ sub AddLocal : Runmode {
# Changes have been submitted: process them
my %entry;
if ($t eq 'mailbox') {
- $entry{user} = $q->param('user').'@'.$d;
+ $entry{user} = $q->param('user').'@'.$du;
$entry{forwards} = $q->param('forwards');
if ($q->param('password') ne $q->param('password2')) {
$error = "Passwords do not match";
@@ -371,11 +377,11 @@ sub AddLocal : Runmode {
# TODO: inherit the quota from the postmaster's?
}
elsif ($t eq 'alias') {
- $entry{alias} = $q->param('alias').'@'.$d;
+ $entry{alias} = $q->param('alias').'@'.$du;
$entry{maildrop} = $q->param('maildrop');
}
elsif ($t eq 'list') {
- $entry{list} = $q->param('list').'@'.$d;
+ $entry{list} = $q->param('list').'@'.$du;
$entry{transport} = $q->param('transport');
}
else {
@@ -395,9 +401,9 @@ sub AddLocal : Runmode {
my $template = $self->load_tmpl( "add-$t.html", cache => 1, utf8 => 1 );
$template->param( url => $q->url
- , user_localpart => $ul
- , user_domainpart => $ud
- , domain => $d
+ , user_localpart => encode_entities($ul)
+ , user_domainpart => encode_entities($ud)
+ , domain => encode_entities($du)
);
if ($error) {
# Preserve the (incorrect) form, except the passwords
diff --git a/lib/Fripost/Panel/Login.pm b/lib/Fripost/Panel/Login.pm
index 8dcfd2b..a147371 100644
--- a/lib/Fripost/Panel/Login.pm
+++ b/lib/Fripost/Panel/Login.pm
@@ -19,10 +19,10 @@ use CGI::Application::Plugin::Authentication;
use CGI::Application::Plugin::Redirect;
use CGI::Application::Plugin::ConfigAuto 'cfg';
-use Net::LDAP;
-use Authen::SASL;
+use Fripost::Schema;
use File::Spec::Functions qw/catfile catdir/;
use HTML::Entities;
+use Net::IDN::Encode qw/email_to_ascii/;
# This method is called right before the 'setup' method below. It
@@ -56,19 +56,22 @@ sub cgiapp_init {
$self->authen->config(
DRIVER => [ 'Generic', sub {
my ($u,$p) = @_;
- my ($l,$d) = split /\@/, $u, 2;
+ my $d = (split /\@/, $u, 2)[1];
unless (defined $d) {
$CFG{default_realm} // return 0;
- $d = $CFG{default_realm};
- $u .= '@'.$d;
+ $u .= '@'.$CFG{default_realm};
}
- my $bind_dn = "fvu=$l,fvd=$d,". join (',', @{$CFG{ldap_suffix}});
-
- my $ldap = Net::LDAP->new( $CFG{ldap_uri} );
- my $mesg = $ldap->bind ( $bind_dn, password => $p );
- $ldap->unbind;
- $mesg->code ? 0 : $u;
+ Encode::_utf8_on($u);
+ $u = Net::IDN::Encode::email_to_ascii($u);
+ my $fp = Fripost::Schema::->auth($u, $p,
+ ldap_uri => $CFG{ldap_uri},
+ ldap_suffix => $CFG{ldap_suffix},
+ -die => 0
+ );
+ return 0 unless defined $fp;
+ $fp->done;
+ return $u;
} ],
STORE => 'Session',
LOGIN_RUNMODE => 'login',
diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm
index 36b7d54..3e89e6c 100644
--- a/lib/Fripost/Schema.pm
+++ b/lib/Fripost/Schema.pm
@@ -25,6 +25,7 @@ use Fripost::Schema::Mailbox;
use Fripost::Schema::Alias;
use Fripost::Schema::List;
use Fripost::Schema::Local;
+use Net::IDN::Encode qw/email_to_ascii/;
=head1 METHODS
@@ -83,7 +84,10 @@ sub auth {
my $mesg = $self->ldap->bind( $self->whoami, password => $pw );
if ($mesg->code) {
- die $cfg{'-die'}."\n" if defined $cfg{'-die'};
+ if (defined $cfg{'-die'}) {
+ return unless $cfg{'-die'};
+ die $cfg{'-die'}."\n";
+ }
die $mesg->error;
}
return $self;
diff --git a/lib/Fripost/Schema/Alias.pm b/lib/Fripost/Schema/Alias.pm
index 0976093..556a7d3 100644
--- a/lib/Fripost/Schema/Alias.pm
+++ b/lib/Fripost/Schema/Alias.pm
@@ -18,6 +18,8 @@ use utf8;
use parent 'Fripost::Schema';
use Fripost::Schema::Misc qw/concat explode must_attrs email_valid/;
+use Net::IDN::Encode qw/domain_to_ascii
+ email_to_ascii email_to_unicode/;
=head1 METHODS
@@ -33,7 +35,7 @@ is a array of hash references, sorted by alias.
sub search {
my $self = shift;
- my $domain = shift;
+ my $domain = domain_to_ascii(shift);
my %options = @_;
my $concat = $options{'-concat'};
@@ -49,10 +51,11 @@ sub search {
die $options{'-die'}."\n" if defined $options{'-die'};
die $aliases->error;
}
- return map { { alias => $_->get_value('fva')
+ return map { { alias => email_to_unicode($_->get_value('fva'))
, isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
, description => concat($concat, $_->get_value('description'))
- , maildrop => concat($concat, $_->get_value('fripostMaildrop'))
+ , maildrop => concat($concat, map { email_to_unicode ($_) }
+ $_->get_value('fripostMaildrop'))
}
}
$aliases->sorted('fva')
@@ -75,9 +78,8 @@ sub replace {
if defined $a->{$_};
}
- my ($l,$d) = split /\@/, $a->{alias}, 2;
-
eval {
+ my ($l,$d) = split /\@/, email_to_ascii($a->{alias}), 2;
&_is_valid($a);
my $mesg = $self->ldap->modify(
"fva=$l,fvd=$d,".$self->suffix,
@@ -108,13 +110,12 @@ sub add {
if defined $a->{$_};
}
- my ($l,$d) = split /\@/, $a->{alias}, 2;
-
eval {
+ my ($l,$d) = split /\@/, email_to_ascii($a->{alias}), 2;
die "Missing alias name\n" if $l eq '';
&_is_valid($a);
die "‘".$a->{alias}."‘ alread exists\n"
- if $self->local->exists($l,$d,%options);
+ if $self->local->exists($a->{alias},%options);
my %attrs = ( objectClass => 'FripostVirtualAlias'
, fripostIsStatusActive => $a->{isactive} ? 'TRUE' : 'FALSE'
@@ -135,7 +136,7 @@ sub add {
}
-=item B<delete> (I<alias>, I<domain>, I<OPTIONS>)
+=item B<delete> (I<alias>, I<OPTIONS>)
Delete the given alias.
@@ -143,8 +144,7 @@ Delete the given alias.
sub delete {
my $self = shift;
- my $l = shift;
- my $d = shift;
+ my ($l,$d) = split /\@/, email_to_ascii(shift), 2;
my %options = @_;
my $mesg = $self->ldap->delete( "fva=$l,fvd=$d,".$self->suffix );
@@ -175,7 +175,7 @@ The B<-die> option, if present, overides LDAP croaks and errors.
sub _is_valid {
my $a = shift;
must_attrs( $a, qw/alias isactive maildrop/ );
- email_valid( $a->{alias}, -exact => 1 );
+ $a->{alias} = email_valid( $a->{alias}, -exact => 1 );
$a->{maildrop} = [ map { email_valid($_) } @{$a->{maildrop}} ];
# TODO: check for cycles?
}
diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm
index e1b855f..3f2c9c5 100644
--- a/lib/Fripost/Schema/Domain.pm
+++ b/lib/Fripost/Schema/Domain.pm
@@ -17,8 +17,10 @@ use warnings;
use utf8;
use parent 'Fripost::Schema';
-use Fripost::Schema::Misc qw/concat get_perms explode must_attrs email_valid/;
-use Email::Valid;
+use Fripost::Schema::Misc qw/concat get_perms explode
+ must_attrs email_valid/;
+use Net::IDN::Encode qw/domain_to_ascii domain_to_unicode
+ email_to_ascii email_to_unicode/;
=head1 METHODS
@@ -48,7 +50,7 @@ sub search {
die $options{'-die'}."\n" if defined $options{'-die'};
die $domains->error;
}
- return map { { domain => $_->get_value('fvd')
+ return map { { domain => domain_to_unicode($_->get_value('fvd'))
, isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
, description => concat($concat, $_->get_value('description'))
}
@@ -65,7 +67,7 @@ Returns a hash with all the (visible) attributes for the given domain.
sub get {
my $self = shift;
- my $d = shift;
+ my $d = domain_to_ascii(shift);
my %options = @_;
my $concat = $options{'-concat'};
@@ -95,10 +97,11 @@ sub get {
die "No such such domain ‘$d‘.\n";
}
- return ( domain => $domain->get_value('fvd')
+ return ( domain => domain_to_unicode($domain->get_value('fvd'))
, isactive => $domain->get_value('fripostIsStatusActive') eq 'TRUE'
, description => concat($concat, $domain->get_value('description'))
- , catchalls => concat($concat, $domain->get_value('fripostOptionalMaildrop'))
+ , catchalls => concat($concat, map { email_to_unicode ($_) }
+ $domain->get_value('fripostOptionalMaildrop'))
, permissions => get_perms($domain, $self->whoami)
)
}
@@ -157,8 +160,9 @@ The B<-die> option, if present, overides LDAP croaks and errors.
sub _is_valid {
my $d = shift;
must_attrs( $d, qw/domain isactive/ );
- email_valid( $d->{domain}, -prefix => 'fake@', -error => 'Invalid domain',
- -exact => 1 );
+ $d->{domain} = email_valid( $d->{domain}, -prefix => 'fake@',
+ -error => 'Invalid domain',
+ -exact => 1 );
$d->{catchalls} = [ map { email_valid($_, -prefix => 'fake') }
@{$d->{catchalls}} ];
}
diff --git a/lib/Fripost/Schema/List.pm b/lib/Fripost/Schema/List.pm
index ec66f76..c6fb4f2 100644
--- a/lib/Fripost/Schema/List.pm
+++ b/lib/Fripost/Schema/List.pm
@@ -18,6 +18,8 @@ use utf8;
use parent 'Fripost::Schema';
use Fripost::Schema::Misc qw/concat explode must_attrs email_valid/;
+use Net::IDN::Encode qw/domain_to_ascii
+ email_to_ascii email_to_unicode/;
=head1 METHODS
@@ -33,7 +35,7 @@ is a array of hash references, sorted by list.
sub search {
my $self = shift;
- my $domain = shift;
+ my $domain = domain_to_ascii(shift);
my %options = @_;
my $concat = $options{'-concat'};
@@ -49,7 +51,7 @@ sub search {
die $options{'-die'}."\n" if defined $options{'-die'};
die $lists->error;
}
- return map { { list => $_->get_value('fvl')
+ return map { { list => email_to_unicode($_->get_value('fvl'))
, isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
, description => concat($concat, $_->get_value('description'))
, transport => $_->get_value('fripostListManager')
@@ -73,9 +75,8 @@ sub replace {
$l->{description} = explode ($options{'-concat'}, $l->{description})
if defined $l->{description};
- my ($l2,$d) = split /\@/, $l->{list}, 2;
-
eval {
+ my ($l2,$d) = split /\@/, email_to_ascii($l->{list}), 2;
&_is_valid($l);
my $l3 = { fripostIsStatusActive => $l->{isactive} ? 'TRUE' : 'FALSE'
, description => $l->{description} };
@@ -103,14 +104,14 @@ sub add {
$l->{description} = explode ($options{'-concat'}, $l->{description})
if defined $l->{description};
- my ($l2,$d) = split /\@/, $l->{list}, 2;
eval {
+ my ($l2,$d) = split /\@/, email_to_ascii($l->{list}), 2;
die "Missing list name\n" if $l eq '';
must_attrs( $l, 'transport' );
&_is_valid($l);
die "‘".$l->{list}."‘ alread exists\n"
- if $self->local->exists($l2,$d,%options);
+ if $self->local->exists($l->{list},%options);
my %attrs = ( objectClass => 'FripostVirtualList'
, fripostIsStatusActive => $l->{isactive} ? 'TRUE' : 'FALSE'
@@ -143,7 +144,7 @@ sub add {
}
-=item B<delete> (I<list>, I<domain>, I<OPTIONS>)
+=item B<delete> (I<list>, I<OPTIONS>)
Delete the given list. Note: this will NOT wipe the archives off the
disk, but merely delete the list entry in the LDAP directory.
@@ -152,8 +153,7 @@ disk, but merely delete the list entry in the LDAP directory.
sub delete {
my $self = shift;
- my $l = shift;
- my $d = shift;
+ my ($l,$d) = split /\@/, email_to_ascii(shift), 2;
my %options = @_;
my $mesg = $self->ldap->delete( "fvl=$l,fvd=$d,".$self->suffix );
@@ -184,7 +184,7 @@ The B<-die> option, if present, overides LDAP croaks and errors.
sub _is_valid {
my $l = shift;
must_attrs( $l, qw/list isactive/ );
- email_valid( $l->{list}, -exact => 1 );
+ $l->{list} = email_valid( $l->{list}, -exact => 1 );
die "Invalid transport: ‘".$l->{transport}."‘\n"
if defined $l->{transport} and
diff --git a/lib/Fripost/Schema/Local.pm b/lib/Fripost/Schema/Local.pm
index 79c5420..64dd622 100644
--- a/lib/Fripost/Schema/Local.pm
+++ b/lib/Fripost/Schema/Local.pm
@@ -18,13 +18,14 @@ use utf8;
use parent 'Fripost::Schema';
use Fripost::Schema::Misc 'concat';
+use Net::IDN::Encode qw/email_to_ascii email_to_unicode/;
=head1 METHODS
=over 4
-=item B<get> (I<local>,I<domain>, I<OPTIONS>)
+=item B<get> (I<local>, I<OPTIONS>)
Returns a hash with all the (visible) attributes for the given entry. An
additional 'type' attribute gives the type of *the* found entry
@@ -34,11 +35,11 @@ additional 'type' attribute gives the type of *the* found entry
sub get {
my $self = shift;
- my $l = shift;
- my $d = shift;
+ my $loc = shift;
my %options = @_;
my $concat = $options{'-concat'};
+ my ($l,$d) = split /\@/, email_to_ascii($loc), 2;
my $locals = $self->ldap->search(
base => "fvd=$d,".$self->suffix,
scope => 'one',
@@ -67,19 +68,21 @@ sub get {
unless (defined $local) {
die $options{'-die'}."\n" if defined $options{'-die'};
- die "No such such entry ‘".$l.'@'.$d."‘.\n";
+ die "No such such entry ‘".$loc."‘.\n";
}
my %ret;
if ($local->dn =~ /^fvu=/) {
$ret{type} = 'mailbox';
$ret{user} = $local->get_value('fvu');
- $ret{forwards} = concat($concat, $local->get_value('fripostOptionalMaildrop'))
+ $ret{forwards} = concat($concat, map { email_to_unicode($_) }
+ $local->get_value('fripostOptionalMaildrop'))
}
elsif ($local->dn =~ /^fva=/) {
$ret{type} = 'alias';
$ret{alias} = $local->get_value('fva');
- $ret{maildrop} = concat($concat, $local->get_value('fripostMaildrop'))
+ $ret{maildrop} = concat($concat, map { email_to_unicode($_) }
+ $local->get_value('fripostMaildrop'))
}
elsif ($local->dn =~ /^fvl=/) {
$ret{type} = 'list';
@@ -92,7 +95,7 @@ sub get {
}
-=item B<exists> (I<local>,I<domain>, I<OPTIONS>)
+=item B<exists> (I<local>, I<OPTIONS>)
Returns 1 if the given I<local>@I<domain> exists, and 0 otherwise.
The authenticated user needs to have search access to the 'entry'
@@ -102,8 +105,7 @@ attribute.
sub exists {
my $self = shift;
- my $l = shift;
- my $d = shift;
+ my ($l,$d) = split /\@/, email_to_ascii(shift), 2;
my %options = @_;
# We may not have read access to the list commands
diff --git a/lib/Fripost/Schema/Mailbox.pm b/lib/Fripost/Schema/Mailbox.pm
index 28ef376..c7d93a2 100644
--- a/lib/Fripost/Schema/Mailbox.pm
+++ b/lib/Fripost/Schema/Mailbox.pm
@@ -18,6 +18,8 @@ use utf8;
use parent 'Fripost::Schema';
use Fripost::Schema::Misc qw/concat explode must_attrs email_valid/;
+use Net::IDN::Encode qw/domain_to_ascii
+ email_to_ascii email_to_unicode/;
=head1 METHODS
@@ -33,12 +35,12 @@ output is a array of hash references, sorted by mailbox.
sub search {
my $self = shift;
- my $domain = shift;
+ my $d = domain_to_ascii(shift);
my %options = @_;
my $concat = $options{'-concat'};
my $mailboxes = $self->ldap->search(
- base => "fvd=$domain,".$self->suffix,
+ base => "fvd=$d,".$self->suffix,
scope => 'one',
deref => 'never',
filter => 'objectClass=FripostVirtualMailbox',
@@ -50,10 +52,11 @@ sub search {
die $options{'-die'}."\n" if defined $options{'-die'};
die $mailboxes->error;
}
- return map { { user => $_->get_value('fvu')
+ return map { { user => email_to_unicode($_->get_value('fvu'))
, isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
, description => concat($concat, $_->get_value('description'))
- , forwards => concat($concat, $_->get_value('fripostOptionalMaildrop'))
+ , forwards => concat($concat, map { email_to_unicode($_) }
+ $_->get_value('fripostOptionalMaildrop'))
, quota => $_->get_value('fripostMailboxQuota') // undef
}
}
@@ -77,9 +80,8 @@ sub replace {
if defined $m->{$_};
}
- my ($l,$d) = split /\@/, $m->{user}, 2;
-
eval {
+ my ($l,$d) = split /\@/, email_to_ascii($m->{user}), 2;
&_is_valid($m);
my $mesg = $self->ldap->modify(
"fvu=$l,fvd=$d,".$self->suffix,
@@ -103,7 +105,7 @@ may want to hash it before hand.
sub passwd {
my $self = shift;
- my ($l,$d) = split /\@/, shift, 2;
+ my ($l,$d) = split /\@/, email_to_ascii(shift), 2;
my $pw = shift;
my %options = @_;
@@ -131,13 +133,12 @@ sub add {
if defined $m->{$_};
}
- my ($l,$d) = split /\@/, $m->{user}, 2;
-
eval {
+ my ($l,$d) = split /\@/, email_to_ascii($m->{user}), 2;
die "Missing user name\n" if $l eq '';
&_is_valid($m);
die "‘".$m->{user}."‘ alread exists\n"
- if $self->local->exists($l,$d,%options);
+ if $self->local->exists($m->{user},%options);
my %attrs = ( objectClass => 'FripostVirtualMailbox'
, fripostIsStatusActive => $m->{isactive} ? 'TRUE' : 'FALSE'
@@ -160,7 +161,7 @@ sub add {
}
-=item B<delete> (I<mailbox>, I<domain>, I<OPTIONS>)
+=item B<delete> (I<mailbox>, I<OPTIONS>)
Delete the given mailbox. Note: this will NOT wipe the mailbox off the
disk, but merely delete its entry in the LDAP directory.
@@ -169,8 +170,7 @@ disk, but merely delete its entry in the LDAP directory.
sub delete {
my $self = shift;
- my $l = shift;
- my $d = shift;
+ my ($l,$d) = split /\@/, email_to_ascii(shift), 2;
my %options = @_;
my $mesg = $self->ldap->delete( "fvu=$l,fvd=$d,".$self->suffix );
@@ -201,7 +201,7 @@ The B<-die> option, if present, overides LDAP croaks and errors.
sub _is_valid {
my $m = shift;
must_attrs( $m, qw/user isactive/ );
- email_valid( $m->{user}, -exact => 1);
+ $m->{user} = email_valid( $m->{user}, -exact => 1);
$m->{forwards} = [ map { email_valid($_) } @{$m->{forwards}} ];
# TODO: match 'quota' against the Dovecot specifications
}
diff --git a/lib/Fripost/Schema/Misc.pm b/lib/Fripost/Schema/Misc.pm
index 4898764..39fa3b7 100644
--- a/lib/Fripost/Schema/Misc.pm
+++ b/lib/Fripost/Schema/Misc.pm
@@ -10,11 +10,14 @@ use 5.010_000;
use strict;
use warnings;
use utf8;
+use feature "unicode_strings";
use Exporter 'import';
our @EXPORT_OK = qw /concat get_perms explode
must_attrs email_valid/;
use Email::Valid;
+use Net::IDN::Encode;
+use Encode;
# Let the first argument, if defined, intersperse the other arguments.
@@ -99,6 +102,8 @@ sub email_valid {
$i =~ s/^[^<>]+\s<([^>]+)>/$1/;
my $mesg = $options{'-error'} // "Invalid e-mail";
$in = $options{'-prefix'}.$i if defined $options{'-prefix'};
+ Encode::_utf8_on($in);
+ $in = Net::IDN::Encode::email_to_ascii($in);
my $addr = Email::Valid::->address( -address => $in,
-tldcheck => 1,
diff --git a/server.pl b/server.pl
index 838c7a9..74e7c09 100755
--- a/server.pl
+++ b/server.pl
@@ -1,4 +1,4 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -CADS
use strict;
use warnings;
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 19:24:38 +0000