diff options
Diffstat (limited to 'lib/Fripost/Schema/Alias.pm')
| -rw-r--r-- | lib/Fripost/Schema/Alias.pm | 201 |
1 files changed, 0 insertions, 201 deletions
diff --git a/lib/Fripost/Schema/Alias.pm b/lib/Fripost/Schema/Alias.pm deleted file mode 100644 index 817f4a6..0000000 --- a/lib/Fripost/Schema/Alias.pm +++ /dev/null @@ -1,201 +0,0 @@ -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<search> (I<domain>, I<OPTIONS>) - -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<replace> (I<alias>, I<OPTIONS>) - -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<add> (I<alias>, I<OPTIONS>) - -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<delete> (I<alias>, I<OPTIONS>) - -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<< <guilhem at fripost.org> >> - -=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__ |