From 68484bbbde92a7b5ccb0da16d29afda31aec0370 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 18 Jan 2013 21:26:31 +0100 Subject: Be sure to escape filters and DNs. --- lib/Fripost/Schema.pm | 12 ++++++------ lib/Fripost/Schema/Alias.pm | 13 +++++++------ lib/Fripost/Schema/Domain.pm | 11 ++++++----- lib/Fripost/Schema/List.pm | 37 +++++++++++++++++++++++-------------- lib/Fripost/Schema/Local.pm | 19 +++++++++++-------- lib/Fripost/Schema/Misc.pm | 20 ++++++++++++++++++-- lib/Fripost/Schema/User.pm | 20 ++++++++++++-------- 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 ', - 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'}; -- cgit v1.2.3