From 58bf9c43bf20c060a9e0623cb9f032b63889b384 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 17 Jan 2013 20:46:12 +0100 Subject: =?UTF-8?q?Mailbox=20=E2=86=92=20User.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/Fripost/Schema/Mailbox.pm | 227 ------------------------------------------ 1 file changed, 227 deletions(-) delete mode 100644 lib/Fripost/Schema/Mailbox.pm (limited to 'lib/Fripost/Schema/Mailbox.pm') diff --git a/lib/Fripost/Schema/Mailbox.pm b/lib/Fripost/Schema/Mailbox.pm deleted file mode 100644 index ce23d98..0000000 --- a/lib/Fripost/Schema/Mailbox.pm +++ /dev/null @@ -1,227 +0,0 @@ -package Fripost::Schema::Mailbox; - -=head1 NAME - -Mailbox.pm - - -=head1 DESCRIPTION - -Mailbox.pm abstracts the LDAP schema definition and provides methods to -add, list or delete virtual mailboxes. - -=cut - -use 5.010_000; -use strict; -use warnings; -use utf8; - -use parent 'Fripost::Schema'; -use Fripost::Schema::Misc qw/concat explode must_attrs email_valid/; -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) mailbox under the given domain. The -output is a array of hash references, sorted by mailbox. - -=cut - -sub search { - my $self = shift; - my $d = domain_to_ascii(shift); - my %options = @_; - my $concat = $options{'-concat'}; - - my $mailboxes = $self->ldap->search( - base => "fvd=$d,".$self->suffix, - scope => 'one', - deref => 'never', - filter => 'objectClass=FripostVirtualMailbox', - attrs => [ qw/fvu description fripostIsStatusActive - fripostOptionalMaildrop - fripostMailboxQuota/ ] - ); - if ($mailboxes->code) { - die $options{'-die'}."\n" if defined $options{'-die'}; - die $mailboxes->error."\n"; - } - return map { { user => email_to_unicode($_->get_value('fvu')) - , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE' - , description => concat($concat, $_->get_value('description')) - , forwards => concat($concat, map { email_to_unicode($_) } - $_->get_value('fripostOptionalMaildrop')) - , quota => $_->get_value('fripostMailboxQuota') // undef - } - } - $mailboxes->sorted('fvu') -} - - -=item B (I, I) - -Replace an existing account with the given one. - -=cut - -sub replace { - my $self = shift; - my $m = shift; - my %options = @_; - - foreach (qw/description forwards/) { - $m->{$_} = explode ($options{'-concat'}, $m->{$_}) - if defined $m->{$_}; - } - - eval { - my ($l,$d) = split /\@/, email_to_ascii($m->{user}), 2; - &_is_valid($m); - my $mesg = $self->ldap->modify( - "fvu=$l,fvd=$d,".$self->suffix, - replace => { fripostIsStatusActive => $m->{isactive} ? - 'TRUE' : 'FALSE' - , description => $m->{description} - , fripostOptionalMaildrop => $m->{forwards} - } ); - die $mesg->error."\n" if $mesg->code; - }; - return $@; -} - - -=item B (I, I, I) - -Change the password of the given user. I is used raw, so you -may want to hash it before hand. - -=cut - -sub passwd { - my $self = shift; - my ($l,$d) = split /\@/, email_to_ascii(shift), 2; - my $pw = shift; - my %options = @_; - - my $mesg = $self->ldap->modify( - "fvu=$l,fvd=$d,".$self->suffix, - replace => { userPassword => $pw } ); - return "Cannot change password" if $mesg->code; -} - - - -=item B (I, I) - -Add the given account. - -=cut - -sub add { - my $self = shift; - my $m = shift; - my %options = @_; - - foreach (qw/description forwards/) { - $m->{$_} = explode ($options{'-concat'}, $m->{$_}) - if defined $m->{$_}; - } - - eval { - die "Missing user name\n" unless $m->{user} =~ /^.+\@.+$/; - my ($l,$d) = split /\@/, email_to_ascii($m->{user}), 2; - &_is_valid($m); - die "‘".$m->{user}."’ already exists\n" - if $self->local->exists($m->{user},%options); - - my %attrs = ( objectClass => 'FripostVirtualMailbox' - , fripostIsStatusActive => $m->{isactive} ? 'TRUE' : 'FALSE' - , userPassword => $m->{password} - ); - $attrs{description} = $m->{description} - if defined $m->{description} and @{$m->{description}}; - $attrs{fripostMailboxQuota} = $m->{quota} if defined $m->{quota}; - $attrs{fripostOptionalMaildrop} = $m->{forwards} - if defined $m->{forwards} and @{$m->{forwards}}; - - my $mesg = $self->ldap->add( "fvu=$l,fvd=$d,".$self->suffix, - 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 mailbox. Note: this will NOT wipe the mailbox off the -disk, but merely delete its entry in the LDAP directory. - -=cut - -sub delete { - my $self = shift; - my ($l,$d) = split /\@/, email_to_ascii(shift), 2; - my %options = @_; - - my $mesg = $self->ldap->delete( "fvu=$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 mailbox is valid. -sub _is_valid { - my $m = shift; - must_attrs( $m, qw/user isactive/ ); - $m->{user} = email_valid( $m->{user}, -exact => 1); - $m->{forwards} = [ map { email_valid($_) } @{$m->{forwards}} ]; - # TODO: match 'quota' against the Dovecot specifications -} - - -=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