aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem.moulin@fripost.org>2012-09-19 02:10:41 +0200
committerGuilhem Moulin <guilhem.moulin@fripost.org>2012-09-19 02:10:41 +0200
commit906d5f24374eb190f6b7a00523fb16e5e683ac81 (patch)
tree61494ece954501a11f02552a140982aed854cbd3 /lib/Fripost
parent9881490f8c578555aa2349f8223104aa22fc8954 (diff)
Better way to create lists.
Diffstat (limited to 'lib/Fripost')
-rw-r--r--lib/Fripost/Panel/Interface.pm6
-rw-r--r--lib/Fripost/Schema.pm12
-rw-r--r--lib/Fripost/Schema/Alias.pm6
-rw-r--r--lib/Fripost/Schema/Domain.pm14
-rw-r--r--lib/Fripost/Schema/List.pm92
-rw-r--r--lib/Fripost/Schema/Local.pm4
-rw-r--r--lib/Fripost/Schema/Mailbox.pm6
7 files changed, 108 insertions, 32 deletions
diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm
index 0b7860e..46d4058 100644
--- a/lib/Fripost/Panel/Interface.pm
+++ b/lib/Fripost/Panel/Interface.pm
@@ -75,7 +75,7 @@ sub ListLocals : Runmode {
# crash.
my @mailboxes = $fp->mailbox->search( $d );
my @aliases = $fp->alias->search( $d );
- my @lists = $fp->list->search( $d );
+ my @lists = $fp->list->search( $d, -is_pending => 0 );
$fp->done;
@@ -221,7 +221,7 @@ sub EditLocal : Runmode {
# Search for *the* matching mailbox, alias or list.
my %local = $fp->local->get ($lu.'@'.$du, -die => 404,
- -concat => "\x{0D}\x{0A}");
+ -concat => "\x{0D}\x{0A}" );
die "Unknown type" unless grep { $local{type} eq $_ }
qw/mailbox alias list/;
@@ -316,7 +316,7 @@ sub EditLocal : Runmode {
}
else {
%local = $fp->local->get ($lu.'@'.$du, -die => 404,
- -concat => "\x{0D}\x{0A}");
+ -concat => "\x{0D}\x{0A}" );
if ($t eq 'mailbox') {
$template->param( user => encode_entities($local{user})
, forwards => encode_entities($local{forwards}) );
diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm
index 3e89e6c..35c69e2 100644
--- a/lib/Fripost/Schema.pm
+++ b/lib/Fripost/Schema.pm
@@ -73,13 +73,21 @@ I<CFG> should contain definitions for the LDAP suffix and URI.
sub auth {
my $class = shift;
- my ($l,$d) = split /\@/, shift, 2;
+ my $id = shift;
my $pw = shift;
my %cfg = @_;
my $self = bless {}, $class;
$self->suffix( join ',', @{$cfg{ldap_suffix}} );
- $self->whoami( "fvu=$l,fvd=$d,".$self->suffix );
+
+ if (not (defined $id) or defined $cfg{ldap_bind_dn}) {
+ $self->whoami( $cfg{ldap_bind_dn} );
+ }
+ else {
+ my ($l,$d) = split /\@/, $id, 2;
+ $self->whoami( "fvu=$l,fvd=$d,".$self->suffix );
+ }
+
$self->ldap( Net::LDAP::->new( $cfg{ldap_uri}, async => 1 ) );
my $mesg = $self->ldap->bind( $self->whoami, password => $pw );
diff --git a/lib/Fripost/Schema/Alias.pm b/lib/Fripost/Schema/Alias.pm
index 556a7d3..f111d7f 100644
--- a/lib/Fripost/Schema/Alias.pm
+++ b/lib/Fripost/Schema/Alias.pm
@@ -49,7 +49,7 @@ sub search {
);
if ($aliases->code) {
die $options{'-die'}."\n" if defined $options{'-die'};
- die $aliases->error;
+ die $aliases->error."\n";
}
return map { { alias => email_to_unicode($_->get_value('fva'))
, isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
@@ -129,7 +129,7 @@ sub add {
attrs => [ %attrs ] );
if ($mesg->code) {
die $options{'-die'}."\n" if defined $options{'-die'};
- die $mesg->error;
+ die $mesg->error."\n";
}
};
return $@;
@@ -153,7 +153,7 @@ sub delete {
return $mesg->error unless $options{'-die'};
die $options{'-die'}."\n";
}
- die $mesg->error;
+ die $mesg->error."\n";
}
}
diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm
index 3f2c9c5..8017e00 100644
--- a/lib/Fripost/Schema/Domain.pm
+++ b/lib/Fripost/Schema/Domain.pm
@@ -48,7 +48,7 @@ sub search {
);
if ($domains->code) {
die $options{'-die'}."\n" if defined $options{'-die'};
- die $domains->error;
+ die $domains->error."\n";
}
return map { { domain => domain_to_unicode($_->get_value('fvd'))
, isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
@@ -86,7 +86,7 @@ sub get {
);
if ($domains->code) {
die $options{'-die'}."\n" if defined $options{'-die'};
- die $domains->error;
+ die $domains->error."\n";
}
# The following is not supposed to happen.
@@ -100,7 +100,7 @@ sub get {
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, map { email_to_unicode ($_) }
+ , catchalls => concat($concat, map { _email_to_unicode ($_) }
$domain->get_value('fripostOptionalMaildrop'))
, permissions => get_perms($domain, $self->whoami)
)
@@ -168,6 +168,14 @@ sub _is_valid {
}
+# A variante of email_to_unicode that also takes care of domain aliases.
+sub _email_to_unicode {
+ my $email = shift;
+ return '@'.domain_to_unicode($email) if $email =~ s/^\@//;
+ return email_to_unicode($email);
+}
+
+
=head1 AUTHOR
Guilhem Moulin C<< <guilhem at fripost.org> >>
diff --git a/lib/Fripost/Schema/List.pm b/lib/Fripost/Schema/List.pm
index c6fb4f2..69317b1 100644
--- a/lib/Fripost/Schema/List.pm
+++ b/lib/Fripost/Schema/List.pm
@@ -39,17 +39,21 @@ sub search {
my %options = @_;
my $concat = $options{'-concat'};
+ my $filter = 'objectClass=FripostVirtualList';
+ $filter = '(&('.$filter.')(!(fripostIsStatusPending=TRUE)))'
+ if (defined $options{'-is_pending'}) and !$options{'-is_pending'};
+
my $lists = $self->ldap->search(
base => "fvd=$domain,".$self->suffix,
scope => 'one',
deref => 'never',
- filter => 'objectClass=FripostVirtualList',
+ filter => $filter,
attrs => [ qw/fvl description fripostIsStatusActive
fripostListManager/ ]
);
if ($lists->code) {
die $options{'-die'}."\n" if defined $options{'-die'};
- die $lists->error;
+ die $lists->error."\n";
}
return map { { list => email_to_unicode($_->get_value('fvl'))
, isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
@@ -117,19 +121,9 @@ sub add {
, fripostIsStatusActive => $l->{isactive} ? 'TRUE' : 'FALSE'
, fripostOwner => $self->whoami
, fripostListManager => $l->{transport}
+ , fripostIsStatusPending => 'TRUE'
+ , fripostLocalAlias => $l2.'#'.$d
);
- if ($l->{transport} eq 'mailman') {
- $attrs{fripostListCommand} =
- [ map { $l2.'-'.$_ }
- qw/admin bounces confirm join leave loop owner
- request subscribe unsubscribe/ ];
- }
- elsif ($l->{transport} eq 'schleuder') {
- $attrs{fripostListCommand} =
- [ map { $l2.'-'.$_ }
- # TODO: check that
- qw/request bounce sendkey owner/ ];
- }
$attrs{description} = $l->{description}
if defined $l->{description} and @{$l->{description}};
@@ -137,10 +131,76 @@ sub add {
attrs => [ %attrs ] );
if ($mesg->code) {
die $options{'-die'}."\n" if defined $options{'-die'};
- die $mesg->error;
+ die $mesg->error."\n";
}
};
return $@;
+ # TODO: send email to mklist-$transport to finalize
+}
+
+
+=item B<is_pending> (I<list>, I<OPTIONS>)
+
+Tells whether the given list's status is I<pending>, meaning an entry
+has been created in the LDAP directory (for instance by the domain owner
+from the Web Panel), but the local aliases have not yet been added by
+the ListCreator entity, and the list is not known by the list manager.
+
+=cut
+
+sub is_pending {
+ my $self = shift;
+ my ($l,$d) = split /\@/, email_to_ascii(shift), 2;
+ my %options = @_;
+
+ my $mesg = $self->ldap->search(
+ base => "fvl=$l,fvd=$d,".$self->suffix,
+ scope => 'base',
+ deref => 'never',
+ filter => 'objectClass=FripostVirtualList',
+ attrs => [ 'fvl', 'fripostIsStatusPending' ]
+ );
+ die "Error: ".$l.'@'.$d.": No such object in the LDAP directory\n"
+ if $mesg->code == 32; # No such object; a common error here.
+ die $mesg->error if $mesg->code;
+
+ die "Error: Multiple matching entries found." if $mesg->count > 1;
+ my $list = $mesg->pop_entry;
+
+ die "Error: No matching entry found." unless defined $list;
+ my $r = $list->get_value('fripostIsStatusPending');
+ return (defined $r and $r eq 'TRUE');
+}
+
+
+=item B<add_commands> (I<list>, I<transport>, I<OPTIONS>)
+
+Add the lists commands, and remove the pending status.
+
+=cut
+
+sub add_commands {
+ my $self = shift;
+ my ($l,$d) = split /\@/, email_to_ascii(shift), 2;
+ my $cmds = shift;
+ my %options = @_;
+
+ my $mesg;
+ foreach my $cmd (@$cmds) {
+ $mesg = $self->ldap->add( "fvlc=$l-$cmd,fvl=$l,fvd=$d,".$self->suffix,
+ attrs => [ objectClass => 'FripostVirtualListCommand',
+ FripostLocalAlias => $l.'-'.$cmd.'#'.$d ] );
+ last if $mesg->code;
+ }
+
+ $mesg = $self->ldap->modify( "fvl=$l,fvd=$d,".$self->suffix,
+ , delete => 'fripostIsStatusPending' )
+ unless $mesg->code;
+
+ if ($mesg->code) {
+ die $options{'-die'}."\n" if defined $options{'-die'};
+ die $mesg->error."\n";
+ }
}
@@ -162,7 +222,7 @@ sub delete {
return $mesg->error unless $options{'-die'};
die $options{'-die'}."\n";
}
- die $mesg->error;
+ die $mesg->error."\n";
}
}
diff --git a/lib/Fripost/Schema/Local.pm b/lib/Fripost/Schema/Local.pm
index 64dd622..89c0a9a 100644
--- a/lib/Fripost/Schema/Local.pm
+++ b/lib/Fripost/Schema/Local.pm
@@ -56,7 +56,7 @@ sub get {
);
if ($locals->code) {
die $options{'-die'}."\n" if defined $options{'-die'};
- die $locals->error;
+ die $locals->error."\n";
}
# The following is not supposed to happen. Note that there is
@@ -124,7 +124,7 @@ sub exists {
return 1 unless $mesg->code; # 0 Success
unless ($mesg->code == 32) { # 32 No such object
die $options{'-die'}."\n" if defined $options{'-die'};
- die $mesg->error;
+ die $mesg->error."\n";
}
}
return 0;
diff --git a/lib/Fripost/Schema/Mailbox.pm b/lib/Fripost/Schema/Mailbox.pm
index c7d93a2..0f2ff53 100644
--- a/lib/Fripost/Schema/Mailbox.pm
+++ b/lib/Fripost/Schema/Mailbox.pm
@@ -50,7 +50,7 @@ sub search {
);
if ($mailboxes->code) {
die $options{'-die'}."\n" if defined $options{'-die'};
- die $mailboxes->error;
+ die $mailboxes->error."\n";
}
return map { { user => email_to_unicode($_->get_value('fvu'))
, isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
@@ -154,7 +154,7 @@ sub add {
attrs => [ %attrs ] );
if ($mesg->code) {
die $options{'-die'}."\n" if defined $options{'-die'};
- die $mesg->error;
+ die $mesg->error."\n";
}
};
return $@;
@@ -179,7 +179,7 @@ sub delete {
return $mesg->error unless $options{'-die'};
die $options{'-die'}."\n";
}
- die $mesg->error;
+ die $mesg->error."\n";
}
}