diff options
Diffstat (limited to 'lib/Fripost')
| -rw-r--r-- | lib/Fripost/Panel/Interface.pm | 6 | ||||
| -rw-r--r-- | lib/Fripost/Schema.pm | 12 | ||||
| -rw-r--r-- | lib/Fripost/Schema/Alias.pm | 6 | ||||
| -rw-r--r-- | lib/Fripost/Schema/Domain.pm | 14 | ||||
| -rw-r--r-- | lib/Fripost/Schema/List.pm | 92 | ||||
| -rw-r--r-- | lib/Fripost/Schema/Local.pm | 4 | ||||
| -rw-r--r-- | lib/Fripost/Schema/Mailbox.pm | 6 |
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"; } } |