More secure way to check unlock tokens.

2 files changed, 55 insertions, 45 deletions

diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm
index 993d771..56e9737 100644
--- a/lib/Fripost/Schema/Domain.pm
+++ b/lib/Fripost/Schema/Domain.pm
@@ -17,6 +17,7 @@ use warnings;
 use utf8;
 
 use parent 'Fripost::Schema';
+use Net::LDAP qw/LDAP_SUCCESS LDAP_COMPARE_TRUE/;
 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
@@ -44,23 +45,45 @@ references, sorted by domain names.
 sub search {
     my $self = shift;
     my %options = @_;
+
     my $concat = $options{'-concat'};
+    my $filter = '(objectClass=FripostVirtualDomain)';
+
+    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=*))';
+        }
+        elsif ($options{'-filter'} eq 'nonlocked') {
+            $filter = '(&'.$filter.'(!(fripostPendingToken=*)))';
+        }
+        else {
+            die "Unknown filter: ".$options{'-filter'}."\n";
+        }
+    }
+    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);
+    }
 
     my $domains = $self->ldap->search(
                       base => canonical_dn(@{$self->suffix}),
                       scope => 'one',
                       deref => 'never',
-                      filter => 'objectClass=FripostVirtualDomain',
-                      attrs => [ qw/fvd description fripostIsStatusActive
-                                    fripostIsStatusPending/ ]
+                      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'
-                 , ispending => defined $_->get_value('fripostIsStatusPending')
                  , description => concat($concat, $_->get_value('description'))
                  }
                }
@@ -70,7 +93,8 @@ sub search {
 
 =item B<get> (I<domain>, I<OPTIONS>)
 
-Returns a hash with all the (visible) attributes for the given domain.
+Returns a hash with all the (visible) attributes for the given
+*non-pending* domain.
 
 =cut
 
@@ -80,18 +104,22 @@ sub get {
     my %options = @_;
     my $concat = $options{'-concat'};
 
+    my $attrs = $options{'-attrs'} //
+                    [ qw/fvd description
+                         fripostIsStatusActive
+                         fripostOptionalMaildrop
+                         fripostCanAddAlias
+                         fripostCanAddList
+                         fripostOwner
+                         fripostPostmaster/ ];
+
     my $domains = $self->ldap->search(
                       base => canonical_dn({fvd => $d}, @{$self->suffix}),
                       scope => 'base',
                       deref => 'never',
-                      filter => 'objectClass=FripostVirtualDomain',
-                      attrs => [ qw/fvd description
-                                    fripostIsStatusActive
-                                    fripostOptionalMaildrop
-                                    fripostCanAddAlias
-                                    fripostCanAddList
-                                    fripostOwner
-                                    fripostPostmaster/ ]
+                      filter => '(&(objectClass=FripostVirtualDomain)
+                                   (!(fripostPendingToken=*)))',
+                      attrs => $attrs
                   );
     if ($domains->code) {
         die $options{'-die'}."\n" if defined $options{'-die'};
@@ -176,8 +204,7 @@ sub list_postmasters {
     }
 
     my $info = parse_whois( domain => $domain );
-#    die "Cannot WHOIS ‘".$domain."’.\n" unless defined $info;
-    # TODO: there is a bug with the encoding
+    die "Cannot WHOIS ‘".$domain."’.\n" unless defined $info;
     if (defined $info) {
         push @postmasters, @{$info->{emails}};
     }
@@ -211,7 +238,7 @@ sub add {
                        deref => 'never',
                        filter => 'objectClass=FripostVirtualDomain',
                        attrs => [] );
-        if ($mesg->code == 0) {
+        if ($mesg->code == LDAP_SUCCESS) {
             die "Domain ‘".$domain."’ already exists.\n";
         }
         elsif ($mesg->code != 32) {
@@ -240,7 +267,7 @@ sub add {
         my $token;
         if (defined $d->{send_token_to}) {
             $token = String::Random::->new->randregex('\w{32}');
-            $attrs{fripostIsStatusPending} = $token
+            $attrs{fripostPendingToken} = $token
         }
 
         $mesg = $self->ldap->add( $dn, attrs => [ %attrs ] );
@@ -268,6 +295,7 @@ sub add {
               Charset  => 'utf-8',
               Data     => $data
             );
+            $mail->sign( Signature => 'The Fripost administration team.');
             $mail->send;
         }
 
@@ -278,34 +306,17 @@ sub add {
 sub unlock {
     my $self = shift;
     my $d = shift;
-    my $code = shift;
+    my $token = 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 $@;
+    my $dn = canonical_dn({fvd => domain_to_ascii($d)}, @{$self->suffix});
+    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;
 }
 
 
diff --git a/lib/Fripost/Schema/Local.pm b/lib/Fripost/Schema/Local.pm
index c342f23..51cac34 100644
--- a/lib/Fripost/Schema/Local.pm
+++ b/lib/Fripost/Schema/Local.pm
@@ -51,7 +51,6 @@ sub get {
                                   (&(objectClass=FripostVirtualList)(fvl=$l)))",
                      attrs => [ qw/fvu description
                                    fripostIsStatusActive
-                                   fripostIsStatusPending
                                    fripostOptionalMaildrop
                                    fripostUserQuota
                                    fva fripostMaildrop