Better way to create lists.

10 files changed, 121 insertions, 36 deletions

diff --git a/TODO.org b/TODO.org
index a9e6b57..a8b3f0f 100644
--- a/TODO.org
+++ b/TODO.org
@@ -12,7 +12,9 @@ domains/emails to Punycode internally?
 
 * TODO Check for cycles when creating new aliases?
 (It is impossible since the authenticated user may not have full read access on the graph)
-Hopefully Postfix checks it and warns the postmaster.
+Actually Postfix checks it and warns the administrator with a 
+"unreasonable virtual_alias_maps map nesting for test-loop1@fripost.org"
+in the logs. So it's fine to do a partial check here.
 
 * TODO Write a script to check every runmode against the W3 validator.
   
@@ -25,3 +27,7 @@ Hopefully Postfix checks it and warns the postmaster.
 * TODO Forbid `/' and `\0' to appear in the domain/user name.
 
 * TODO How should we encode the URL for internationalized domain names? Punicode vs. unicode vs. HTML entities?
+(Right now it's HTML entities.)
+
+* TODO Forbid UTF8 in the domain part of lists? (Test if the list
+managers support it at least.)
diff --git a/config.in b/config.in
index 1eccd78..1a245f7 100644
--- a/config.in
+++ b/config.in
@@ -15,7 +15,7 @@ default_realm = fripost.org
 ldap_suffix = ou=virtual,o=mailHosting,dc=fripost,dc=dev
 
 # TODO: This should be replaced with a Keberos ticket.
-ldap_authcID = AdminPanel
+ldap_authcID = AdminWebPanel@fripost.org
 ldap_authcPW = panel
 
 # The minimum password length.
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";
     }
 }
 
diff --git a/template/edit-mailbox.html b/template/edit-mailbox.html
index 4ce6837..9ceb87c 100644
--- a/template/edit-mailbox.html
+++ b/template/edit-mailbox.html
@@ -92,10 +92,13 @@
       <textarea name="forwards" cols="50" rows="10" ><TMPL_VAR NAME=forwards></textarea>
       <div class="help">
         An optional list of destinations (one e-mail address per line) that
-        will <i>also</i> receive mail delivered to
+        will receive mail for
         <span class="email"><TMPL_VAR NAME=user>@<TMPL_VAR NAME=domain></span>.
+        (<i>Note</i>: When not empty, this list cancels delivery to
+        this mailbox, so do not forget to list
+        <span class="email"><TMPL_VAR NAME=user>@<TMPL_VAR NAME=domain></span>
+        here as well if you want this mailbox to be delivered too.)
       </div>
-
       <hr/>
       <br/>