diff options
Diffstat (limited to 'lib/Fripost')
| -rw-r--r-- | lib/Fripost/Panel/Interface.pm | 7 | ||||
| -rw-r--r-- | lib/Fripost/Panel/Login.pm | 4 | ||||
| -rw-r--r-- | lib/Fripost/Schema/Domain.pm | 99 | ||||
| -rw-r--r-- | lib/Fripost/Schema/Local.pm | 1 |
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 |