More secure way to check unlock tokens.

4 files changed, 62 insertions, 49 deletions

diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm
index e4724d1..cc7545a 100644
--- a/lib/Fripost/Panel/Interface.pm
+++ b/lib/Fripost/Panel/Interface.pm
@@ -66,8 +66,9 @@ sub ListLocals : Runmode {
     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') );
+    if (defined $q->param('unlock')) {
+        $fp->domain->unlock( $d, $q->param('unlock') )
+            if $q->param('unlock') ne '';
         $fp->done;
         return $self->redirect('../');
     }
@@ -224,6 +225,7 @@ sub EditLocal : Runmode {
 
     # Search for *the* matching user, alias or list.
     my ($d,$l) = ($self->split_path)[1,2];
+    $fp->domain->get ($d, -die => 404, -attrs => []);
     my %local = $fp->local->get ($l.'@'.$d, -die => 404,
                                             -concat => "\x{0D}\x{0A}" );
     die "Unknown type" unless grep { $local{type} eq $_ }
@@ -486,6 +488,7 @@ sub AddLocal : Runmode {
 
         unless ($error) {
             my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
+            $fp->domain->get ($d, -die => 404, -attrs => []);
             $error = $fp->$t->add( \%entry, -concat => "(\n|\x{0D}\x{0A})", %rest);
             $fp->done;
             return $self->redirect('./') unless $error;
diff --git a/lib/Fripost/Panel/Login.pm b/lib/Fripost/Panel/Login.pm
index b0906b3..e0ee02f 100644
--- a/lib/Fripost/Panel/Login.pm
+++ b/lib/Fripost/Panel/Login.pm
@@ -192,7 +192,7 @@ sub error_rm : ErrorRunmode {
     my $self = shift;
     my $error = shift;
 
-    if ($error =~ /^4\d+$/) {
+    if ($error =~ /^\d+$/) {
         # HTTP client error.
         chomp $error;
         $self->header_props ( -status => $error );
@@ -213,7 +213,7 @@ sub error_rm : ErrorRunmode {
         # Users are not supposed to see that unless the CGI crashes :P
         my $template = $self->load_tmpl( 'error.html', cache => 1 );
         $template->param( email => $self->cfg('report_email') );
-        $template->param( message => $error );
+        $template->param( message => encode_entities ($error) );
         $template->param( url => $self->query->url . '/');
         return $template->output;
     }
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