diff options
Diffstat (limited to 'lib/Fripost/Schema/Domain.pm')
| -rw-r--r-- | lib/Fripost/Schema/Domain.pm | 143 |
1 files changed, 63 insertions, 80 deletions
diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm index 4cc12e4..f819348 100644 --- a/lib/Fripost/Schema/Domain.pm +++ b/lib/Fripost/Schema/Domain.pm @@ -17,10 +17,10 @@ use warnings; use utf8; use parent 'Fripost::Schema'; +use Fripost::Schema::Mail; use Fripost::Schema::Util qw/softdie dn2mail email_valid domain_valid canonical_dn ldap_explode_dn ldap_error - ldap_assert_absent/; -use Fripost::Schema::Mail; + ldap_assert_absent escape_filter_nostar/; use Net::IDN::Encode qw/domain_to_ascii domain_to_unicode email_to_unicode/; use URI::Escape::XS 'encodeURIComponent'; use Encode (); @@ -58,14 +58,14 @@ a new domain, unless the user is asking for a confirmation token. An optional array reference containing the (internationalized) e-mails addresses of users that have permission to create aliases (other than -domain owner or postmaster) under this domain. The local part may be +domain owners or postmasters) under this domain. The local part may be left empty to grant permissions to a whole domain. =item B<canAddList> An optional array reference containing the (internationalized) e-mails addresses of users that have permission to create mailing lists (other -than domain owner or postmaster) under this domain. The local part may +than domain owners or postmasters) under this domain. The local part may be left empty to grant permissions to a whole domain. =item B<owner> @@ -133,15 +133,13 @@ context, only the first domain found is returned. In void context, no attributes are returned from the LDAP server, but it may nevertheless be useful, to ensure that the result set is not empty for instance. -The following options are considered: - =over 4 -=item B<-no-escape> => 0|1 +=item B<-no-star-escape> => 0|1 By default, I<domainname> - when defined - is safely escaped before -insertion into the LDAP filter. This flag disables escaping. It is -useful if I<domainname> contains wildcards for instance. +insertion into the LDAP filter. When set, this flag disables escaping of +wildcards (*) in I<domainname>. =item B<-filter> => locked|unlocked @@ -158,7 +156,7 @@ is set to [] that is, no attribute is sent back to the client. =item B<-count> => 0|1 Return the number of entries in the result set. When set, the B<-keys> -option is bypassed not to ask any attribute from the server. +option is bypassed not to ask any attribute to the server. =item B<-sort> => 0|1 @@ -166,7 +164,7 @@ In list context, sort the results per domain name. =back -Errors can be caught with options B<-die> and B<-error>, see +Errors can be caught with options B<-die> and B<-error>; See B<Fripost::Schema::Util> for details. =cut @@ -183,8 +181,9 @@ sub search { if ($domainname) { my $d = domain_to_ascii($domainname); - $d = Net::LDAP::Util::escape_filter_value($d) - unless $options{'-no-escape'}; + $d = $options{'-no-star-escape'} ? + escape_filter_nostar $d : + Net::LDAP::Util::escape_filter_value $d; push @filters, 'fvd='.$d; } @@ -348,7 +347,7 @@ Returns 0 or 1, depending on whether or not I<username> has permission to add new domains. If I<username> is undefined, the current user is considered instead. -Errors can be caught with options B<-die> and B<-error>, see +Errors can be caught with options B<-die> and B<-error>; See B<Fripost::Schema::Util> for details. =cut @@ -393,7 +392,17 @@ for a valid WHOIS containing e-mails, and lists postmaster@hostname (RFC 822, appendix C.6) if hostname has a MX record and does not use ours yet. -Errors can be caught with options B<-die> and B<-error>, see +=over 4 + +=item B<ignore-MX> + +An array reference containing hostnames for which no postmaster will be +listed. (Typically, the host we control, since email will then not reach +end users.) Note that subdomains are automatically blacklisted. + +=back + +Errors can be caught with options B<-die> and B<-error>; See B<Fripost::Schema::Util> for details. =cut @@ -418,7 +427,13 @@ sub list_owner_emails { # Look for a valid MX record that is not ours. my %mx = Net::DNS::Dig->new()->for( $domain, 'MX' )->rdata; push @postmasters, 'postmaster@'.$domain # RFC 822, appendix C.6 - if grep {!/\bfripost\.org$/} (values %mx); + unless !$options{'-ignore-MX'} or + grep { my ($mx, $ok) = ($_, 0); + foreach (@{$options{'-ignore-MX'}}) { + if ($mx =~ /\b\Q$_\E$/) { $ok = 1; last }; + } + $ok; + } (values %mx); $tld =~ s/^[^\.]*\.//; } @@ -436,7 +451,7 @@ sub list_owner_emails { # Apply a unique sort on the list. my %hash; $hash{$_} = 1 for grep {email_valid($_ // '', -nodie => 1 )} @postmasters; - sort keys %hash; + map {email_to_unicode $_} (sort keys %hash); } @@ -448,8 +463,6 @@ owner is specified in I<domain>, the current user is automatically promoted owner. (If you you want to add a non self-managed domain, choose an empty string for the owner.) -The following options are considered: - =over 4 =item B<-append> => 0|1 @@ -481,7 +494,7 @@ the domain. =back -Errors can be caught with options B<-die> and B<-error>, see +Errors can be caught with options B<-die> and B<-error>; See B<Fripost::Schema::Util> for details. =cut @@ -615,91 +628,62 @@ sub _domain_to_entry { -=item B<unlock> (I<domainname>, I<token>, I<OPTIONS>) - -Unlock the pending I<domainname>, locked with I<token>. +=item B<replace> (I<domain>, I<OPTIONS>) -The following options are considered: +Replace an existing domain with the given one. =over 4 =item B<-dry-run> => 0|1 -Merely simulate the unlock. I<token> is still checked to be a valid code. +Merely simulate the replacement. I<domain> is still checked to be a +valid domain in the above representation. =back -Errors can be caught with options B<-die> and B<-error>, see +Errors can be caught with options B<-die> and B<-error>; See B<Fripost::Schema::Util> for details. =cut - -sub unlock { +sub replace { my $self = shift; - my $domainname = domain_to_ascii(shift); - my $token = shift; + my $domain = shift; my %options = @_; # Nothing to do after an error. return if $options{'-error'} && ${$options{'-error'}}; - my $dn = $self->mail2dn( $domainname ); - my $mesg = $self->ldap->compare( $dn - , attr => 'fripostPendingToken' - , value => $token ); - my $catch = { Net::LDAP::Constant::LDAP_COMPARE_TRUE => 0 - , Net::LDAP::Constant::LDAP_COMPARE_FALSE => - "Wrong unlock code for ‘".$domainname."’" - }; - ldap_error($mesg, %options, -die => $catch) // return; + # Check domain validity. + &_assert_valid($domain, %options, -replace => 1) // return; return 1 if $options{'-dry-run'}; - $mesg = $self->ldap->modify( $dn, - delete => { 'objectClass' => 'FripostPendingEntry' - , 'fripostPendingToken' => [] - }); + my %entry = $self->_domain_to_entry (%$domain); + my $mesg = $self->ldap->modify( $self->mail2dn($domain->{name}) + , replace => \%entry ); ldap_error($mesg, %options); } +=item B<delete> (I<domainname>, I<OPTIONS>) +Delete the given I<domainname>. - -=item B<replace> (I<domain>, I<OPTIONS>) - -Replace an existing domain with the given one. - -=over 4 - -=item B<-dry-run> => 0|1 - -Merely simulate the replacement. I<domain> is still checked to be a -valid domain in the above representation. - -=back - -Errors can be caught with options B<-die> and B<-error>, see +Errors can be caught with options B<-die> and B<-error>; See B<Fripost::Schema::Util> for details. =cut -sub replace { +sub delete { my $self = shift; - my $domain = shift; + my $domainname = shift; my %options = @_; # Nothing to do after an error. return if $options{'-error'} && ${$options{'-error'}}; - # Check domain validity. - &_assert_valid($domain, %options, -replace => 1) // return; - return 1 if $options{'-dry-run'}; - - my %entry = $self->_domain_to_entry (%$domain); - my $mesg = $self->ldap->modify( $self->mail2dn($domain->{name}) - , replace => \%entry ); + my $mesg = $self->ldap->delete( $self->mail2dn($domainname) ); ldap_error($mesg, %options); } @@ -710,23 +694,22 @@ sub _assert_valid { my $d = shift; my %options = @_; eval { - Fripost::Schema::Util::must_attrs( $d, qw/name isActive/ ) - unless $options{'-append'} or $options{'-replace'}; - $d->{name} = domain_valid( domain_to_ascii ($d->{name}) ); - $d->{catchAll} = [ map { email_valid($_, -prefix => 'fake') } - @{$d->{catchAll}} ] + Fripost::Schema::Util::mandatory_attrs( $d, 'name' ); + $d->{isActive} //= 1 unless $options{'-append'} or $options{'-replace'}; + + $d->{name} = domain_valid( $d->{name} ); + $d->{catchAll} = [ map { email_valid($_, '-allow-empty-local' => 1) } + @{$d->{catchAll}} ] if $d->{catchAll}; - $d->{canAddAlias} = [ map { email_valid($_, -prefix => 'fake') } - @{$d->{canAddAlias}} ] + $d->{canAddAlias} = [ map { email_valid($_, '-allow-empty-local' => 1) } + @{$d->{canAddAlias}} ] if $d->{canAddAlias}; - $d->{canAddList} = [ map { email_valid($_, -prefix => 'fake') } - @{$d->{canAddList}} ] + $d->{canAddList} = [ map { email_valid($_, '-allow-empty-local' => 1) } + @{$d->{canAddList}} ] if $d->{canAddList}; - $d->{owner} = [ map { email_valid($_, -prefix => 'fake') } - @{$d->{owner}} ] + $d->{owner} = [ map { email_valid($_) } @{$d->{owner}} ] if $d->{owner}; - $d->{postmaster} = [ map { email_valid($_, -prefix => 'fake') } - @{$d->{postmaster}} ] + $d->{postmaster} = [ map { email_valid($_) } @{$d->{postmaster}} ] if $d->{postmaster}; }; softdie ($@, %options); |