aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost/Schema
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Fripost/Schema')
-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
6 files changed, 64 insertions, 53 deletions
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,
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 02:17:00 +0000