aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost/Schema
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Fripost/Schema')
-rw-r--r--lib/Fripost/Schema/Alias.pm13
-rw-r--r--lib/Fripost/Schema/Domain.pm11
-rw-r--r--lib/Fripost/Schema/List.pm37
-rw-r--r--lib/Fripost/Schema/Local.pm19
-rw-r--r--lib/Fripost/Schema/Misc.pm20
-rw-r--r--lib/Fripost/Schema/User.pm20
6 files changed, 77 insertions, 43 deletions
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'};
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-31 14:26:45 +0000