New domains.

7 files changed, 324 insertions, 81 deletions

diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm
index d04fa3a..e4724d1 100644
--- a/lib/Fripost/Panel/Interface.pm
+++ b/lib/Fripost/Panel/Interface.pm
@@ -18,7 +18,8 @@ use Fripost::Schema::Util 'split_addr';
 use Fripost::Password;
 use HTML::Entities 'encode_entities';
 use URI::Escape::XS 'encodeURIComponent';
-use Net::IDN::Encode qw/email_to_unicode email_to_ascii/;
+use Net::IDN::Encode qw/email_to_unicode email_to_ascii domain_to_ascii/;
+use Encode;
 
 
 # This method is called right before the 'setup' method below. It
@@ -38,8 +39,6 @@ sub ListDomains : StartRunmode {
     my $self = shift;
     my %CFG = $self->cfg;
 
-    my ($ul,$ud) = split_addr( $self->authen->username, -encode => 'unicode' );
-
     my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
     my @domains = $fp->domain->search( -concat => "\n", -die => 403);
     $fp->done;
@@ -49,6 +48,7 @@ sub ListDomains : StartRunmode {
     $template->param( $self->userInfo );
     $template->param( domains => [ map { { &mkLink( domain => $_->{domain})
                                          , isactive => $_->{isactive}
+                                         , ispending => $_->{ispending}
                                          , description => $_->{description} } }
                                        @domains ]
     );
@@ -62,10 +62,16 @@ sub ListLocals : Runmode {
     my $self = shift;
     my %CFG = $self->cfg;
 
-    my ($ul,$ud) = split_addr( $self->authen->username, -encode => 'unicode' );
     my $d = ($self->split_path)[1];
     my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
 
+    my $q = $self->query;
+    if (defined $q->param('unlock') and $q->param('unlock') ne '') {
+        $fp->domain->unlock( $d, $q->param('unlock') );
+        $fp->done;
+        return $self->redirect('../');
+    }
+
     # Query *the* matching domain
     my %domain = $fp->domain->get( $d, -die => 404 );
 
@@ -156,7 +162,6 @@ sub EditDomain : Runmode {
     my $self = shift;
     my %CFG = $self->cfg;
 
-    my ($ul,$ud) = split_addr( $self->authen->username, -encode => 'unicode' );
     my $d = ($self->split_path)[1];
 
     my $q = $self->query;
@@ -169,11 +174,11 @@ sub EditDomain : Runmode {
         # Changes have been submitted: process them
         $error = $fp->domain->replace({
                      domain => $d,
-                     isactive => $q->param('isactive'),
-                     description => $q->param('description'),
-                     catchalls => $q->param('catchalls'),
-                     canAddAlias => $q->param('canAddAlias'),
-                     canAddList => $q->param('canAddList')
+                     isactive => $q->param('isactive') // 1,
+                     description => $q->param('description') // undef,
+                     catchalls => $q->param('catchalls') // undef,
+                     canAddAlias => $q->param('canAddAlias') // undef,
+                     canAddList => $q->param('canAddList') // undef
         }, -concat => "(\n|\x{0D}\x{0A})");
     }
     my %domain = $fp->domain->get( $d, -die => 404 );
@@ -186,11 +191,11 @@ sub EditDomain : Runmode {
                     , isPostmaster => $domain{permissions} eq 'p');
     if ($error) {
         # Preserve the (incorrect) form
-        $template->param( isactive => $q->param('isactive')
-                        , description => $q->param('description')
-                        , catchalls => $q->param('catchalls')
-                        , canAddAlias => $q->param('canAddAlias')
-                        , canAddList => $q->param('canAddList')
+        $template->param( isactive => $q->param('isactive') // 1
+                        , description => $q->param('description') // undef
+                        , catchalls => $q->param('catchalls') // undef
+                        , canAddAlias => $q->param('canAddAlias') // undef
+                        , canAddList => $q->param('canAddList') // undef
                         , error => encode_entities ($error) );
     }
     else {
@@ -241,11 +246,11 @@ sub EditLocal : Runmode {
         my %entry;
         if ($t eq 'user') {
             $entry{user} = $l.'@'.$d;
-            $entry{forwards} = $q->param('forwards');
+            $entry{forwards} = $q->param('forwards') // undef;
 
-            if ($q->param('oldpw') ne '' or
-                $q->param('newpw') ne '' or
-                $q->param('newpw2') ne '') {
+            if (($q->param('oldpw')  // '') ne '' or
+                ($q->param('newpw')  // '') ne '' or
+                ($q->param('newpw2') // '') ne '') {
                 # If the user tries to change the password, we make her
                 # bind first, to prevent an attacker from setting a
                 # custom password and accessing the emails.
@@ -263,13 +268,13 @@ sub EditLocal : Runmode {
                         my $u = email_to_unicode($self->authen->username);
                         $fp = Fripost::Schema::->auth(
                                   $u,
-                                  $q->param('oldpw'),
+                                  $q->param('oldpw') // '',
                                   %CFG,
                                   -die => "Wrong password (for ‘".$u."’)." );
                     };
                     $error = $@ || $fp->user->passwd(
                                       $entry{user},
-                                      Fripost::Password::hash($q->param('newpw'))
+                                      Fripost::Password::hash($q->param('newpw') // '')
                                    );
                     $fp->done if defined $fp;
                 }
@@ -277,14 +282,14 @@ sub EditLocal : Runmode {
         }
         elsif ($t eq 'alias') {
             $entry{alias} = $l.'@'.$d;
-            $entry{maildrop} = $q->param('maildrop');
+            $entry{maildrop} = $q->param('maildrop') // undef;
         }
         elsif ($t eq 'list') {
             $entry{list} = $l.'@'.$d;
-            $entry{transport} = $q->param('transport');
+            $entry{transport} = $q->param('transport') // undef;
         }
-        $entry{isactive} = $q->param('isactive');
-        $entry{description} = $q->param('description');
+        $entry{isactive} = $q->param('isactive') // 1;
+        $entry{description} = $q->param('description') // undef;
         $error = $fp->$t->replace( \%entry, -concat => "(\n|\x{0D}\x{0A})")
             unless $error;
     }
@@ -297,17 +302,17 @@ sub EditLocal : Runmode {
         # Preserve the (incorrect) form, except the passwords
         if ($t eq 'user') {
             $template->param( user => encode_entities($l)
-                            , forwards => $q->param('forwards') );
+                            , forwards => $q->param('forwards') // undef );
         }
         elsif ($t eq 'alias') {
             $template->param( alias => encode_entities($l)
-                            , maildrop => $q->param('maildrop') );
+                            , maildrop => $q->param('maildrop') // undef );
         }
         elsif ($t eq 'list') {
             $template->param( list => encode_entities($l) );
         }
-        $template->param( isactive => $q->param('isactive')
-                        , description => $q->param('description') );
+        $template->param( isactive => $q->param('isactive') // 1
+                        , description => $q->param('description') // undef );
     }
     else {
         %local = $fp->local->get ($l.'@'.$d, -die => 404,
@@ -339,6 +344,82 @@ sub EditLocal : Runmode {
     return $template->output;
 }
 
+sub AddDomain : Runmode {
+    my $self = shift;
+    my %CFG = $self->cfg;
+
+    my $q = $self->query;
+    return $self->redirect('./') if defined $q->param('cancel'); # Cancellation
+
+    my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
+    my $domain = $q->param('domain');
+    Encode::_utf8_on($domain) if defined $domain;
+    my $session_param;
+    $session_param = 'AddDomain-Postmasters-' . domain_to_ascii($domain)
+        if defined $domain;
+
+    my $error; # Tells whether the change submission has failed.
+    if (defined $q->param('submit')) {
+        # Changes have been submitted: process them
+
+        if (defined $q->param('postmaster') and defined $session_param) {
+            my @postmasters = split /\s*,\s*/, $self->session->param($session_param);
+            $error = "‘".$q->param('postmaster')."’ was not listed among the domain owners."
+                unless defined $self->session->param($session_param)
+                           and grep { $q->param('postmaster') eq $_ } @postmasters;
+        }
+
+        $error = $fp->domain->add({
+                     domain => $domain,
+                     send_token_to => $q->param('postmaster') // undef,
+                     isactive => $q->param('isactive') // 1,
+                     description => $q->param('description') // undef,
+                     catchalls => $q->param('catchalls') // undef },
+                 -concat => "(\n|\x{0D}\x{0A})",
+                '-dry-run' => not (defined $q->param('postmaster')),
+                 -domainurl => $q->url.'/'.encode_entities($domain).'/' # TODO: try that in nginx
+        ) unless $error;
+    }
+    $fp->done;
+
+    return $self->redirect('./') # Confirmation token sent, everything OK
+        if ($error // '') eq '' and defined $q->param('postmaster');
+
+    my $tmpl_file;
+    my @postmasters;
+
+    if (($error // '') ne '' or not (defined $domain)) {
+        # Something went wrong, or the domain is unknown
+        $tmpl_file = 'add-domain-1.html';
+    }
+    else {
+        $tmpl_file = 'add-domain-2.html';
+        @postmasters = Fripost::Schema::Domain::->list_postmasters($domain);
+    }
+
+    my $template = $self->load_tmpl( $tmpl_file, cache => 1,
+                                   , loop_context_vars => 1 );
+    $template->param( $self->userInfo );
+    $template->param( error => encode_entities ($error) ) if $error;
+
+    $template->param( isactive => $q->param('isactive') // 1
+                    , description => $q->param('description') // undef
+                    , catchalls => $q->param('catchalls') // undef
+                    );
+    $template->param( domain => encode_entities($domain) )
+        if defined $domain;
+
+    if (@postmasters) {
+        # Store it, to ensure the user doesn't send back a bogus email
+        $self->session->param( $session_param, join(',', @postmasters) );
+        $self->session->flush;
+
+        $template->param( postmasters => [ map {{postmaster => $_}} @postmasters ] )
+    }
+
+    return $template->output;
+}
+
 
 # In this Run Mode authenticated users can add users, aliases and lists
 # (if they have the permission).
@@ -400,8 +481,8 @@ sub AddLocal : Runmode {
             # Unknown type
             return $self->redirect('./');
         }
-        $entry{isactive} = $q->param('isactive');
-        $entry{description} = $q->param('description');
+        $entry{isactive} = $q->param('isactive') // 1;
+        $entry{description} = $q->param('description') // undef;
 
         unless ($error) {
             my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
@@ -417,23 +498,23 @@ sub AddLocal : Runmode {
     if ($error) {
         # Preserve the (incorrect) form, except the passwords
         if ($t eq 'user') {
-            $template->param( user => $q->param('user')
-                            , forwards => $q->param('forwards') );
+            $template->param( user => $q->param('user') // undef
+                            , forwards => $q->param('forwards') // undef );
         }
         elsif ($t eq 'alias') {
-            $template->param( alias => $q->param('alias')
-                            , maildrop => $q->param('maildrop') );
+            $template->param( alias => $q->param('alias') // undef
+                            , maildrop => $q->param('maildrop') // undef );
         }
         elsif ($t eq 'list') {
-            $template->param( list => $q->param('list')
+            $template->param( list => $q->param('list') // undef
                             , isenc => $q->param('transport') eq 'schleuder' );
         }
         else {
             # Unknown type
             return $self->redirect('./');
         }
-        $template->param( isactive => $q->param('isactive')
-                        , description => $q->param('description')
+        $template->param( isactive => $q->param('isactive') // 1
+                        , description => $q->param('description') // undef
                         , error => encode_entities ($error) );
     }
     else {
diff --git a/lib/Fripost/Panel/Login.pm b/lib/Fripost/Panel/Login.pm
index 12b0294..b0906b3 100644
--- a/lib/Fripost/Panel/Login.pm
+++ b/lib/Fripost/Panel/Login.pm
@@ -105,13 +105,12 @@ sub setup {
         # /domain/{user,alias,list}/?query_url
         my ($null,$domain,$local,$crap) = $self->split_path;
 
-        return 'ListDomains' unless (defined $null) and $null eq '';
+        return 'ListDomains' if (defined $null) and $null ne '';
 
         unless (defined $domain and $domain ne '') {
-            # TODO
-#            if (defined $a) {
-#                return 'AddDomain' if $a eq 'add';
-#            }
+            if (defined $a) {
+                return 'AddDomain' if $a eq 'add';
+            }
             return 'ListDomains';
         }
 
diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm
index e86822f..993d771 100644
--- a/lib/Fripost/Schema/Domain.pm
+++ b/lib/Fripost/Schema/Domain.pm
@@ -21,6 +21,13 @@ use Fripost::Schema::Util qw/concat get_perms explode must_attrs
                              email_valid canonical_dn/;
 use Net::IDN::Encode qw/domain_to_ascii domain_to_unicode
                         email_to_ascii email_to_unicode/;
+use Encode;
+use Net::Domain::TLD 'tld_exists';
+use Net::DNS::Dig;
+use Net::Whois::Parser 'parse_whois';
+use String::Random;
+use Template;
+use MIME::Entity;
 
 
 =head1 METHODS
@@ -44,7 +51,8 @@ sub search {
                       scope => 'one',
                       deref => 'never',
                       filter => 'objectClass=FripostVirtualDomain',
-                      attrs => [ qw/fvd description fripostIsStatusActive/ ]
+                      attrs => [ qw/fvd description fripostIsStatusActive
+                                    fripostIsStatusPending/ ]
                   );
     if ($domains->code) {
         die $options{'-die'}."\n" if defined $options{'-die'};
@@ -52,6 +60,7 @@ sub search {
     }
     return map { { domain => domain_to_unicode($_->get_value('fvd'))
                  , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
+                 , ispending => defined $_->get_value('fripostIsStatusPending')
                  , description => concat($concat, $_->get_value('description'))
                  }
                }
@@ -148,10 +157,158 @@ sub replace {
 }
 
 
+sub list_postmasters {
+    my $self = shift;
+    my $hostname = shift;
+    my @postmasters;
+
+    my $tld = domain_to_ascii($hostname);
+    my $domain;
+    until ( tld_exists($tld) ) {
+        die "‘".$hostname."’ has an Invalid TLD.\n" unless $tld =~ /\./;
+        $domain = $tld;
+
+        my %mx = Net::DNS::Dig->new()->for( $domain, 'MX' )->rdata;
+        push @postmasters, 'postmaster@'.$domain  # RFC 822, appendix C.6
+        if grep {!/\bfripost\.org$/} (values %mx);
+
+        $tld =~ s/^[^\.]*\.//;
+    }
+
+    my $info = parse_whois( domain => $domain );
+#    die "Cannot WHOIS ‘".$domain."’.\n" unless defined $info;
+    # TODO: there is a bug with the encoding
+    if (defined $info) {
+        push @postmasters, @{$info->{emails}};
+    }
+
+    my %hash;
+    $hash{$_} = 1 for grep {email_valid($_ // '', -nodie => 1 )}
+                           @postmasters;
+    sort keys %hash;
+}
+
 sub add {
-    die "TODO";
+    my $self = shift;
+    my $d = shift;
+    my %options = @_;
+
+    foreach (qw/description catchalls canAddAlias canAddList/) {
+        $d->{$_} = explode ($options{'-concat'}, $d->{$_})
+            if defined $d->{$_};
+    }
+
+    eval {
+        my $domain = $d->{domain};
+        Encode::_utf8_on($domain);
+        &_is_valid($d);
+
+        my $dn = canonical_dn( {fvd => $d->{domain}}, @{$self->suffix} );
+
+        my $mesg = $self->ldap->search(
+                       base => $dn,
+                       scope => 'base',
+                       deref => 'never',
+                       filter => 'objectClass=FripostVirtualDomain',
+                       attrs => [] );
+        if ($mesg->code == 0) {
+            die "Domain ‘".$domain."’ already exists.\n";
+        }
+        elsif ($mesg->code != 32) {
+            die $mesg->error."\n";
+        }
+
+        return if $options{'-dry-run'};
+
+        my %attrs = ( objectClass => 'FripostVirtualDomain'
+                    , fripostIsStatusActive => $d->{isactive} ?
+                        'TRUE' : 'FALSE'
+                    );
+        $attrs{description} = $d->{description}
+            if defined $d->{description} and @{$d->{description}};
+        $attrs{fripostOptionalMaildrop} = $d->{catchalls}
+            if defined $d->{catchalls} and @{$d->{catchalls}};
+
+        if (defined $d->{owner}) {
+            $attrs{fripostOwner} = $self->_fvu2dn($d->{owner})
+              if $d->{owner} ne '';
+        }
+        else {
+            $attrs{fripostOwner} = $self->whoami;
+        }
+
+        my $token;
+        if (defined $d->{send_token_to}) {
+            $token = String::Random::->new->randregex('\w{32}');
+            $attrs{fripostIsStatusPending} = $token
+        }
+
+        $mesg = $self->ldap->add( $dn, attrs => [ %attrs ] );
+        die $mesg->error."\n" if $mesg->code;
+
+
+        if (defined $d->{send_token_to}) {
+            my $tt = Template->new({
+              INCLUDE_PATH => './templates',  # TODO: use a config option
+              INTERPOLATE  => 1,
+            }) or die $Template::ERROR."\n";
+
+            my $data;
+            my $vars = { domain => $domain, token => $token };
+            $vars->{unlockurl} = $options{'-domainurl'}.'?unlock='.$token
+                if defined $options{'-domainurl'};
+            $tt->process( 'new-domain.tt', $vars, \$data)
+                or die $tt->error."\n";
+
+            my $mail = MIME::Entity::->build(
+              From     => 'Fripost Admin Panel <AdminWebPanel@fripost.org>',
+              To       => $d->{send_token_to},
+              Subject  => "Your new domain ".$d->{domain},
+              Encoding => 'quoted-printable',
+              Charset  => 'utf-8',
+              Data     => $data
+            );
+            $mail->send;
+        }
+
+    };
+    return $@;
+}
+
+sub unlock {
+    my $self = shift;
+    my $d = shift;
+    my $code = shift;
+
+    eval {
+        my $dn = canonical_dn({fvd => domain_to_ascii($d)}, @{$self->suffix});
+        my $domains = $self->ldap->search(
+                          base => $dn,
+                          scope => 'base',
+                          deref => 'never',
+                          filter => '(&(objectClass=FripostVirtualDomain)'.
+                                      '(fripostIsStatusPending=*))',
+                          attrs => [ 'fripostIsStatusPending' ]
+                      );
+        die $domains->error."\n" if $domains->code;
+
+        my $domain = $domains->pop_entry;
+        die "No such such domain: ‘".$d."’\n" unless defined $domain;
+
+        die "Wrong unlock code for ‘".$d."’\n"
+            unless $domain->get_value('fripostIsStatusPending') eq $code;
+        # TODO: a more secure option would be to add a 'userPassword'
+        # attribute to domains. We can bind as the domain to check the
+        # validity of the token and add an ACL rule to give =z rights on
+        # self and =0 for everyone else.
+
+        my $mesg = $self->ldap->modify( $dn, delete => 'fripostIsStatusPending' );
+        die $mesg->error."\n" if $mesg->code;
+    };
+    return $@;
 }
 
+
 =back
 
 =head1 GLOBAL OPTIONS
@@ -179,6 +336,9 @@ sub _is_valid {
                                  @{$d->{canAddAlias}} ];
     $d->{canAddList} = [ map { email_valid($_, -prefix => 'fake') }
                                 @{$d->{canAddList}} ];
+
+    $d->{send_token_to} = email_valid( $d->{send_token_to} )
+                              if defined $d->{send_token_to};
 }
 
 
diff --git a/lib/Fripost/Schema/List.pm b/lib/Fripost/Schema/List.pm
index 18eeb29..2c4d1bc 100644
--- a/lib/Fripost/Schema/List.pm
+++ b/lib/Fripost/Schema/List.pm
@@ -42,7 +42,7 @@ sub search {
     my $concat = $options{'-concat'};
 
     my $filter = 'objectClass=FripostVirtualList';
-    $filter = '(&('.$filter.')(!(fripostIsStatusPending=TRUE)))'
+    $filter = '(&('.$filter.')(!(fripostIsStatusPending=*)))'
         if (defined $options{'-is_pending'}) and !$options{'-is_pending'};
 
     my $lists = $self->ldap->search(
@@ -62,7 +62,7 @@ sub search {
                  , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
                  , description => concat($concat, $_->get_value('description'))
                  , transport => $_->get_value('fripostListManager')
-                 , ispending => ($_->get_value('fripostIsStatusPending') // '') eq 'TRUE'
+                 , ispending => defined $_->get_value('fripostIsStatusPending')
                  }
                }
                $lists->sorted('fvl')
@@ -144,8 +144,7 @@ sub add {
     # Ask the list manager to create the list now.
 
     my $member = email_valid( $self->_dn2fvu($self->whoami), -exact => 1);
-    my $to = email_valid( 'mklist+'.$l->{transport}.'@fripost.org'
-                        , -exact => 1 );
+    my $to = email_valid( 'mklist+'.$l->{transport}.'@fripost.org' );
 
     my $mail = MIME::Entity::->build(
         From     => 'Fripost Admin Panel <AdminWebPanel@fripost.org>',
diff --git a/lib/Fripost/Schema/Local.pm b/lib/Fripost/Schema/Local.pm
index 5ca833c..c342f23 100644
--- a/lib/Fripost/Schema/Local.pm
+++ b/lib/Fripost/Schema/Local.pm
@@ -141,10 +141,11 @@ sub exists {
 
     foreach (@tests) {
         my $dn = canonical_dn($_, {fvd => $d}, @{$self->suffix});
-        my $mesg = $self->ldap->search( base => $dn,
-                                        scope => 'base',
-                                        deref => 'never',
-                                        filter => 'objectClass=*'
+        my $mesg = $self->ldap->search( base => $dn
+                                      , scope => 'base'
+                                      , deref => 'never'
+                                      , filter => 'objectClass=*'
+                                      , attrs => []
         );
         return 1 unless $mesg->code; # 0  Success
         unless ($mesg->code == 32) { # 32 No such object
diff --git a/lib/Fripost/Schema/User.pm b/lib/Fripost/Schema/User.pm
index 7d79e69..3b5cfca 100644
--- a/lib/Fripost/Schema/User.pm
+++ b/lib/Fripost/Schema/User.pm
@@ -72,23 +72,23 @@ Replace an existing account with the given one.
 
 sub replace {
     my $self = shift;
-    my $m = shift;
+    my $u = shift;
     my %options = @_;
 
     foreach (qw/description forwards/) {
-        $m->{$_} = explode ($options{'-concat'}, $m->{$_})
-            if defined $m->{$_};
+        $u->{$_} = explode ($options{'-concat'}, $u->{$_})
+            if defined $u->{$_};
     }
 
     eval {
-        my ($l,$d) = split_addr( $m->{user}, -encode => 'ascii' );
-        &_is_valid($m);
+        my ($l,$d) = split_addr( $u->{user}, -encode => 'ascii' );
+        &_is_valid($u);
         my $mesg = $self->ldap->modify(
                        canonical_dn( {fvu => $l}, {fvd => $d}, @{$self->suffix} ),
-                       replace => { fripostIsStatusActive => $m->{isactive} ?
+                       replace => { fripostIsStatusActive => $u->{isactive} ?
                                         'TRUE' : 'FALSE'
-                                  , description => $m->{description}
-                                  , fripostOptionalMaildrop => $m->{forwards}
+                                  , description => $u->{description}
+                                  , fripostOptionalMaildrop => $u->{forwards}
                    } );
         die $mesg->error."\n" if $mesg->code;
     };
@@ -126,30 +126,30 @@ Add the given account.
 
 sub add {
     my $self = shift;
-    my $m = shift;
+    my $u = shift;
     my %options = @_;
 
     foreach (qw/description forwards/) {
-        $m->{$_} = explode ($options{'-concat'}, $m->{$_})
-            if defined $m->{$_};
+        $u->{$_} = explode ($options{'-concat'}, $u->{$_})
+            if defined $u->{$_};
     }
 
     eval {
-        die "Missing user name\n" unless $m->{user} =~ /^.+\@.+$/;
-        my ($l,$d) = split_addr( $m->{user}, -encode => 'ascii' );
-        &_is_valid($m);
-        die "‘".$m->{user}."’ already exists\n"
-            if $self->local->exists($m->{user},%options);
+        die "Missing user name\n" unless $u->{user} =~ /^.+\@.+$/;
+        my ($l,$d) = split_addr( $u->{user}, -encode => 'ascii' );
+        &_is_valid($u);
+        die "‘".$u->{user}."’ already exists\n"
+            if $self->local->exists($u->{user},%options);
 
         my %attrs = ( objectClass => 'FripostVirtualUser'
-                    , fripostIsStatusActive => $m->{isactive} ? 'TRUE' : 'FALSE'
-                    , userPassword => $m->{password}
+                    , fripostIsStatusActive => $u->{isactive} ? 'TRUE' : 'FALSE'
+                    , userPassword => $u->{password}
                     );
-        $attrs{description} = $m->{description}
-            if defined $m->{description} and @{$m->{description}};
-        $attrs{fripostUserQuota} = $m->{quota} if defined $m->{quota};
-        $attrs{fripostOptionalMaildrop} = $m->{forwards}
-            if defined $m->{forwards} and @{$m->{forwards}};
+        $attrs{description} = $u->{description}
+            if defined $u->{description} and @{$u->{description}};
+        $attrs{fripostUserQuota} = $u->{quota} if defined $u->{quota};
+        $attrs{fripostOptionalMaildrop} = $u->{forwards}
+            if defined $u->{forwards} and @{$u->{forwards}};
 
         my $mesg = $self->ldap->add(
                        canonical_dn( {fvu => $l}, {fvd => $d}, @{$self->suffix} ),
@@ -203,10 +203,10 @@ The B<-die> option, if present, overides LDAP croaks and errors.
 
 # Ensure that the given user is valid.
 sub _is_valid {
-    my $m = shift;
-    must_attrs( $m, qw/user isactive/ );
-    $m->{user} = email_valid( $m->{user}, -exact => 1);
-    $m->{forwards} = [ map { email_valid($_) } @{$m->{forwards}} ];
+    my $u = shift;
+    must_attrs( $u, qw/user isactive/ );
+    $u->{user} = email_valid( $u->{user}, -exact => 1);
+    $u->{forwards} = [ map { email_valid($_) } @{$u->{forwards}} ];
     # TODO: match 'quota' against the Dovecot specifications
 }
 
diff --git a/lib/Fripost/Schema/Util.pm b/lib/Fripost/Schema/Util.pm
index b26214b..2692421 100644
--- a/lib/Fripost/Schema/Util.pm
+++ b/lib/Fripost/Schema/Util.pm
@@ -116,7 +116,10 @@ sub email_valid {
                                         -fqdn => 1 );
     my $match = defined $addr;
     $match &&= $addr eq $in if $options{'-exact'};
-    die $mesg." ‘".$i."’\n" unless $match;
+    unless ($match) {
+      return if $options{'-nodie'};
+      die $mesg." ‘".$i."’\n";
+    }
     $addr =~ s/^$options{'-prefix'}// if defined $options{'-prefix'};
     return $addr;
 }