Be sure to escape filters and DNs.

7 files changed, 83 insertions, 49 deletions

diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm
index 236b407..63df10f 100644
--- a/lib/Fripost/Schema.pm
+++ b/lib/Fripost/Schema.pm
@@ -20,7 +20,7 @@ use utf8;
 
 use Net::LDAP;
 use Authen::SASL;
-use Fripost::Schema::Misc 'split_addr';
+use Fripost::Schema::Misc qw/canonical_dn ldap_explode_dn split_addr/;
 use Fripost::Schema::Domain;
 use Fripost::Schema::User;
 use Fripost::Schema::Alias;
@@ -48,10 +48,10 @@ sub SASLauth {
     my %cfg = @_;
 
     my $self = bless {}, $class;
-    $self->suffix( join ',', @{$cfg{ldap_suffix}} );
-    $self->whoami( "fvu=$l,fvd=$d,".$self->suffix );
     return $self unless defined $cfg{ldap_SASL_mechanism};
 
+    $self->suffix( ldap_explode_dn(@{$cfg{ldap_suffix}}) );
+    $self->whoami( canonical_dn( {fvu => $l}, {fvd => $d}, @{$self->suffix} ));
     $self->ldap( Net::LDAP::->new( $cfg{ldap_uri}, async => 0 ));
 
     my $callback;
@@ -96,14 +96,14 @@ sub auth {
     my %cfg = @_;
 
     my $self = bless {}, $class;
-    $self->suffix( join ',', @{$cfg{ldap_suffix}} );
+    $self->suffix( ldap_explode_dn(@{$cfg{ldap_suffix}}) );
 
     if (not (defined $id) or defined $cfg{ldap_bind_dn}) {
-        $self->whoami( $cfg{ldap_bind_dn} );
+        $self->whoami( join ',', @{$cfg{ldap_bind_dn}} );
     }
     else {
         my ($l,$d) = split_addr($id);
-        $self->whoami( "fvu=$l,fvd=$d,".$self->suffix );
+        $self->whoami( canonical_dn( {fvu => $l}, {fvd => $d}, @{$self->suffix} ));
     }
 
     $self->ldap( Net::LDAP::->new( $cfg{ldap_uri}, async => 0 ) );
diff --git a/lib/Fripost/Schema/Alias.pm b/lib/Fripost/Schema/Alias.pm
index f575b4c..d121929 100644
--- a/lib/Fripost/Schema/Alias.pm
+++ b/lib/Fripost/Schema/Alias.pm
@@ -18,7 +18,7 @@ use utf8;
 
 use parent 'Fripost::Schema';
 use Fripost::Schema::Misc qw/concat explode must_attrs email_valid
-                             split_addr/;
+                             split_addr canonical_dn/;
 use Net::IDN::Encode qw/domain_to_ascii
                         email_to_ascii email_to_unicode/;
 
@@ -41,7 +41,7 @@ sub search {
     my $concat = $options{'-concat'};
 
     my $aliases = $self->ldap->search(
-                      base => "fvd=$domain,".$self->suffix,
+                      base => canonical_dn( {fvd => $domain}, @{$self->suffix} ),
                       scope => 'one',
                       deref => 'never',
                       filter => 'objectClass=FripostVirtualAlias',
@@ -83,7 +83,7 @@ sub replace {
         my ($l,$d) = split_addr( $a->{alias}, -encoding => 'ascii' );
         &_is_valid($a);
         my $mesg = $self->ldap->modify(
-                       "fva=$l,fvd=$d,".$self->suffix,
+                       canonical_dn({fva => $l}, {fvd => $d}, @{$self->suffix}),
                        replace => { fripostIsStatusActive => $a->{isactive} ?
                                         'TRUE' : 'FALSE'
                                   , description => $a->{description}
@@ -126,8 +126,8 @@ sub add {
         $attrs{description} = $a->{description}
             if defined $a->{description} and @{$a->{description}};
 
-        my $mesg = $self->ldap->add( "fva=$l,fvd=$d,".$self->suffix,
-                                     attrs => [ %attrs ] );
+        my $dn = canonical_dn({fva => $l}, {fvd => $d}, @{$self->suffix});
+        my $mesg = $self->ldap->add( $dn, attrs => [ %attrs ] );
         if ($mesg->code) {
             die $options{'-die'}."\n" if defined $options{'-die'};
             die $mesg->error."\n";
@@ -148,7 +148,8 @@ sub delete {
     my ($l,$d) = split_addr( shift, -encoding => 'ascii' );
     my %options = @_;
 
-    my $mesg = $self->ldap->delete( "fva=$l,fvd=$d,".$self->suffix );
+    my $mesg = $self->ldap->delete( canonical_dn( {fva => $l}, {fvd => $d},
+                                                  @{$self->suffix} ) );
     if ($mesg->code) {
         if (defined $options{'-die'}) {
             return $mesg->error unless $options{'-die'};
diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm
index 0e1de49..c36cea8 100644
--- a/lib/Fripost/Schema/Domain.pm
+++ b/lib/Fripost/Schema/Domain.pm
@@ -18,7 +18,8 @@ use utf8;
 
 use parent 'Fripost::Schema';
 use Fripost::Schema::Misc qw/concat get_perms explode
-                             must_attrs email_valid/;
+                             must_attrs email_valid
+                             canonical_dn/;
 use Net::IDN::Encode qw/domain_to_ascii domain_to_unicode
                         email_to_ascii email_to_unicode/;
 
@@ -40,7 +41,7 @@ sub search {
     my $concat = $options{'-concat'};
 
     my $domains = $self->ldap->search(
-                      base => $self->suffix,
+                      base => canonical_dn(@{$self->suffix}),
                       scope => 'one',
                       deref => 'never',
                       filter => 'objectClass=FripostVirtualDomain',
@@ -72,7 +73,7 @@ sub get {
     my $concat = $options{'-concat'};
 
     my $domains = $self->ldap->search(
-                      base => "fvd=$d,".$self->suffix,
+                      base => canonical_dn({fvd => $d}, @{$self->suffix}),
                       scope => 'base',
                       deref => 'never',
                       filter => 'objectClass=FripostVirtualDomain',
@@ -129,8 +130,8 @@ sub replace {
 
     eval {
         &_is_valid($d);
-        my $mesg = $self->ldap->modify(
-                       'fvd='.$d->{domain}.','.$self->suffix,
+        my $dn = canonical_dn( {fvd => $d->{domain}}, @{$self->suffix} );
+        my $mesg = $self->ldap->modify( $dn,
                        replace => { fripostIsStatusActive => $d->{isactive} ?
                                         'TRUE' : 'FALSE'
                                   , description => $d->{description}
diff --git a/lib/Fripost/Schema/List.pm b/lib/Fripost/Schema/List.pm
index e6605f0..58d198c 100644
--- a/lib/Fripost/Schema/List.pm
+++ b/lib/Fripost/Schema/List.pm
@@ -18,7 +18,7 @@ use utf8;
 
 use parent 'Fripost::Schema';
 use Fripost::Schema::Misc qw/concat explode must_attrs email_valid
-                             split_addr/;
+                             split_addr canonical_dn ldap_explode_dn/;
 use Net::IDN::Encode qw/domain_to_ascii
                         email_to_ascii email_to_unicode/;
 use Mail::GnuPG;
@@ -47,7 +47,7 @@ sub search {
         if (defined $options{'-is_pending'}) and !$options{'-is_pending'};
 
     my $lists = $self->ldap->search(
-                    base => "fvd=$domain,".$self->suffix,
+                    base => canonical_dn({fvd => $domain}, @{$self->suffix}),
                     scope => 'one',
                     deref => 'never',
                     filter => $filter,
@@ -85,13 +85,13 @@ sub replace {
         if defined $l->{description};
 
     eval {
-        my ($l2,$d) = split /\@/, email_to_ascii($l->{list}), 2;
+        my ($l2,$d) = split_addr( $l->{list}, -encoding => 'ascii' );
         &_is_valid($l);
         my $l3 = { fripostIsStatusActive => $l->{isactive} ? 'TRUE' : 'FALSE'
                  , description => $l->{description} };
         $l3->{fripostListManager} = $l->{transport} if defined $l->{transport};
         my $mesg = $self->ldap->modify(
-                       "fvl=$l2,fvd=$d,".$self->suffix,
+                       canonical_dn({fvl => $l2}, {fvd => $d}, @{$self->suffix}),
                        replace => $l3 );
         die $mesg->error."\n" if $mesg->code;
     };
@@ -133,8 +133,8 @@ sub add {
         $attrs{description} = $l->{description}
             if defined $l->{description} and @{$l->{description}};
 
-        my $mesg = $self->ldap->add( "fvl=$l2,fvd=$d,".$self->suffix,
-                                     attrs => [ %attrs ] );
+        my $dn = canonical_dn({fvl => $l2}, {fvd => $d}, @{$self->suffix});
+        my $mesg = $self->ldap->add( $dn, attrs => [ %attrs ] );
         if ($mesg->code) {
             die $options{'-die'}."\n" if defined $options{'-die'};
             die $mesg->error."\n";
@@ -143,11 +143,16 @@ sub add {
     return $@ if $@;
 
     # Ask the list manager to create the list now.
-    my $member = $self->whoami;
-    $member =~ s/^fvu=([^,]+),fvd=([^,]+),.*$/$1\@$2/;
+
+    my $whoami = ldap_explode_dn( $self->whoami );
+    my $member = email_valid( $whoami->[0]->{fvu} .'@'. $whoami->[1]->{fvd}
+                            , -exact => 1 );
+    my $to = email_valid( 'mklist+'.$l->{transport}.'@fripost.org'
+                        , -exact => 1 );
+
     my $mail = MIME::Entity::->build(
         From     => 'Fripost Admin Panel <AdminWebPanel@fripost.org>',
-        To       => 'mklist+'.$l->{transport}.'@fripost.org',
+        To       => $to,
         Subject  => "New ".$l->{transport}." list",
         Encoding => 'quoted-printable',
         Charset  => 'utf-8',
@@ -175,8 +180,9 @@ sub is_pending {
     my ($l,$d) = split_addr( shift, -encoding => 'ascii' );
     my %options = @_;
 
+    my $dn = canonical_dn({fvl => $l}, {fvd => $d}, @{$self->suffix});
     my $mesg = $self->ldap->search(
-                    base => "fvl=$l,fvd=$d,".$self->suffix,
+                    base => $dn,
                     scope => 'base',
                     deref => 'never',
                     filter => 'objectClass=FripostVirtualList',
@@ -209,14 +215,16 @@ sub add_commands {
 
     my $mesg;
     foreach my $cmd (@$cmds) {
-        $mesg = $self->ldap->add( "fvlc=$l-$cmd,fvl=$l,fvd=$d,".$self->suffix,
+        my $dn = canonical_dn( {fvlc => $l.'-'.$cmd}, {fvl => $l}, {fvd => $d},
+                               @{$self->suffix} );
+        $mesg = $self->ldap->add( $dn,
                        attrs => [ objectClass => 'FripostVirtualListCommand',
                                   FripostLocalAlias => $l.'-'.$cmd.'#'.$d ] );
         last if $mesg->code;
     }
 
-    $mesg = $self->ldap->modify( "fvl=$l,fvd=$d,".$self->suffix,
-                               , delete => 'fripostIsStatusPending' )
+    my $dn = canonical_dn( {fvl => $l}, {fvd => $d}, @{$self->suffix} );
+    $mesg = $self->ldap->modify( $dn, delete => 'fripostIsStatusPending' )
         unless $mesg->code;
 
     if ($mesg->code) {
@@ -238,7 +246,8 @@ sub delete {
     my ($l,$d) = split_addr( shift, -encoding => 'ascii' );
     my %options = @_;
 
-    my $mesg = $self->ldap->delete( "fvl=$l,fvd=$d,".$self->suffix );
+    my $dn = canonical_dn( {fvl => $l}, {fvd => $d}, @{$self->suffix} );
+    my $mesg = $self->ldap->delete( $dn );
     if ($mesg->code) {
         if (defined $options{'-die'}) {
             return $mesg->error unless $options{'-die'};
diff --git a/lib/Fripost/Schema/Local.pm b/lib/Fripost/Schema/Local.pm
index e2e7a4b..d8a71ef 100644
--- a/lib/Fripost/Schema/Local.pm
+++ b/lib/Fripost/Schema/Local.pm
@@ -17,7 +17,7 @@ use warnings;
 use utf8;
 
 use parent 'Fripost::Schema';
-use Fripost::Schema::Misc qw/concat split_addr/;
+use Fripost::Schema::Misc qw/concat split_addr canonical_dn/;
 use Net::IDN::Encode qw/email_to_ascii email_to_unicode/;
 use Net::LDAP::Util 'escape_filter_value';
 
@@ -41,8 +41,9 @@ sub get {
     my $concat = $options{'-concat'};
 
     my ($l,$d) = split_addr( $loc, -encoding => 'ascii' );
+    $l = escape_filter_value($l);
     my $locals = $self->ldap->search(
-                     base => "fvd=$d,".$self->suffix,
+                     base => canonical_dn({fvd => $d}, @{$self->suffix}),
                      scope => 'one',
                      deref => 'never',
                      filter => "(|(&(objectClass=FripostVirtualUser)(fvu=$l))
@@ -109,22 +110,23 @@ attribute.
 
 sub exists {
     my $self = shift;
-    my ($l,$d) = split /\@/, email_to_ascii(shift), 2;
+    my ($l,$d) = split_addr( shift, -encoding => 'ascii' );
     my %options = @_;
 
     # We may not have read access to the list commands
     # The trick is somewhat dirty, but it's safe enough since postfix
     # delivers to users, aliases, and lists with different
     # priorities (and lists have the lowest).
-    my @cmds = qw/admin bounces confirm join leave owner request subscribe unsubscribe bounce sendkey/;
-    my @tests = ( 'fvu='.$l, 'fva='.$l, 'fvl='.$l );
+    my @cmds = qw/admin bounces confirm join leave owner request
+                  subscribe unsubscribe bounce sendkey/;
+    my @tests = ( {fvu => $l}, {fva => $l}, {fvl => $l} );
 
     foreach (@cmds) {
         # If the entry is of the form 'foo-command', we need to ensure
         # that no list 'foo' exists, otherwise the new entry would
         # override foo's command.
         if ($l =~ s/-$_$//) {
-            push @tests, 'fvl='.$l;
+            push @tests, {fvl => $l};
             last;
         }
     }
@@ -133,12 +135,13 @@ sub exists {
         # none of its commands exists.
         foreach (@cmds) {
             my $l2 = $l.'-'.$_;
-            push @tests, 'fvu='.$l2, 'fva='.$l2;
+            push @tests, {fvu => $l2}, {fva => $l2};
         }
     }
 
     foreach (@tests) {
-        my $mesg = $self->ldap->search( base => "$_,fvd=$d,".$self->suffix,
+        my $dn = canonical_dn($_, {fvd => $d}, @{$self->suffix});
+        my $mesg = $self->ldap->search( base => $dn,
                                         scope => 'base',
                                         deref => 'never',
                                         filter => 'objectClass=*'
diff --git a/lib/Fripost/Schema/Misc.pm b/lib/Fripost/Schema/Misc.pm
index 9ae8cdc..aec2618 100644
--- a/lib/Fripost/Schema/Misc.pm
+++ b/lib/Fripost/Schema/Misc.pm
@@ -14,9 +14,11 @@ use utf8;
 use Exporter 'import';
 our @EXPORT_OK = qw /concat get_perms explode
                      must_attrs email_valid
+                     canonical_dn ldap_explode_dn
                      split_addr/;
 use Email::Valid;
 use Net::IDN::Encode;
+use Net::LDAP::Util;
 use Encode;
 
 
@@ -58,14 +60,17 @@ sub explode {
 # - p:  postmaster
 sub get_perms {
     my ($entry, $dn) = @_;
+    my @dn = @{ldap_explode_dn ($dn)};
+    shift @dn;
+    my $dn2 = canonical_dn (@dn);
     my $perms = '';
 
     $perms .= 'a'
-        if grep { $dn eq $_  or  (split /,/,$dn,2)[1] eq $_ }
+        if grep { $dn eq $_  or  $dn2 eq $_ }
                 $entry->get_value ('fripostCanCreateAlias');
 
     $perms .= 'l'
-        if grep { $dn eq $_  or  (split /,/,$dn,2)[1] eq $_ }
+        if grep { $dn eq $_  or  $dn2 eq $_ }
                 $entry->get_value ('fripostCanCreateList');
 
     $perms = 'o'
@@ -116,6 +121,17 @@ sub email_valid {
     return $addr;
 }
 
+sub canonical_dn {
+    Net::LDAP::Util::canonical_dn(\@_, casefold => 'lower'
+                                     , mbcescape => 1
+                                     , reverse => 0
+                                     , separator => ',');
+};
+
+sub ldap_explode_dn {
+    Net::LDAP::Util::ldap_explode_dn( join (',', @_), casefold => 'lower' )
+}
+
 sub split_addr {
     my $addr = shift;
     my %options = @_;
diff --git a/lib/Fripost/Schema/User.pm b/lib/Fripost/Schema/User.pm
index c1d559a..ff8691f 100644
--- a/lib/Fripost/Schema/User.pm
+++ b/lib/Fripost/Schema/User.pm
@@ -18,7 +18,7 @@ use utf8;
 
 use parent 'Fripost::Schema';
 use Fripost::Schema::Misc qw/concat explode must_attrs email_valid
-                             split_addr/;
+                             split_addr canonical_dn/;
 use Net::IDN::Encode qw/domain_to_ascii
                         email_to_ascii email_to_unicode/;
 
@@ -41,7 +41,7 @@ sub search {
     my $concat = $options{'-concat'};
 
     my $users = $self->ldap->search(
-                    base => "fvd=$d,".$self->suffix,
+                    base => canonical_dn( {fvd => $d}, @{$self->suffix} ),
                     scope => 'one',
                     deref => 'never',
                     filter => 'objectClass=FripostVirtualUser',
@@ -85,7 +85,7 @@ sub replace {
         my ($l,$d) = split_addr( $m->{user}, -encoding => 'ascii' );
         &_is_valid($m);
         my $mesg = $self->ldap->modify(
-                       "fvu=$l,fvd=$d,".$self->suffix,
+                       canonical_dn( {fvu => $l}, {fvd => $d}, @{$self->suffix} ),
                        replace => { fripostIsStatusActive => $m->{isactive} ?
                                         'TRUE' : 'FALSE'
                                   , description => $m->{description}
@@ -111,8 +111,9 @@ sub passwd {
     my %options = @_;
 
     my $mesg = $self->ldap->modify(
-                   "fvu=$l,fvd=$d,".$self->suffix,
-                   replace => { userPassword => $pw } );
+                   canonical_dn( {fvu => $l}, {fvd => $d}, @{$self->suffix} ),
+                   replace => { userPassword => $pw }
+               );
     return "Cannot change password" if $mesg->code;
 }
 
@@ -151,8 +152,10 @@ sub add {
         $attrs{fripostOptionalMaildrop} = $m->{forwards}
             if defined $m->{forwards} and @{$m->{forwards}};
 
-        my $mesg = $self->ldap->add( "fvu=$l,fvd=$d,".$self->suffix,
-                                     attrs => [ %attrs ] );
+        my $mesg = $self->ldap->add(
+                       canonical_dn( {fvu => $l}, {fvd => $d}, @{$self->suffix} ),
+                       attrs => [ %attrs ]
+                   );
         if ($mesg->code) {
             die $options{'-die'}."\n" if defined $options{'-die'};
             die $mesg->error."\n";
@@ -174,7 +177,8 @@ sub delete {
     my ($l,$d) = split_addr( shift, -encoding => 'ascii' );
     my %options = @_;
 
-    my $mesg = $self->ldap->delete( "fvu=$l,fvd=$d,".$self->suffix );
+    my $mesg = $self->ldap->delete( canonical_dn( {fvu => $l}, {fvd => $d},
+                                                  @{$self->suffix} ) );
     if ($mesg->code) {
         if (defined $options{'-die'}) {
             return $mesg->error unless $options{'-die'};