package Fripost::Schema::Local; =head1 NAME Local.pm - =head1 DESCRIPTION Local.pm abstracts the LDAP schema definition and provides methods to search for virtual mailboxes, aliases or lists alltogether. =cut use 5.010_000; use strict; use warnings; use utf8; use parent 'Fripost::Schema'; use Fripost::Schema::Misc 'concat'; use Net::IDN::Encode qw/email_to_ascii email_to_unicode/; =head1 METHODS =over 4 =item B (I, I) Returns a hash with all the (visible) attributes for the given entry. An additional 'type' attribute gives the type of *the* found entry (possible values are 'mailbox', 'alias', and 'list'). =cut sub get { my $self = shift; my $loc = shift; my %options = @_; my $concat = $options{'-concat'}; my ($l,$d) = split /\@/, email_to_ascii($loc), 2; my $locals = $self->ldap->search( base => "fvd=$d,".$self->suffix, scope => 'one', deref => 'never', filter => "(|(&(objectClass=FripostVirtualMailbox)(fvu=$l)) (&(objectClass=FripostVirtualAlias)(fva=$l)) (&(objectClass=FripostVirtualList)(fvl=$l)))", attrs => [ qw/fvu description fripostIsStatusActive fripostIsStatusPending fripostOptionalMaildrop fripostMailboxQuota fva fripostMaildrop fvl fripostListManager/ ] ); if ($locals->code) { die $options{'-die'}."\n" if defined $options{'-die'}; die $locals->error."\n"; } # The following is not supposed to happen. Note that there is # nothing in the LDAP schema to prevent that, but it's not too # critical as Postfix search for mailboxes, aliases and lists in # that order. die "Error: Multiple matching entries found." if $locals->count > 1; my $local = $locals->pop_entry; unless (defined $local) { die $options{'-die'}."\n" if defined $options{'-die'}; die "No such such entry ‘".$loc."’.\n"; } my %ret; if ($local->dn =~ /^fvu=/) { $ret{type} = 'mailbox'; $ret{user} = $local->get_value('fvu'); $ret{forwards} = concat($concat, map { email_to_unicode($_) } $local->get_value('fripostOptionalMaildrop')) } elsif ($local->dn =~ /^fva=/) { $ret{type} = 'alias'; $ret{alias} = $local->get_value('fva'); $ret{maildrop} = concat($concat, map { email_to_unicode($_) } $local->get_value('fripostMaildrop')) } elsif ($local->dn =~ /^fvl=/) { $ret{type} = 'list'; $ret{list} = $local->get_value('fvl'); $ret{transport} = $local->get_value('fripostListManager'); } $ret{isactive} = $local->get_value('fripostIsStatusActive') eq 'TRUE'; $ret{description} = concat($concat, $local->get_value('description')); $ret{ispending} = ($local->get_value('fripostIsStatusPending') // '') eq 'TRUE'; return %ret; } =item B (I, I) Returns 1 if the given I@I exists, and 0 otherwise. The authenticated user needs to have search access to the 'entry' attribute. =cut sub exists { my $self = shift; my ($l,$d) = split /\@/, email_to_ascii(shift), 2; my %options = @_; # We may not have read access to the list commands # The trick is somewhat dirty, but it's safe enough since postfix # delivers to mailboxes, aliases, and lists with different # priorities (and lists have the lowest). my @cmds = qw/admin bounces confirm join leave owner request subscribe unsubscribe bounce sendkey/; my @tests = ( 'fvu='.$l, 'fva='.$l, 'fvl='.$l ); foreach (@cmds) { # If the entry is of the form 'foo-command', we need to ensure # that no list 'foo' exists, otherwise the new entry would # override foo's command. if ($l =~ s/-$_$//) { push @tests, 'fvl='.$l; last; } } if (defined $options{t} and $options{t} eq 'list') { # If that's a list that is to be created, we need to ensure that # none of its commands exists. foreach (@cmds) { my $l2 = $l.'-'.$_; push @tests, 'fvu='.$l2, 'fva='.$l2; } } foreach (@tests) { my $mesg = $self->ldap->search( base => "$_,fvd=$d,".$self->suffix, scope => 'base', deref => 'never', filter => 'objectClass=*' ); return 1 unless $mesg->code; # 0 Success unless ($mesg->code == 32) { # 32 No such object die $options{'-die'}."\n" if defined $options{'-die'}; die $mesg->error."\n"; } } return 0; } =back =head1 GLOBAL OPTIONS If the B<-concat> option is present, it will intersperse multi-valued attributes. Otherwise, an array reference containing every values will be returned for these attributes. The B<-die> option, if present, overides LDAP croaks and errors. =cut =head1 AUTHOR Guilhem Moulin C<< >> =head1 COPYRIGHT Copyright 2012 Guilhem Moulin. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as perl itself. =cut 1; __END__