diff options
Diffstat (limited to 'lib/Fripost/Schema/Local.pm')
| -rw-r--r-- | lib/Fripost/Schema/Local.pm | 312 |
1 files changed, 308 insertions, 4 deletions
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 |