package Fripost::Schema::Alias; =head1 NAME Alias.pm - =head1 DESCRIPTION Alias.pm abstracts the LDAP schema definition and provides methods to add, list or delete virtual aliases. =cut use 5.010_000; use strict; use warnings; use utf8; use parent 'Fripost::Schema'; use Fripost::Schema::Util qw/concat explode must_attrs email_valid split_addr canonical_dn/; use Net::IDN::Encode qw/domain_to_ascii email_to_ascii email_to_unicode/; =head1 METHODS =over 4 =item B (I, I) List every known (and visible) alias under the given domain. The output is a array of hash references, sorted by alias. =cut sub search { my $self = shift; my $domain = domain_to_ascii(shift); my %options = @_; my $concat = $options{'-concat'}; my $aliases = $self->ldap->search( base => canonical_dn( {fvd => $domain}, @{$self->suffix} ), scope => 'one', deref => 'never', filter => 'objectClass=FripostVirtualAlias', attrs => [ qw/fva description fripostIsStatusActive fripostMaildrop/ ] ); if ($aliases->code) { die $options{'-die'}."\n" if defined $options{'-die'}; die $aliases->error."\n"; } return map { { alias => email_to_unicode($_->get_value('fva')) , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE' , description => concat($concat, $_->get_value('description')) , maildrop => concat($concat, map { email_to_unicode ($_) } $_->get_value('fripostMaildrop')) } } $aliases->sorted('fva') } =item B (I, I) Replace an existing alias with the given one. =cut sub replace { my $self = shift; my $a = shift; my %options = @_; foreach (qw/description maildrop/) { $a->{$_} = explode ($options{'-concat'}, $a->{$_}) if defined $a->{$_}; } eval { my ($l,$d) = split_addr( $a->{alias}, -encode => 'ascii' ); &_is_valid($a); my $mesg = $self->ldap->modify( canonical_dn({fva => $l}, {fvd => $d}, @{$self->suffix}), replace => { fripostIsStatusActive => $a->{isactive} ? 'TRUE' : 'FALSE' , description => $a->{description} , fripostMaildrop => $a->{maildrop} } ); die $mesg->error."\n" if $mesg->code; }; return $@; } =item B (I, I) Add the given alias. =cut sub add { my $self = shift; my $a = shift; my %options = @_; foreach (qw/description maildrop/) { $a->{$_} = explode ($options{'-concat'}, $a->{$_}) if defined $a->{$_}; } eval { die "Missing alias name\n" unless $a->{alias} =~ /^.+\@.+$/; my ($l,$d) = split_addr( $a->{alias}, -encode => 'ascii' ); &_is_valid($a); die "‘".$a->{alias}."’ already exists\n" if $self->local->exists($a->{alias},%options); my %attrs = ( objectClass => 'FripostVirtualAlias' , fripostIsStatusActive => $a->{isactive} ? 'TRUE' : 'FALSE' , fripostMaildrop => $a->{maildrop} , fripostOwner => $self->whoami ); $attrs{description} = $a->{description} if defined $a->{description} and @{$a->{description}}; my $dn = canonical_dn({fva => $l}, {fvd => $d}, @{$self->suffix}); my $mesg = $self->ldap->add( $dn, attrs => [ %attrs ] ); if ($mesg->code) { die $options{'-die'}."\n" if defined $options{'-die'}; die $mesg->error."\n"; } }; return $@; } =item B (I, I) Delete the given alias. =cut sub delete { my $self = shift; my ($l,$d) = split_addr( shift, -encode => 'ascii' ); my %options = @_; my $mesg = $self->ldap->delete( canonical_dn( {fva => $l}, {fvd => $d}, @{$self->suffix} ) ); if ($mesg->code) { if (defined $options{'-die'}) { return $mesg->error unless $options{'-die'}; die $options{'-die'}."\n"; } die $mesg->error."\n"; } } =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 # Ensure that the given alias is valid. sub _is_valid { my $a = shift; must_attrs( $a, qw/alias isactive maildrop/ ); $a->{alias} = email_valid( $a->{alias}, -exact => 1 ); $a->{maildrop} = [ map { email_valid($_) } @{$a->{maildrop}} ]; } =head1 AUTHOR Guilhem Moulin C<< >> =head1 COPYRIGHT Copyright 2012,2013 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__