From 6ebe4849dd75ec01197bf465ea20b6aa74e770a1 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Mon, 21 Jan 2013 05:23:51 +0100 Subject: More secure way to check unlock tokens. --- lib/Fripost/Schema/Domain.pm | 99 ++++++++++++++++++++++++-------------------- lib/Fripost/Schema/Local.pm | 1 - 2 files changed, 55 insertions(+), 45 deletions(-) (limited to 'lib/Fripost/Schema') 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 (I, I) -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 -- cgit v1.2.3