aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost/Schema
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Fripost/Schema')
-rw-r--r--lib/Fripost/Schema/Domain.pm22
-rw-r--r--lib/Fripost/Schema/Local.pm312
-rw-r--r--lib/Fripost/Schema/Util.pm2
3 files changed, 319 insertions, 17 deletions
diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm
index 6ed22b6..3caffb5 100644
--- a/lib/Fripost/Schema/Domain.pm
+++ b/lib/Fripost/Schema/Domain.pm
@@ -2,7 +2,7 @@ package Fripost::Schema::Domain;
=head1 NAME
-Domain.pm - Domain related methods in the Fripost Schema
+Domain.pm - Domainpart related methods for the Fripost Schema
=head1 DESCRIPTION
@@ -31,7 +31,7 @@ use Template;
=head1 REPRESENTATION
-Domains are imported and exported as hash references, having the
+Domains are imported and exported as hash references, with the
following keys:
=over 4
@@ -44,6 +44,10 @@ A UTF-8 string representing the (internationalized) domain name.
Whether or not the domain is active.
+=item B<description>
+
+An array reference containing UTF-8 strings describing the domain.
+
=item B<isPending> => 0|1
Whether or not the domain is pending. This is key is ignored when adding
@@ -79,10 +83,6 @@ An optional array reference containing the (internationalized)
catch-alls for that domain. Localparts may be left empty for domain
aliases.
-=item B<description>
-
-An array reference containing UTF-8 string representing that domain.
-
=item B<permissions>
An optional string representing the permission of the current user
@@ -154,10 +154,10 @@ current user to read or even search anything, though. The default is to
retrieve every visible attribute, unless in void context where B<-keys>
is set to [] that is, no attribute is sent back to the client.
-=item B<-count>
+=item B<-count> => 0|1
-Returns the number of entries in the result set. The B<-keys> option is
-bypassed not to ask any attribute from the server.
+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.
=item B<-sort> => 0|1
@@ -285,9 +285,7 @@ sub _entries_to_domains {
}
# Add a 'permissions' key if wanted.
- if ((not @$keys or grep { $_ eq 'permissions' } @$keys) and
- grep { $entry->exists($_) } qw/fripostCanAddAlias fripostCanAddList
- fripostOwner fripostPostmaster/) {
+ if ((not @$keys or grep { $_ eq 'permissions' } @$keys)) {
my $perms = '';
$perms .= 'a' if $entry->exists('fripostCanAddAlias') and
grep { $user eq lc $_ or $parent eq lc $_ }
diff --git a/lib/Fripost/Schema/Local.pm b/lib/Fripost/Schema/Local.pm
index 7a1ae22..1f09f66 100644
--- a/lib/Fripost/Schema/Local.pm
+++ b/lib/Fripost/Schema/Local.pm
@@ -2,12 +2,12 @@ package Fripost::Schema::Local;
=head1 NAME
-Local.pm -
+Local.pm - Localpart related method for the Fripost Schema
=head1 DESCRIPTION
-Local.pm abstracts the LDAP schema definition and provides methods to
-search for virtual users, aliases or lists alltogether.
+This module abstracts the LDAP schema definition and provides methods to
+add, list or delete virtual users, aliases or lists.
=cut
@@ -17,11 +17,315 @@ use warnings;
use utf8;
use parent 'Fripost::Schema';
-use Fripost::Schema::Util qw/concat split_addr canonical_dn/;
+use Fripost::Schema::Util qw/concat split_addr canonical_dn
+ ldap_error dn2mail/;
use Net::IDN::Encode qw/email_to_ascii email_to_unicode/;
use Net::LDAP::Util 'escape_filter_value';
+=head1 REPRESENTATION
+
+Virtual users, aliases and lists are imported and exported as hash
+references, with the following keys:
+
+=over 4
+
+=item B<name>
+
+A UTF-8 string representing the (internationalized) e-mail address for
+the user, alias or list.
+
+=item B<type> => user|alias|list
+
+The type of the entry.
+
+=item B<isActive> => 0|1
+
+Whether or not the entry is active.
+
+=item B<description>
+
+An array reference containing UTF-8 strings describing the entry.
+
+=item B<isPending> => 0|1
+
+(List only) Whether or not the entry is pending. New lists are always
+marked as pending, and it is up to the list manager's side to unlock
+them.
+
+=item B<quota>
+
+(User only) A string e.g., C<100 MB> representing the current quota on
+the user's mailboxes.
+
+=item B<owner>
+
+(Alias and list only) An optional array reference containing the
+(internationalized) e-mails addresses of the entry owners.
+
+=item B<forward>
+
+(User only) An optional array reference containing a (internationalized)
+e-mails addresses that will also receive every single message sent to
+that user.
+
+=item B<destination>
+
+(Alias only) An array reference containing a (internationalized) e-mails
+addresses that will receive messages sent to that alias.
+
+=item B<transport> mailman|schleuder
+
+(List only) The list manager associated with list entries.
+
+
+=head1 METHODS
+
+=over 4
+
+=item B<search> (I<name>, I<OPTIONS>)
+
+Search for I<name>, or list all the known (and visible) users, aliases
+and lists when I<name> is not defined. If I<name> does not contain a '@'
+symbol, it is interpreted as a domain name, which limits the scope of
+that search. In list context, return a list of entries represented as
+hash references, as explained above. In scalar context, only the first
+entry 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
+
+By default, the local and domain parts of I<name> - when defined - are
+safely escaped before insertion into the LDAP DN and filter. This flag
+disables escaping. It is useful if I<name> contains wildcards for
+instance. Note that in case the domain part contains wildcard, this
+method will query the LDAP server for every single matching domain.
+
+=item B<-filter> => locked|unlocked
+
+Limit the search scope to pending / non-pending entries only.
+
+=item B<-type> => user|alias|list
+
+Limit the search scope to the given entry type.
+
+=item B<-keys>
+
+An array reference containing the attributes that are to be retrived
+from the LDAP server. Note that Access Control List may prevent the
+current user to read or even search anything, though. The default is to
+retrieve every visible attribute, unless in void context where B<-keys>
+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.
+
+=item B<-sort> => 0|1
+
+In list context, sort the results per localpart.
+
+=back
+
+Errors can be caught with options B<-die> and B<-error>, see
+B<Fripost::Schema::Util> for details.
+
+=cut
+
+sub search {
+ my $self = shift;
+ my $in = shift;
+ my %options = @_;
+
+ # Nothing to do after an error.
+ return if $options{'-error'} && ${$options{'-error'}};
+
+ # If there is not '@', we interpret $in as a domain name.
+ $in =~ s/^([^\@]+)$/\@$1/;
+ my ($localname, $domainname) = split_addr($in);
+
+ my @filters;
+ if (defined $options{'-type'}) {
+ # Limit the scope to the given type.
+ if ($options{'-type'} eq 'user') {
+ push @filters, 'objectClass=FripostVirtualUser';
+ }
+ elsif ($options{'-type'} eq 'alias') {
+ push @filters, 'objectClass=FripostVirtualAlias';
+ }
+ elsif ($options{'-type'} eq 'list') {
+ push @filters, 'objectClass=FripostVirtualList';
+ }
+ }
+ else {
+ push @filters, '(|(objectClass=FripostVirtualUser)'.
+ '(objectClass=FripostVirtualAlias)'.
+ '(objectClass=FripostVirtualList))';
+ }
+
+ my @domainnames;
+ if ($domainname) {
+ if ($options{'-no-escape'} and $domainname =~ /\*/) {
+ # If the domain part contains a wildcard, we have to query
+ # the LDAP server to list the matching domains.
+ my %opts = ( '-no-escape' => 1, -keys => [ 'name' ]) ;
+ $opts{'-filter'} = 'unlocked';
+ foreach (qw/-filter -error -die/) {
+ $opts{$_} = $options{$_} if $options{$_};
+ }
+ push @domainnames, map {$_->{name}}
+ $self->domain->search($domainname, %opts);
+ }
+ else {
+ # Otherwise, a single query is enough.
+ $domainname = Net::LDAP::Util::escape_dn_value($domainname)
+ unless $options{'-no-escape'};
+ push @domainnames, $domainname;
+ }
+ }
+
+ if ($localname) {
+ $localname = Net::LDAP::Util::escape_filter_value($localname)
+ unless $options{'-no-escape'};
+ push @filters, 'fvl='.$localname;
+ }
+
+ if (defined $options{'-filter'}) {
+ push @filters, 'objectClass=FripostPendingEntry'
+ if $options{'-filter'} eq 'locked';
+ push @filters, '!(objectClass=FripostPendingEntry)'
+ if $options{'-filter'} eq 'unlocked';
+ }
+
+ my $attrs = [];
+ if (not (defined wantarray)) {
+ # In void context, we are only interested in whether or not the
+ # result set is empty.
+ $attrs = [ '1.1' ];
+ }
+ elsif (defined $options{'-keys'}) {
+ $attrs = @{$options{'-keys'}} ? [ &_keys_to_attrs(@{$options{'-keys'}}) ]
+ : [ '1.1' ];
+ }
+
+ my $filter = Fripost::Schema::Util::ldap_and_filter(@filters);
+ my $count = 0;
+ my @resultset;
+ foreach my $domainname (@domainnames) {
+ # For query the server for each matching domain.
+ my $locals = $self->ldap->search( base => $self->mail2dn('@'.$domainname)
+ , scope => 'one'
+ , deref => 'never'
+ , filter => $filter
+ , attrs => $attrs
+ );
+ ldap_error($locals, %options) // return;
+ next unless defined wantarray; # We'll drop the result anyway
+
+ if ($options{'-count'}) {
+ $count += $locals->count;
+ }
+ elsif (wantarray) {
+ push @resultset,
+ &_entries_to_locals( $domainname, $options{'-keys'},
+ $locals->entries );
+ }
+ else {
+ # In scalar context, we stop here if we got a match.
+ return &_entries_to_locals( $domainname, $options{'-keys'},
+ $locals->pop_entry )
+ if $locals->count;
+ }
+ }
+
+ return $count if $options{'-count'};
+ # In list context, we return the whole result set, maybe sorted.
+ $options{'-sort'} ? sort { $a->{name} cmp $b->{name} } @resultset
+ : @resultset;
+}
+
+
+# Map a list of LDAP::Entry object into our public representation of
+# users, aliases and lists.
+sub _entries_to_locals {
+ my $domainname = shift;
+ my $keys = shift // [];
+
+ my @locals;
+ foreach my $entry (@_) {
+
+ # Ignore bogus entries.
+ return unless defined $entry;
+ my %local;
+
+ foreach my $attr ($entry->attributes) {
+ my $val = $entry->get_value($attr, asref => 1);
+ if ($attr eq 'fvl') {
+ $local{name} = email_to_unicode($val->[0].'@'.$domainname)
+ if not @$keys or grep { $_ eq 'name' } @$keys;
+ }
+ elsif ($attr eq 'fripostIsStatusActive') {
+ $local{isActive} = $val->[0] eq 'TRUE'
+ if not @$keys or grep { $_ eq 'isActive' } @$keys;
+ }
+ elsif ($attr eq 'objectClass') {
+ if (grep { lc $_ eq lc 'FripostVirtualUser' } @$val) {
+ $local{type} = 'user';
+ }
+ elsif (grep { lc $_ eq lc 'FripostVirtualAlias' } @$val) {
+ $local{type} = 'alias';
+ }
+ elsif (grep { lc $_ eq lc 'FripostVirtualList' } @$val) {
+ $local{type} = 'list';
+ }
+ $local{isPending} = scalar (grep { lc $_ eq lc 'FripostPendingEntry' }
+ @$val )
+ if not @$keys or grep { $_ eq 'isPending' } @$keys;
+ }
+ elsif ($attr eq 'description') {
+ $local{description} = [ map { Encode::_utf8_on($_); $_ } @$val ]
+ if not @$keys or grep { $_ eq 'description' } @$keys;
+ }
+ elsif ($attr eq 'fripostUserQuota') {
+ $local{quota} = $val->[0]
+ if not @$keys or grep { $_ eq 'quota' } @$keys;
+ }
+ elsif ($attr eq 'fripostOwner') {
+ $local{owner} = [ map { dn2mail($_) } @$val ]
+ if not @$keys or grep { $_ eq 'owner' } @$keys;
+ }
+ elsif ($attr eq 'fripostOptionalMaildrop') {
+ $local{forward} = [ map { email_to_unicode($_) } @$val ]
+ if not @$keys or grep { $_ eq 'forward' } @$keys;
+ }
+ elsif ($attr eq 'fripostMaildrop') {
+ $local{destination} = [ map { email_to_unicode($_) } @$val ]
+ if not @$keys or grep { $_ eq 'destination' } @$keys;
+ }
+ elsif ($attr eq 'fripostListManager') {
+ $local{transport} = $val->[0]
+ if not @$keys or grep { $_ eq 'transport' } @$keys;
+ }
+ else {
+ die "Missing translation for local attribute ‘".$attr."’.";
+ }
+ }
+
+ # Stop after the first processed domain in scalar mode.
+ return \%local unless wantarray;
+ push @locals, \%local;
+ }
+ return @locals;
+}
+
+
+
=head1 METHODS
=over 4
diff --git a/lib/Fripost/Schema/Util.pm b/lib/Fripost/Schema/Util.pm
index d5e122e..59d724f 100644
--- a/lib/Fripost/Schema/Util.pm
+++ b/lib/Fripost/Schema/Util.pm
@@ -154,7 +154,7 @@ sub ldap_explode_dn {
}
sub split_addr {
- my $addr = shift;
+ my $addr = shift // return;
my %options = @_;
$addr =~ /^(.*)\@([^\@]+)$/s;
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 03:47:49 +0000