Better checks for existing entries.

2 files changed, 31 insertions, 6 deletions

diff --git a/lib/Fripost/Schema/List.pm b/lib/Fripost/Schema/List.pm
index 67da859..ad06b50 100644
--- a/lib/Fripost/Schema/List.pm
+++ b/lib/Fripost/Schema/List.pm
@@ -120,7 +120,7 @@ sub add {
         must_attrs( $l, 'transport' );
         &_is_valid($l);
         die "‘".$l->{list}."’ already exists\n"
-            if $self->local->exists($l->{list},%options);
+            if $self->local->exists( $l->{list}, t => 'list', %options );
 
         my %attrs = ( objectClass => 'FripostVirtualList'
                     , fripostIsStatusActive => $l->{isactive} ? 'TRUE' : 'FALSE'
@@ -267,10 +267,16 @@ sub _is_valid {
     must_attrs( $l, qw/list isactive/ );
     $l->{list} = email_valid( $l->{list}, -exact => 1 );
 
+    my ($l2,$d) = split /\@/, $l->{list}, 2;
+    foreach ( qw/admin bounces confirm join leave owner request subscribe unsubscribe bounce sendkey/ ){
+        die "Invalid list name: ‘".$l->{list}."’\n" if $l2 =~ /-$_$/;
+    }
+    die "Invalid list name: ‘".$l->{list}."’\n"
+        unless $l->{list} =~ /^[[:alnum:]_=\+\-\.\@]+$/;
+
     die "Invalid transport: ‘".$l->{transport}."’\n"
         if defined $l->{transport} and
             $l->{transport} !~ /^(schleuder|mailman)$/;
-    # TODO: check commands
 }
 
 
diff --git a/lib/Fripost/Schema/Local.pm b/lib/Fripost/Schema/Local.pm
index f497a4e..49c3d68 100644
--- a/lib/Fripost/Schema/Local.pm
+++ b/lib/Fripost/Schema/Local.pm
@@ -115,11 +115,29 @@ sub exists {
     # The trick is somewhat dirty, but it's safe enough since postfix
     # delivers to mailboxes, aliases, and lists with different
     # priorities (and lists have the lowest).
-#    $l =~ s/(.*)-(admin|bounces|confirm|join|leave|loop|owner|request|subscribe|unsubscribe|bounce|sendkey)$/$1/;
-    # ^ TODO
+    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;
+            last;
+        }
+    }
+    if (defined $options{t} and $options{t} eq 'list') {
+        # If that's a list that is to be created, we need to ensure that
+        # none of its commands exists.
+        foreach (@cmds) {
+            my $l2 = $l.'-'.$_;
+            push @tests, 'fvu='.$l2, 'fva='.$l2;
+        }
+    }
 
-    foreach my $t (qw/fvu fva fvl/) {
-        my $mesg = $self->ldap->search( base => "$t=$l,fvd=$d,".$self->suffix,
+    foreach (@tests) {
+        my $mesg = $self->ldap->search( base => "$_,fvd=$d,".$self->suffix,
                                         scope => 'base',
                                         deref => 'never',
                                         filter => 'objectClass=*'
@@ -129,6 +147,7 @@ sub exists {
             die $options{'-die'}."\n" if defined $options{'-die'};
             die $mesg->error."\n";
         }
+        
     }
     return 0;
 }