aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Fripost')
-rw-r--r--lib/Fripost/Panel/Interface.pm7
-rw-r--r--lib/Fripost/Panel/Login.pm4
-rw-r--r--lib/Fripost/Schema/Domain.pm99
-rw-r--r--lib/Fripost/Schema/Local.pm1
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