Updated and redocumented Fripost::Schema::Domain.

4 files changed, 695 insertions, 248 deletions

diff --git a/lib/Fripost/Schema/Auth.pm b/lib/Fripost/Schema/Auth.pm
index 2df1a7e..c6325b8 100644
--- a/lib/Fripost/Schema/Auth.pm
+++ b/lib/Fripost/Schema/Auth.pm
@@ -68,7 +68,7 @@ the virtual entries.
 
 =back
 
-Errors can be caught with options B<-die> and B<-errors>, see
+Errors can be caught with options B<-die> and B<-error>, see
 B<Fripost::Schema::Util> for details.
 
 =cut
@@ -82,7 +82,7 @@ sub SASLauth {
     my $self = bless {}, $class;
 
     $self->suffix( ldap_explode_dn(@{$options{ldap_suffix}}) );
-    $self->whoami( $self->mkdn($user) );
+    $self->whoami( $self->mail2dn($user) );
     $self->ldap( Net::LDAP::->new( $options{ldap_uri} // 'ldap://127.0.0.1:389/'
                                  , async => 0 ) );
     assert( $self->ldap, -die => "Couldn't connect to the LDAP server." );
@@ -109,7 +109,7 @@ sub SASLauth {
                                   , callback => $callback );
     my $host = $options{ldap_SASL_service_instance} // 'localhost';
     my $conn = $sasl->client_new( 'ldap', $host );
-    ldap_error ($conn, %options);
+    ldap_error ($conn, %options) // return;
 
     my $mesg = $self->ldap->bind( undef, sasl => $conn );
     ldap_error ($mesg, %options) // return;
@@ -145,7 +145,7 @@ the virtual entries.
 
 =back
 
-Errors can be caught with options B<-die> and B<-errors>, see
+Errors can be caught with options B<-die> and B<-error>, see
 B<Fripost::Schema::Util> for details.
 
 =cut
@@ -164,7 +164,7 @@ sub auth {
     }
     else {
         return unless defined $user;
-        $self->whoami( $self->mkdn($user) );
+        $self->whoami( $self->mail2dn($user) );
     }
 
     $self->ldap( Net::LDAP::->new( $options{ldap_uri} // 'ldap://127.0.0.1:389/'
@@ -189,14 +189,14 @@ attribute of the DN associated with I<username>.
 If I<newpassword> is left undefined, the new password is generated at
 random, and returned upon success.
 
-Errors can be caught with options B<-die> and B<-errors>, see
+Errors can be caught with options B<-die> and B<-error>, see
 B<Fripost::Schema::Util> for details.
 
 =cut
 
 sub passwd {
     my $self = shift;
-    my $user = $self->mkdn(shift) // $self->whoami;
+    my $user = $self->mail2dn(shift) // $self->whoami;
     my $oldpw = shift;
     my $newpw = shift;
     my %options = @_;
@@ -243,7 +243,7 @@ of hashes), defined in B<Net::LDAP::Util>.
 sub suffix { shift->_set_or_get('_suffix',@_); }
 
 
-=item B<mkdn> ({I<username>|I<domainname>})
+=item B<mail2dn> ({I<username>|I<domainname>})
 
 Create the Distinguished Name associated with the I<username> (may be an
 alias or a list name regardless) or I<domainname>. The argument is first
@@ -251,12 +251,16 @@ converted to ASCII.
 
 =cut
 
-sub mkdn {
+sub mail2dn {
     my $self = shift;
     my $user = shift // return;
+
+    $user =~ s/^([^\@]+)$/\@$1/;
     my ($l,$d) = split_addr($user, -encode => 'ascii');
+
     my @dn = ({fvd => $d}, @{$self->suffix});
-    unshift @dn, {fvl => $l} if defined $l and $l ne '';
+    unshift @dn, {fvl => $l} if $l;
+
     canonical_dn( @dn );
 }
 
diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm
index 8c3586f..75a525d 100644
--- a/lib/Fripost/Schema/Domain.pm
+++ b/lib/Fripost/Schema/Domain.pm
@@ -2,11 +2,11 @@ package Fripost::Schema::Domain;
 
 =head1 NAME
 
-Domain.pm -
+Domain.pm - Domain related methods in the Fripost Schema
 
 =head1 DESCRIPTION
 
-Domain.pm abstracts the LDAP schema definition and provides methods to
+This module abstracts the LDAP schema definition and provides methods to
 add, list or delete virtual domains.
 
 =cut
@@ -17,188 +17,403 @@ use warnings;
 use utf8;
 
 use parent 'Fripost::Schema';
-use Net::LDAP qw/LDAP_SUCCESS LDAP_COMPARE_TRUE LDAP_NO_SUCH_OBJECT/;
-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 Fripost::Schema::Util qw/must_attrs softdie canonical_dn dn2mail email_valid
+                             ldap_explode_dn ldap_error ldap_and_filter/;
+use Fripost::Schema::Mail;
+use Net::IDN::Encode qw/domain_to_ascii domain_to_unicode email_to_unicode/;
+use URI::Escape::XS 'encodeURIComponent';
 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 REPRESENTATION
+
+Domains are imported and exported as hash references, having the
+following keys:
+
+=over 4
+
+=item B<name>
+
+A UTF-8 string representing the (internationalized) domain name.
+
+=item B<isActive> => 0|1
+
+Whether or not the domain is active.
+
+=item B<isPending> => 0|1
+
+Whether or not the domain is pending. This is key is ignored when adding
+a new domain, unless the user is asking for a confirmation token.
+
+=item B<canAddAlias>
+
+An optional array reference containing the (internationalized) e-mails
+addresses of users that have permission to create aliases (other than
+domain owner or postmaster) under this domain. The local part may be
+left empty to grant permissions to a whole domain.
+
+=item B<canAddList>
+
+An optional array reference containing the (internationalized) e-mails
+addresses of users that have permission to create mailing lists (other
+than domain owner or postmaster) under this domain. The local part may
+be left empty to grant permissions to a whole domain.
+
+=item B<owner>
+
+An optional array reference containing the (internationalized) e-mails
+addresses of the domain owners (other than postmasters).
+
+=item B<postmaster>
+
+An optional array reference containing the (internationalized) e-mails
+addresses of the domain postmasters.
+
+=item B<catchAlls>
+
+An optional array reference containing the (internationalized)
+catch-alls for that domain. Localparts may be left empty for domain
+aliases.
+
+=item B<description>
+
+An array reference containing UTF-8 string representing that domain.
+
+=item B<permissions>
+
+An optional string representing the permission of the current user
+against this domain. (Note that this key is ignored when inserting a new
+domain, since the information is redundent with B<canAddAlias>,
+B<canAddList>, B<owner> and B<postmaster>.) The string is a sequence of
+characters which meaning is:
+
+=over 4
+
+=item B<a>
+
+The current user can add aliases under that domain (but is not listed
+among domain owners or postmasters).
+
+=item B<l>
+
+The current user can add mailing lists under that domain (but is not
+listed among domain owners or postmasters).
+
+=item B<o>
+
+The current user owns that domain.
+
+=item B<p>
+
+The current user has postmaster rights on that domain.
+
+=back
+
+=back
+
+Note that when retrieving a domain from the database, only a subset of
+these keys may be visible, hence exported.
 
 
 =head1 METHODS
 
 =over 4
 
-=item B<search> (I<OPTIONS>)
+=item B<search> (I<domainname>, I<OPTIONS>)
+
+Search for I<domainname>, or list all the known (and visible) domains
+when I<domainname> is not defined. In list context, return a list of
+domains represented as hash references, as explained above. In scalar
+context, only the first domain found is returned. In void context, no
+attributes are returned from the LDAP server, but it may nevertheless be
+useful, to ensure that the result set is not empty for instance.
+
+The following options are considered:
+
+=over 4
+
+=item B<-no-escape> => 0|1
+
+By default, I<domainname> - when defined - is safely escaped before
+insertion into the LDAP filter. This flag disables escaping. It is
+useful if I<domainname> contains wildcards for instance.
+
+=item B<-filter> => locked|unlocked
+
+Limit the search scope to pending / non-pending domains only.
+
+=item B<-keys>
+
+An array reference containing the attributes that are to be retrived
+from the LDAP server. Note that Access Control List may prevent the
+current user to read or even search anything, though. The default is to
+retrieve every visible attribute, unless in void context where B<-keys>
+is set to [] that is, no attribute is sent back to the client.
+
+=item B<-assert-exists>
+
+A custom error to be raised on empty result sets. When 0, it makes the
+method returns the size of the result set.
+
+=item B<-sort> => 0|1
+
+In list context, sort the results per domain name.
+
+=back
 
-List every known (and visible) domain. The output is a array of hash
-references, sorted by domain names.
+Errors can be caught with options B<-die> and B<-error>, see
+B<Fripost::Schema::Util> for details.
 
 =cut
 
 sub search {
     my $self = shift;
+    my $domainname = shift;
     my %options = @_;
 
-    my $concat = $options{'-concat'};
-    my $filter = '(objectClass=FripostVirtualDomain)';
+    # Nothing to do after an error.
+    return if $options{'-error'} && ${$options{'-error'}};
+
+    my @filters = ('objectClass=FripostVirtualDomain');
+
+    if ($domainname) {
+        $domainname = Net::LDAP::Util::escape_filter_value($domainname)
+            unless $options{'-no-escape'};
+        push @filters, 'fvd='.$domainname;
+    }
 
     if (defined $options{'-filter'}) {
-        if ($options{'-filter'} eq 'locked') {
-            # Will only work if we're the owner, but otherwise we
-            # shouldn't see the domain anyway.
-            $filter = '(&'.$filter.'(fripostPendingToken=*))';
+        push @filters, 'objectClass=FripostPendingEntry'
+            if $options{'-filter'} eq 'locked';
+        push @filters, '!(objectClass=FripostPendingEntry)'
+            if $options{'-filter'} eq 'unlocked';
+    }
+
+    my $attrs = [];
+    if (not (defined wantarray)) {
+        # In void context, we are only interested in whether or not the
+        # result set is empty.
+        $attrs = [ '1.1' ];
+    }
+    elsif (defined $options{'-keys'}) {
+        $attrs = @{$options{'-keys'}} ? [ &_keys_to_attrs(@{$options{'-keys'}}) ]
+                                      : [ '1.1' ];
+    }
+
+    my $domains = $self->ldap->search( base => canonical_dn(@{$self->suffix})
+                                     , scope => 'one'
+                                     , deref => 'never'
+                                     , filter => ldap_and_filter(@filters)
+                                     , attrs => $attrs
+                                     );
+    ldap_error($domains, %options) // return;
+
+    softdie ($options{'-assert-exists'}, %options) // return
+        unless $domains->count;
+    return $domains->count if exists $options{'-assert-exists'};
+
+    &_entries_to_domains( $self->whoami, $options{'-keys'} // [],
+        wantarray ? ( $options{'-sort'} ? $domains->sorted('fvd')
+                                        : $domains->entries )
+                  : $domains->pop_entry
+    );
+}
+
+# Map a list of LDAP::Entry object into our public representation of
+# domains.
+sub _entries_to_domains {
+    my $user = lc shift;
+    my @dn = @{ldap_explode_dn $user};
+    shift @dn;
+    my $parent = lc (canonical_dn @dn);
+    my $keys = shift;
+
+    my @domains;
+    foreach my $entry (@_) {
+
+        # Ignore bogus entries.
+        return unless defined $entry;
+        my %domain;
+
+        foreach my $attr ($entry->attributes) {
+            my $val = $entry->get_value($attr, asref => 1);
+            if ($attr eq 'fvd') {
+                $domain{name} = domain_to_unicode($val->[0])
+                    if not @$keys or grep { $_ eq 'name' } @$keys;
+            }
+            elsif ($attr eq 'fripostIsStatusActive') {
+                $domain{isActive} = $val->[0] eq 'TRUE'
+                    if not @$keys or grep { $_ eq 'isActive' } @$keys;
+            }
+            elsif ($attr eq 'objectClass') {
+                $domain{isPending} = scalar (grep { lc $_ eq lc 'FripostPendingEntry' }
+                                                  @$val )
+                    if not @$keys or grep { $_ eq 'isPending' } @$keys;
+            }
+            elsif ($attr eq 'fripostCanAddAlias') {
+                $domain{canAddAlias} = [ map { dn2mail($_) } @$val ]
+                    if not @$keys or grep { $_ eq 'canAddAlias' } @$keys;
+            }
+            elsif ($attr eq 'fripostCanAddList') {
+                $domain{canAddList} = [ map { dn2mail($_) } @$val ]
+                    if not @$keys or grep { $_ eq 'canAddList' } @$keys;
+            }
+            elsif ($attr eq 'fripostOwner') {
+                $domain{owner} = [ map { dn2mail($_) } @$val ]
+                    if not @$keys or grep { $_ eq 'owner' } @$keys;
+            }
+            elsif ($attr eq 'fripostPostmaster') {
+                $domain{postmaster} = [ map { dn2mail($_) } @$val ]
+                    if not @$keys or grep { $_ eq 'postmaster' } @$keys;
+            }
+            elsif ($attr eq 'fripostOptionalMaildrop') {
+                $domain{catchAlls} = [ map { &_email_to_unicode($_) } @$val ]
+                    if not @$keys or grep { $_ eq 'catchAlls' } @$keys;
+            }
+            elsif ($attr eq 'description') {
+               $domain{description} = [ map { Encode::_utf8_on($_); $_ } @$val ]
+                    if not @$keys or grep { $_ eq 'description' } @$keys;
+            }
+            else {
+                die "Missing translation for domain attribute ‘".$attr."’.";
+            }
         }
-        elsif ($options{'-filter'} eq 'nonlocked') {
-            $filter = '(&'.$filter.'(!(fripostPendingToken=*)))';
+
+        # Add a 'permissions' key if wanted.
+        if ((not @$keys or grep { $_ eq 'permissions' } @$keys) and
+            grep { $entry->exists($_) } qw/fripostCanAddAlias fripostCanAddList
+                                           fripostOwner fripostPostmaster/) {
+            my $perms = '';
+            $perms .= 'a' if $entry->exists('fripostCanAddAlias') and
+                             grep { $user eq lc $_  or  $parent eq lc $_ }
+                                  $entry->get_value('fripostCanAddAlias');
+            $perms .= 'l' if $entry->exists('fripostCanAddList') and
+                             grep { $user eq lc $_  or  $parent eq lc $_ }
+                                  $entry->get_value('fripostCanAddList');
+            $perms  = 'o' if $entry->exists('fripostOwner') and
+                             grep { $user eq lc $_ }
+                                  $entry->get_value('fripostOwner');
+            $perms  = 'p' if $entry->exists('fripostPostmaster') and
+                             grep { $user eq lc $_ }
+                                  $entry->get_value('fripostPostmaster');
+            $domain{permissions} = $perms;
+        }
+
+        # Stop after the first processed domain in scalar mode.
+        return \%domain unless wantarray;
+        push @domains, \%domain;
+    }
+    return @domains;
+}
+
+
+# Map our domain keys into the LDAP attribute(s) that are required to
+# fetch this information.
+sub _keys_to_attrs {
+    my %map = ( name => 'fvd'
+              , isActive => 'fripostIsStatusActive'
+              , isPending => 'objectClass'
+              , canAddAlias => 'fripostCanAddAlias'
+              , canAddList => 'fripostCanAddList'
+              , owner => 'fripostOwner'
+              , postmaster => 'fripostPostmaster'
+              , catchAlls => 'fripostOptionalMaildrop'
+              , description => 'description'
+              , permissions => [ qw/fripostCanAddAlias fripostCanAddList
+                                    fripostOwner fripostPostmaster/ ]
+              );
+    my %attrs;
+    foreach my $k (@_) {
+        die "Missing translation for key ‘".$k."’."
+            unless exists $map{$k};
+        if (ref $map{$k} eq 'ARRAY') {
+            $attrs{$_} = 1 for @{$map{$k}};
         }
         else {
-            die "Unknown filter: ".$options{'-filter'}."\n";
+            $attrs{$map{$k}} = 1;
         }
     }
-    else {
-        my @domains0 = map {{ %$_, ispending => 1 }}
-                           $self->search(%options, -filter => 'locked');
-        my @domains1 = map {{ %$_, ispending => 0 }}
-                           $self->search(%options, -filter => 'nonlocked');
-        return sort {$a->{domain} cmp $b->{domain}} (@domains0, @domains1);
-    }
+    return keys %attrs;
+}
 
-    my $domains = $self->ldap->search(
-                      base => canonical_dn(@{$self->suffix}),
-                      scope => 'one',
-                      deref => 'never',
-                      filter => $filter,
-                      attrs => [ qw/fvd description fripostIsStatusActive/ ]
-                  );
-    if ($domains->code) {
-        die $options{'-die'}."\n" if defined $options{'-die'};
-        die $domains->error."\n";
-    }
 
-    return map { { domain => domain_to_unicode($_->get_value('fvd'))
-                 , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
-                 , description => concat($concat, $_->get_value('description'))
-                 }
-               }
-               $domains->sorted('fvd')
-}
 
+=item B<canIAdd> (I<username>, I<OPTIONS>)
 
-=item B<get> (I<domain>, I<OPTIONS>)
+Returns 0 or 1, depending on whether or not I<username> has permission
+to add new domains. If I<username> is undefined, the current user is
+considered instead.
 
-Returns a hash with all the (visible) attributes for the given
-*non-pending* domain.
+Errors can be caught with options B<-die> and B<-error>, see
+B<Fripost::Schema::Util> for details.
 
 =cut
 
-sub get {
+sub canIAdd {
     my $self = shift;
-    my $d = domain_to_ascii(shift);
+    my @dn = @{ldap_explode_dn ($self->mail2dn(shift) // $self->whoami)};
+    my $user = lc (canonical_dn @dn);
+    shift @dn;
+    my $parent = lc (canonical_dn @dn);
     my %options = @_;
-    my $concat = $options{'-concat'};
-
-    my $attrs = $options{'-attrs'} //
-                    [ qw/fvd description
-                         fripostIsStatusActive
-                         fripostOptionalMaildrop
-                         fripostCanAddAlias
-                         fripostCanAddList
-                         fripostOwner
-                         fripostPostmaster/ ];
-
-    $attrs = [ '1.1' ] if $options{'-assert_exist'};
-
-    my $domains = $self->ldap->search(
-                      base => canonical_dn({fvd => $d}, @{$self->suffix}),
-                      scope => 'base',
-                      deref => 'never',
-                      filter => '(&(objectClass=FripostVirtualDomain)
-                                   (!(fripostPendingToken=*)))',
-                      attrs => $attrs
-                  );
-    if ($domains->code) {
-        die $options{'-die'}."\n" if defined $options{'-die'};
-        die $domains->error."\n";
-    }
 
-    # The following is not supposed to happen.
-    die "Error: Multiple matching entries found." if $domains->count > 1;
-    my $domain = $domains->pop_entry;
-    unless (defined $domain) {
-        die $options{'-die'}."\n" if defined $options{'-die'};
-        die "No such such domain: ‘$d’\n";
-    }
-    return if $options{'-assert_exist'};
-
-    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 ($_) }
-                                              $domain->get_value('fripostOptionalMaildrop'))
-           , permissions => get_perms($domain, $self->whoami)
-           , canAddAlias => concat($concat, map { &_email_to_unicode ($self->_dn2fvu($_)) }
-                                               $domain->get_value('fripostCanAddAlias'))
-           , canAddList => concat($concat, map { &_email_to_unicode ($self->_dn2fvu($_)) }
-                                              $domain->get_value('fripostCanAddList'))
-           )
+    # Nothing to do after an error.
+    return if $options{'-error'} && ${$options{'-error'}};
+
+    my $mesg = $self->ldap->search( base => canonical_dn(@{$self->suffix})
+                                  , scope => 'base'
+                                  , deref => 'never'
+                                  , filter => 'objectClass=FripostVirtual'
+                                  , attrs => [ 'fripostCanAddDomain' ]
+                                  );
+    ldap_error($mesg, %options) // return;
+
+    # If these are raised, something is seriously wrong.
+    die "Empty virtual directory?" unless $mesg->count;
+    die "Multiple virtual directories?" unless $mesg->count == 1;
+
+    my $base = $mesg->pop_entry // die "Empty virtual directory?";
+    scalar (grep { lc $_ eq $user  or lc $_ eq $parent }
+                 $base->get_value('fripostCanAddDomain'));
 }
 
 
-=item B<replace> (I<domain>, I<OPTIONS>)
 
-Replace an existing domain with the given one.
+=item B<list_admin_emails> (I<domainname>, I<OPTIONS>)
+
+Search for postmaster e-mail addresses for I<domainname>. For
+I<domainname> itself and each of its parents, this routine searches for
+a valid WHOIS containing e-mails, and lists postmaster@hostname (RFC
+822, appendix C.6) if hostname has a MX record and does not use ours
+yet.
+
+Errors can be caught with options B<-die> and B<-error>, see
+B<Fripost::Schema::Util> for details.
 
 =cut
 
-sub replace {
+sub list_admin_emails {
     my $self = shift;
-    my $d = shift;
+    my $domainname = shift;
     my %options = @_;
 
-    foreach (qw/description catchalls canAddAlias canAddList/) {
-        $d->{$_} = explode ($options{'-concat'}, $d->{$_})
-            if defined $d->{$_};
-    }
+    # Nothing to do after an error.
+    return if $options{'-error'} && ${$options{'-error'}};
 
-    eval {
-        &_is_valid($d);
-        my $dn = canonical_dn( {fvd => $d->{domain}}, @{$self->suffix} );
-        my $mesg = $self->ldap->modify( $dn,
-                       replace => { fripostIsStatusActive => $d->{isactive} ?
-                                        'TRUE' : 'FALSE'
-                                  , description => $d->{description}
-                                  , fripostOptionalMaildrop => $d->{catchalls}
-                                  , fripostCanAddAlias =>
-                                          [ map $self->_fvu2dn($_),
-                                                @{$d->{canAddAlias}} ]
-                                  , fripostCanAddList =>
-                                          [ map $self->_fvu2dn($_),
-                                                @{$d->{canAddList}} ]
-                   } );
-        die $mesg->error."\n" if $mesg->code;
-    };
-    return $@;
-}
-
-
-sub list_postmasters {
-    my $self = shift;
-    my $hostname = shift;
     my @postmasters;
-
-    my $tld = domain_to_ascii($hostname);
+    my $tld = domain_to_ascii($domainname);
     my $domain;
+
     until ( tld_exists($tld) ) {
-        die "‘".$hostname."’ has an Invalid TLD.\n" unless $tld =~ /\./;
+        softdie ("‘".$domainname."’ has an Invalid TLD.", %options) // return
+            unless $tld =~ /\./;
         $domain = $tld;
 
+        # Look for a valid MX record that is not ours.
         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);
@@ -206,153 +421,278 @@ sub list_postmasters {
         $tld =~ s/^[^\.]*\.//;
     }
 
+    # Look for e-mail addresses in the WHOIS.
     my $info = parse_whois( domain => $domain );
-    die "Cannot WHOIS ‘".$domain."’.\n" unless defined $info;
     if (defined $info) {
         push @postmasters, @{$info->{emails}};
     }
+    else {
+        softdie ("Cannot WHOIS ‘".$domain."’", %options);
+        return;
+    }
 
+    # Apply a unique sort on the list.
     my %hash;
-    $hash{$_} = 1 for grep {email_valid($_ // '', -nodie => 1 )}
-                           @postmasters;
+    $hash{$_} = 1 for grep {email_valid($_ // '', -nodie => 1 )} @postmasters;
     sort keys %hash;
 }
 
+
+
+=item B<add> (I<domain>, I<OPTIONS>)
+
+Add the domain I<domain>, represented by a hash reference as explained
+above. If no owner is specified in I<domain>, the current user is
+automatically promoted owner instead.
+
+The following options are considered:
+
+=over 4
+
+=item B<-append> => 0|1
+
+When I<domain>'s is already present, the default is to raise an error.
+This flag appends the attributes in the new I<domain> to the existing
+one (or replace the old values in case of single-valued attributes).
+
+=item B<-dry-run> => 0|1
+
+Merely simulate the insertion. I<domain> is still checked to be valid
+and, unless B<-append> is set, its name is ensured not to be present in
+the directory.
+
+=item B<-send-confirmation-token> => I<email>
+
+When set, this option locks down the domain before inserting it, and
+send a message to I<email> with the unlocking token.
+
+=item B<webapp_url>
+
+The URL to send, together with the token, to provide instructions how to
+unlock the domain.
+
+=item B<tmpl_path>
+
+Where to find the e-mail template with the instructions how to unlock
+the domain.
+
+=back
+
+Errors can be caught with options B<-die> and B<-error>, see
+B<Fripost::Schema::Util> for details.
+
+=cut
+
 sub add {
     my $self = shift;
-    my $d = shift;
+    my $domain = shift;
     my %options = @_;
 
-    foreach (qw/description catchalls canAddAlias canAddList/) {
-        $d->{$_} = explode ($options{'-concat'}, $d->{$_})
-            if defined $d->{$_};
+    # Nothing to do after an error.
+    return if $options{'-error'} && ${$options{'-error'}};
+
+    my $domainname = $domain->{name};
+    # Check domain validity.
+    &_is_valid($domain, %options) // return;
+    my $dn = $self->mail2dn( $domain->{name} );
+
+    # Search for an existing domain with the same name.
+    my $exists = $self->search($domain->{name}, %options, '-assert-exists' => 0);
+    softdie ( "Domain ‘".$domainname."’ already exists.", %options ) // return
+        if not $options{'-append'} and $exists;
+    # Stop here in dry-run mode.
+    return 1 if $options{'-dry-run'};
+
+    # Convert the domain into a LDAP entry, and remove keys to empty values.
+    my %attrs = $self->_domain_to_entry (%$domain);
+    Fripost::Schema::Util::clean_ldap_entry( \%attrs );
+
+    my ($mesg, $token);
+    if ($options{'-append'} and $exists) {
+        # Replace single valued attributes; Add other attributes.
+        my %unique = ( fripostIsStatusActive => $attrs{fripostIsStatusActive} );
+        delete $attrs{$_} for (keys %unique);
+        $mesg = $self->ldap->modify( $dn, replace => \%unique, add => \%attrs );
     }
-
-    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 => [ '1.1' ] );
-        if ($mesg->code == LDAP_SUCCESS) {
-            die "Domain ‘".$domain."’ already exists.\n";
+    else {
+        if ($options{'-send-confirmation-token'}) {
+            # Add the pending class, and generate a random token.
+            $attrs{objectClass} = [ qw/FripostVirtualDomain FripostPendingEntry/ ];
+            $token = String::Random::->new->randregex('\w{32}');
+            $attrs{fripostPendingToken} = $token;
         }
-        elsif ($mesg->code != LDAP_NO_SUCH_OBJECT) {
-            die $mesg->error."\n";
+        else {
+            $attrs{objectClass} = 'FripostVirtualDomain';
         }
+        # The default owner is the current user.
+        $attrs{fripostOwner} //= [ $self->whoami ];
+        $mesg = $self->ldap->add( $dn, attrs => [ %attrs ] );
+    }
 
-        return if $options{'-dry-run'};
+    ldap_error($mesg, %options) // return;
+    return 1 unless $options{'-send-confirmation-token'};
+
+    # Send token
+    email_valid ($options{'-send-confirmation-token'});
+    my $tt = Template->new({ INCLUDE_PATH => $options{tmpl_path}
+                           , INTERPOLATE  => 1 })
+                 or die $Template::ERROR;
+    my $vars = { domain => $domainname, token => $token };
+    $vars->{unlockurl} = $options{webapp_url}
+                          .encodeURIComponent($domainname)
+                          .'/?unlock='.$token
+        if defined $options{webapp_url};
+
+    my $data;
+    $tt->process( 'new-domain.tt', $vars, \$data) or die $tt->error;
+    Fripost::Schema::Mail::->new( From    => $options{email_from} //
+                                             $ENV{USER}.'@localhost'
+                                , To      => $options{'-send-confirmation-token'}
+                                , Subject => "Your new domain ".$domain->{name}
+                                , Data    => $data
+                                )->send;
+
+    1;
+}
 
-        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}};
+# Convert our representation of domains into a hash which keys are LDAP
+# attributes.
+sub _domain_to_entry {
+    my $self = shift;
+    my %domain = @_;
+    my %entry;
 
-        if (defined $d->{owner}) {
-            $attrs{fripostOwner} = $self->_fvu2dn($d->{owner})
-              if $d->{owner} ne '';
+    foreach my $key (keys %domain) {
+        if ($key eq 'name') {
+            # Its value is forced by the DN.
+        }
+        elsif ($key eq 'isActive') {
+            $entry{fripostIsStatusActive} = $domain{isActive} ? 'TRUE' : 'FALSE';
+        }
+        elsif ($key eq 'description') {
+            $entry{description} = $domain{description};
+        }
+        elsif ($key eq 'catchAlls') {
+            $entry{fripostOptionalMaildrop} = $domain{catchAlls};
+        }
+        elsif ($key eq 'canAddAlias') {
+            $entry{fripostCanAddAlias} =
+                [ map { $self->mail2dn($_) } @{$domain{canAddAlias}} ];
+        }
+        elsif ($key eq 'canAddList') {
+            $entry{fripostCanAddList} =
+                [ map { $self->mail2dn($_) } @{$domain{canAddList}} ];
+        }
+        elsif ($key eq 'owner') {
+            $entry{fripostOwner} =
+                [ map { $self->mail2dn($_) } @{$domain{owner}} ];
+        }
+        elsif ($key eq 'postmaster') {
+            $entry{fripostPostmaster} =
+                [ map { $self->mail2dn($_) } @{$domain{postmaster}} ];
         }
         else {
-            $attrs{fripostOwner} = $self->whoami;
+            die "Missing translation for domain key ‘".$key."’.";
         }
+    }
+    return %entry;
+}
 
-        my $token;
-        if (defined $d->{send_token_to}) {
-            $token = String::Random::->new->randregex('\w{32}');
-            $attrs{fripostPendingToken} = $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->sign( Signature => 'The Fripost administration team.');
-            $mail->send;
-        }
 
-    };
-    return $@;
-}
+=item B<unlock> (I<domainname>, I<token>, I<OPTIONS>)
+
+Unlock the pending domain I<domainname>, locked with I<token>.
+
+Errors can be caught with options B<-die> and B<-error>, see
+B<Fripost::Schema::Util> for details.
+
+=cut
+
 
 sub unlock {
     my $self = shift;
-    my $d = shift;
+    my $domainname = shift;
     my $token = shift;
+    my %options = @_;
+
+    # Nothing to do after an error.
+    return if $options{'-error'} && ${$options{'-error'}};
 
-    my $dn = canonical_dn({fvd => domain_to_ascii($d)}, @{$self->suffix});
+    my $dn = $self->mail2dn( $domainname );
     my $mesg = $self->ldap->compare( $dn
                                    , attr => 'fripostPendingToken'
                                    , value => $token );
-    die "Wrong unlock code for ‘".$d."’\n"
-        unless $mesg->code eq LDAP_COMPARE_TRUE;
-
-    $mesg = $self->ldap->modify( $dn, delete => 'fripostPendingToken' );
-    die $mesg->error."\n" if $mesg->code;
+    my $catch = { Net::LDAP::Constant::LDAP_COMPARE_TRUE => 0
+                , Net::LDAP::Constant::LDAP_COMPARE_FALSE =>
+                    "Wrong unlock code for ‘".$domainname."’"
+                };
+    ldap_error($mesg, %options, -die => $catch) // return;
+
+    $mesg = $self->ldap->modify( $dn,
+                delete => { 'objectClass' => 'FripostPendingEntry'
+                          , 'fripostPendingToken' => []
+                          });
+    ldap_error($mesg, %options);
 }
 
 
-=back
 
-=head1 GLOBAL OPTIONS
 
-If the B<-concat> option is present, it will intersperse multi-valued
-attributes. Otherwise, an array reference containing every values will
-be returned for these attributes.
 
-The B<-die> option, if present, overides LDAP croaks and errors.
+
+=item B<replace> (I<domain>, I<OPTIONS>)
+
+Replace an existing domain with the given one.
+
+Errors can be caught with options B<-die> and B<-error>, see
+B<Fripost::Schema::Util> for details.
 
 =cut
 
+sub replace {
+    my $self = shift;
+    my $domain = shift;
+    my %options = @_;
+
+    # Nothing to do after an error.
+    return if $options{'-error'} && ${$options{'-error'}};
+
+    &_is_valid($domain, %options);
+    my %entry = $self->_domain_to_entry (%$domain);
+    my $mesg = $self->ldap->modify( $self->mail2dn($domain->{name})
+                                  , replace => \%entry );
+    ldap_error($mesg, %options);
+}
+
 
 
 # Ensure that the given domain is valid.
 sub _is_valid {
     my $d = shift;
-    must_attrs( $d, qw/domain isactive/ );
-    $d->{domain} = email_valid( $d->{domain}, -prefix => 'fake@',
+    my %options = @_;
+    eval {
+        must_attrs( $d, qw/name isActive/ );
+        $d->{name} = email_valid( $d->{name}, -prefix => 'fake@',
                                               -error => 'Invalid domain',
                                               -exact => 1 );
-    $d->{catchalls} = [ map { email_valid($_, -prefix => 'fake') }
-                            @{$d->{catchalls}} ];
-    $d->{canAddAlias} = [ map { email_valid($_, -prefix => 'fake') }
-                                 @{$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};
+        $d->{catchAlls} = [ map { email_valid($_, -prefix => 'fake') }
+                                @{$d->{catchAlls}} ]
+                if $d->{catchAlls};
+        $d->{canAddAlias} = [ map { email_valid($_, -prefix => 'fake') }
+                                     @{$d->{canAddAlias}} ]
+                if $d->{canAddAlias};
+        $d->{canAddList} = [ map { email_valid($_, -prefix => 'fake') }
+                                    @{$d->{canAddList}} ]
+                if $d->{canAddList};
+        $d->{owner} = [ map { email_valid($_, -prefix => 'fake') }
+                                    @{$d->{postmaster}} ]
+                if $d->{postmaster};
+        $d->{postmaster} = [ map { email_valid($_, -prefix => 'fake') }
+                                    @{$d->{postmaster}} ]
+                if $d->{postmaster};
+    };
+    softdie ($@, %options);
 }
 
 
@@ -363,6 +703,7 @@ sub _email_to_unicode {
     return email_to_unicode($email);
 }
 
+=back
 
 =head1 AUTHOR
 
diff --git a/lib/Fripost/Schema/Mail.pm b/lib/Fripost/Schema/Mail.pm
new file mode 100644
index 0000000..309dad8
--- /dev/null
+++ b/lib/Fripost/Schema/Mail.pm
@@ -0,0 +1,58 @@
+package Fripost::Schema::Mail;
+
+=head1 NAME
+
+Mail.pm - Send clear, signed or encrypted e-mails.
+
+=head1 DESCRIPTION
+
+This module is adds GnuPG signing on top of MIME::Lite. Most of the
+code comes from Mail::GnuPG.
+
+=cut
+
+use 5.010_000;
+use strict;
+use warnings;
+use utf8;
+
+use MIME::Lite;
+
+sub new {
+    my $class = shift;
+    my $self = bless {}, $class;
+    my %msg = @_;
+
+    $msg{Encoding} //= 'quoted-printable';
+    $msg{Charset}  //= 'utf-8';
+
+    $self->{_msg} = MIME::Lite->new(@_);
+    return $self;
+}
+
+sub send {
+    my $self = shift;
+    print STDERR $self->{_msg}->as_string;
+    $self->{_msg}->send;
+}
+
+=back
+
+=head1 AUTHOR
+
+Guilhem Moulin C<< <guilhem at fripost.org> >>
+
+=head1 COPYRIGHT
+
+Copyright 2013 Guilhem Moulin.
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as perl itself.
+
+=cut
+
+1;
+
+__END__
diff --git a/lib/Fripost/Schema/Util.pm b/lib/Fripost/Schema/Util.pm
index 0f6821c..2c71411 100644
--- a/lib/Fripost/Schema/Util.pm
+++ b/lib/Fripost/Schema/Util.pm
@@ -13,11 +13,12 @@ use utf8;
 
 use Exporter 'import';
 our @EXPORT_OK = qw /concat get_perms explode
-                     must_attrs email_valid split_addr
-                     canonical_dn ldap_explode_dn ldap_error
+                     must_attrs email_valid split_addr dn2mail
+                     canonical_dn ldap_explode_dn ldap_error ldap_and_filter
+                     clean_ldap_entry
                      assert softdie/;
 use Email::Valid;
-use Net::IDN::Encode;
+use Net::IDN::Encode qw/domain_to_unicode email_to_unicode/;
 use Net::LDAP::Util;
 use Encode;
 
@@ -139,20 +140,24 @@ sub split_addr {
     my $addr = shift;
     my %options = @_;
 
+    $addr =~ /^(.*)\@([^@]+)$/s;
+    my ($l,$d) = ($1, $2);
+
     if (defined $options{'-encode'}) {
         my $e = $options{'-encode'};
         if ($e eq 'ascii') {
-            $addr = Net::IDN::Encode::email_to_ascii($addr);
+            Encode::_utf8_on($d);
+            $addr = Net::IDN::Encode::domain_to_ascii($d);
         }
         elsif ($e eq 'unicode') {
-            $addr = Net::IDN::Encode::email_to_unicode($addr);
+            $d = Net::IDN::Encode::domain_to_unicode($d);
         }
         else {
-            die "Unknown encoding: ". $e;
+            softdie ("Unknown encoding: ". $e, %options);
+            return;
         }
     }
-
-    split /\@/, $addr, 2;
+    return ($l,$d);
 }
 
 sub ldap_error {
@@ -180,8 +185,7 @@ sub ldap_error {
         $error = $mesg->error if $mesg->code;
     }
 
-    return $mesg unless defined $error;
-    return unless $error;
+    return 1 unless $error;
 
     if (defined $options{'-error'}) {
         ${$options{'-error'}} = $error;
@@ -210,10 +214,50 @@ sub softdie {
     my $mesg = shift;
     my %options = @_;
 
+    return 1 unless $mesg;
     $options{'-die'} = $mesg;
     &assert (undef, %options);
 }
 
+sub dn2mail {
+    my $dn = ldap_explode_dn(shift);
+
+    return '@'. domain_to_unicode(lc $dn->[0]->{fvd})
+        if exists $dn->[0]->{fvd};
+    return email_to_unicode(lc $dn->[0]->{fvl} .'@'. lc $dn->[1]->{fvd});
+}
+
+sub ldap_and_filter {
+    my @filters = @_;
+
+    if ($#filters == 0) {
+        return $filters[0];
+    }
+    else {
+        @filters = map {'('.$_.')'} @filters;
+        return '(&'.(join '', @filters).')';
+    }
+}
+
+
+sub clean_ldap_entry {
+    my $attrs = shift;
+
+    foreach (keys %$attrs) {
+        if (defined $attrs->{$_}) {
+            if (ref $attrs->{$_} eq 'ARRAY') {
+                delete $attrs->{$_} unless @{$attrs->{$_}}
+            }
+            elsif (ref $attrs->{$_} eq '') {
+                delete $attrs->{$_} if $attrs->{$_} eq '';
+            }
+        }
+        else {
+            delete $attrs->{$_};
+        }
+    }
+}
+
 =head1 AUTHOR
 
 Guilhem Moulin C<< <guilhem at fripost.org> >>