diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Fripost/Panel/Interface.pm | 128 | ||||
| -rw-r--r-- | lib/Fripost/Panel/Login.pm | 25 | ||||
| -rw-r--r-- | lib/Fripost/Schema.pm | 6 | ||||
| -rw-r--r-- | lib/Fripost/Schema/Alias.pm | 24 | ||||
| -rw-r--r-- | lib/Fripost/Schema/Domain.pm | 20 | ||||
| -rw-r--r-- | lib/Fripost/Schema/List.pm | 20 | ||||
| -rw-r--r-- | lib/Fripost/Schema/Local.pm | 20 | ||||
| -rw-r--r-- | lib/Fripost/Schema/Mailbox.pm | 28 | ||||
| -rw-r--r-- | lib/Fripost/Schema/Misc.pm | 5 |
9 files changed, 150 insertions, 126 deletions
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, |