New domains.

5 files changed, 201 insertions, 38 deletions

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;
 }