From 4a0d87e642c4d97ee2a026f1207e25a001518f3a Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sat, 8 Sep 2012 19:49:11 +0200 Subject: Abstracting the LDAP stuff in an OO library. --- lib/Fripost/Schema/Domain.pm | 183 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 183 insertions(+) create mode 100644 lib/Fripost/Schema/Domain.pm (limited to 'lib/Fripost/Schema/Domain.pm') diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm new file mode 100644 index 0000000..3ff2c25 --- /dev/null +++ b/lib/Fripost/Schema/Domain.pm @@ -0,0 +1,183 @@ +package Fripost::Schema::Domain; + +=head1 NAME + +Domain.pm - + +=head1 DESCRIPTION + +Domain.pm abstracts the LDAP schema definition and provides methods to +add, list or delete virtual domains. + +=cut + +use 5.010_000; +use strict; +use warnings; +use utf8; + +use parent 'Fripost::Schema'; +use Fripost::Schema::Misc qw/concat get_perms explode must_attrs email_valid/; +use Email::Valid; + + +=head1 METHODS + +=over 4 + +=item B (I) + +List every known (and visible) domain. The output is a array of hash +references, sorted by domain names. + +=cut + +sub search { + my $self = shift; + my %options = @_; + my $concat = $options{'-concat'}; + + my $domains = $self->ldap->search( + base => $self->suffix, + scope => 'one', + deref => 'never', + filter => 'objectClass=FripostVirtualDomain', + attrs => [ qw/fvd description fripostIsStatusActive/ ] + ); + if ($domains->code) { + die $options{'-die'}."\n" if defined $options{'-die'}; + die $domains->error; + } + return map { { domain => $_->get_value('fvd') + , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE' + , description => concat($concat, $_->get_value('description')) + } + } + $domains->sorted('fvd') +} + + +=item B (I, I) + +Returns a hash with all the (visible) attributes for the given domain. + +=cut + +sub get { + my $self = shift; + my $d = shift; + my %options = @_; + my $concat = $options{'-concat'}; + + my $domains = $self->ldap->search( + base => "fvd=$d,".$self->suffix, + scope => 'base', + deref => 'never', + filter => 'objectClass=FripostVirtualDomain', + attrs => [ qw/fvd description + fripostIsStatusActive + fripostOptionalMaildrop + fripostCanCreateAlias + fripostCanCreateList + fripostOwner + fripostPostmaster/ ] + ); + if ($domains->code) { + die $options{'-die'}."\n" if defined $options{'-die'}; + die $domains->error; + } + + # The following is not supposed to happen. + die "Error: Multiple matching entries found." if $domains->count > 1; + my $domain = $domains->pop_entry; + unless (defined $domain) { + die $options{'-die'}."\n" if defined $options{'-die'}; + die "No such such domain ā€˜$dā€˜.\n"; + } + + return ( domain => $domain->get_value('fvd') + , isactive => $domain->get_value('fripostIsStatusActive') eq 'TRUE' + , description => concat($concat, $domain->get_value('description')) + , catchalls => concat($concat, $domain->get_value('fripostOptionalMaildrop')) + , permissions => get_perms($domain, $self->whoami) + ) +} + + +=item B (I, I) + +Replace an existing domain with the given one. + +=cut + +sub replace { + my $self = shift; + my $d = shift; + my %options = @_; + + foreach (qw/description catchalls/) { + $d->{$_} = explode ($options{'-concat'}, $d->{$_}) + if defined $d->{$_}; + } + + eval { + &_is_valid($d); + my $mesg = $self->ldap->modify( + 'fvd='.$d->{domain}.','.$self->suffix, + replace => { fripostIsStatusActive => $d->{isactive} ? + 'TRUE' : 'FALSE' + , description => $d->{description} + , fripostOptionalMaildrop => $d->{catchalls} + } ); + die $mesg->error."\n" if $mesg->code; + }; + return $@; +} + + +sub add { + die "TODO"; +} + +=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 domain is valid. +sub _is_valid { + my $d = shift; + must_attrs( $d, qw/domain isactive/ ); + email_valid( $d->{domain}, -prefix => 'fake@', -error => 'Invalid domain', + -exact => 1 ); + $d->{catchalls} = [ map { email_valid($_) } @{$d->{catchalls}} ]; +} + + +=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__ -- cgit v1.2.3