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__