aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--INSTALL1
-rw-r--r--TODO.org12
-rwxr-xr-xcgi-bin/index.fcgi2
-rw-r--r--lib/Fripost/Schema/List.pm10
-rw-r--r--lib/Fripost/Schema/Local.pm27
5 files changed, 39 insertions, 13 deletions
diff --git a/INSTALL b/INSTALL
index e40587b..4027c9d 100644
--- a/INSTALL
+++ b/INSTALL
@@ -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
diff --git a/TODO.org b/TODO.org
index d9aa4a1..c8600ce 100644
--- a/TODO.org
+++ b/TODO.org
@@ -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;
}