diff options
| -rw-r--r-- | INSTALL | 1 | ||||
| -rw-r--r-- | TODO.org | 12 | ||||
| -rwxr-xr-x | cgi-bin/index.fcgi | 2 | ||||
| -rw-r--r-- | lib/Fripost/Schema/List.pm | 10 | ||||
| -rw-r--r-- | lib/Fripost/Schema/Local.pm | 27 |
5 files changed, 39 insertions, 13 deletions
@@ -20,6 +20,7 @@ apt-get install libnet-ldap-perl \ libdigest-perl \ libstring-mkpasswd-perl \ libnet-idn-encode-perl \ + liburi-escape-xs-perl \ libmail-gnupg-perl @@ -4,11 +4,11 @@ domains/emails to Punycode internally? * TODO What to do when a user wants to add a domain? Is it worth it to send a confirmation e-mail? -* TODO Better check for existing lists (commands). +* DONE Better check for existing lists (commands). - When adding a new alias/mailbox 'test', check for existing alias/mailbox 'test', and list 'test'. - When adding a new alias/mailbox 'test-request', check for existing alias/mailbox 'test-request', list 'test-request' *and* list 'test'. (The same for other list commands.) - When adding a new list 'test', check for existing alias/mailbox/list 'test', 'test-request',... -- When adding a new list 'test-request', check for existing alias/mailbox/list 'test-request', 'test-request-request',... *and* list 'test'. (The same for other list commands.) +- (Lists of the form 'test-request' are forbidden); * TODO Check for cycles when creating new aliases? (It is impossible since the authenticated user may not have full read access on the graph) @@ -31,7 +31,7 @@ http://mark.stosberg.com/blog/2010/12/percent-encoding-uris-in-perl.html * CANCELED How should we encode the URL for internationalized domain names? Punicode vs. unicode vs. HTML entities? CLOSED: [2012-09-27 Thu 00:03] - CLOSING NOTE [2012-09-27 Thu 00:03] \\ -It's up to the browser (Firefox support unicode in URLs). +It's up to the browser (Firefox supports unicode in URLs). * CANCELED Forbid UTF8 in the domain part of lists? (Test if the list managers support it at least.) @@ -40,15 +40,15 @@ CLOSED: [2012-09-27 Thu 03:38] Mailman and Schleuder do not support IDNs, but we convert the list name into punicode first. -* TODO Give the right for domain owners and postmaster to grant the right +* TODO Give the right for domain owners and postmasters to grant the right to create aliases and lists. * TODO Give the right to appoint co owners (for list and aliases). * TODO Make every service use Kerberos, and remove the passphrase on -their private keys. +their GPG private keys. -* TODO Check list names against mailman's and schleuder's regexps? +* DONE Check list names against mailman's and schleuder's regexps? * TODO What to do when a list creation fails? Set up a new service to clean out the pending lists and domains if they have not been fixed diff --git a/cgi-bin/index.fcgi b/cgi-bin/index.fcgi index 8e551d8..5c73463 100755 --- a/cgi-bin/index.fcgi +++ b/cgi-bin/index.fcgi @@ -15,7 +15,7 @@ use CGI::Fast (); use File::Spec::Functions 'catfile'; use lib 'lib'; use Fripost::Panel::Interface; - +use CGI::Carp 'fatalsToBrowser'; my $config_dir = '/etc/fripost-panel'; my @config = catfile ('./', 'default.in'); 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; } |