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/Panel/Interface.pm | 45 ++++---- lib/Fripost/Schema.pm | 14 +-- lib/Fripost/Schema/Local.pm | 14 +-- lib/Fripost/Schema/Mailbox.pm | 227 ----------------------------------------- lib/Fripost/Schema/User.pm | 227 +++++++++++++++++++++++++++++++++++++++++ 5 files changed, 263 insertions(+), 264 deletions(-) delete mode 100644 lib/Fripost/Schema/Mailbox.pm create mode 100644 lib/Fripost/Schema/User.pm (limited to 'lib/Fripost') diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm index 4e5b48e..02f3f4b 100644 --- a/lib/Fripost/Panel/Interface.pm +++ b/lib/Fripost/Panel/Interface.pm @@ -55,7 +55,7 @@ sub ListDomains : StartRunmode { } -# This Run Mode lists the known mailboxes, aliases and lists under the current +# This Run Mode lists the known users, aliases and lists under the current # domain. sub ListLocals : Runmode { my $self = shift; @@ -68,12 +68,11 @@ sub ListLocals : Runmode { # Query *the* matching domain my %domain = $fp->domain->get( $d, -die => 404 ); - # Query the mailboxes, aliases and lists under the given domain. We - # don't die with a HTTP error code here, as it is not supposed to - # crash. - my @mailboxes = $fp->mailbox->search( $d ); - my @aliases = $fp->alias->search( $d ); - my @lists = $fp->list->search( $d ); + # Query the users, aliases and lists under the given domain. We don't + # die with a HTTP error code here, as it is not supposed to crash. + my @users = $fp->user->search( $d ); + my @aliases = $fp->alias->search( $d ); + my @lists = $fp->list->search( $d ); $fp->done; @@ -88,12 +87,12 @@ sub ListLocals : Runmode { # activation, modify catchalls?) $template->param( canEditDomain => $domain{permissions} =~ /[op]/ ); - # Can the user add mailboxes? - $template->param( canAddMailbox => $domain{permissions} =~ /p/ ); - # Should we list mailboxes? - $template->param( listMailboxes => $#mailboxes >= 0 || + # Can the user add users? + $template->param( canAddUser => $domain{permissions} =~ /p/ ); + # Should we list users? + $template->param( listUsers => $#users >= 0 || $domain{permissions} =~ /p/ ); - $template->param( mailboxes => [ + $template->param( users => [ map { { &mkLink(user => $_->{user}) , description => join ("\n", @{$_->{description}}) , isactive => $_->{isactive} @@ -102,7 +101,7 @@ sub ListLocals : Runmode { , quota => $_->{quota} }; } - @mailboxes + @users ]); # Can the user add aliases? @@ -217,12 +216,12 @@ sub EditLocal : Runmode { my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); - # Search for *the* matching mailbox, alias or list. + # Search for *the* matching user, alias or list. my ($d,$l) = ($self->split_path)[1,2]; my %local = $fp->local->get ($l.'@'.$d, -die => 404, -concat => "\x{0D}\x{0A}" ); die "Unknown type" unless grep { $local{type} eq $_ } - qw/mailbox alias list/; + qw/user alias list/; die "404\n" if $local{ispending}; my $error; # Tells whether the change submission has failed. @@ -239,7 +238,7 @@ sub EditLocal : Runmode { if (defined $q->param('submit')) { # Changes have been submitted: process them my %entry; - if ($t eq 'mailbox') { + if ($t eq 'user') { $entry{user} = $l.'@'.$d; $entry{forwards} = $q->param('forwards'); @@ -268,7 +267,7 @@ sub EditLocal : Runmode { ldap_suffix => $CFG{ldap_suffix}, -die => "Wrong password (for ‘".$u."’)." ); }; - $error = $@ || $fp->mailbox->passwd( + $error = $@ || $fp->user->passwd( $entry{user}, Fripost::Password::hash($q->param('newpw')) ); @@ -296,7 +295,7 @@ sub EditLocal : Runmode { if ($error and defined $q->param('submit')) { # Preserve the (incorrect) form, except the passwords - if ($t eq 'mailbox') { + if ($t eq 'user') { $template->param( user => encode_entities($l) , forwards => $q->param('forwards') ); } @@ -313,7 +312,7 @@ sub EditLocal : Runmode { else { %local = $fp->local->get ($l.'@'.$d, -die => 404, -concat => "\x{0D}\x{0A}" ); - if ($t eq 'mailbox') { + if ($t eq 'user') { $template->param( user => encode_entities($local{user}) , forwards => encode_entities($local{forwards}) ); } @@ -341,8 +340,8 @@ sub EditLocal : Runmode { } -# In this Run Mode authenticated users can add mailboxes, aliases and -# lists (if they have the permission). +# In this Run Mode authenticated users can add users, aliases and lists +# (if they have the permission). sub AddLocal : Runmode { my $self = shift; my %CFG = $self->cfg; @@ -357,7 +356,7 @@ sub AddLocal : Runmode { # Changes have been submitted: process them my %entry; my %rest; - if ($t eq 'mailbox') { + if ($t eq 'user') { $entry{user} = $q->param('user').'@'.$d; $entry{forwards} = $q->param('forwards'); if ($q->param('password') ne $q->param('password2')) { @@ -417,7 +416,7 @@ sub AddLocal : Runmode { $template->param( domain => encode_entities($d) ); if ($error) { # Preserve the (incorrect) form, except the passwords - if ($t eq 'mailbox') { + if ($t eq 'user') { $template->param( user => $q->param('user') , forwards => $q->param('forwards') ); } diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm index ad88c82..909a92c 100644 --- a/lib/Fripost/Schema.pm +++ b/lib/Fripost/Schema.pm @@ -9,7 +9,7 @@ Schema.pm - =head1 DESCRIPTION Schema.pm abstracts the LDAP schema definition and provides methods to -add, list or delete virtual domains, mailboxes, aliases or lists. +add, list or delete virtual domains, users, aliases or lists. =cut @@ -21,7 +21,7 @@ use utf8; use Net::LDAP; use Authen::SASL 'Cyrus'; use Fripost::Schema::Domain; -use Fripost::Schema::Mailbox; +use Fripost::Schema::User; use Fripost::Schema::Alias; use Fripost::Schema::List; use Fripost::Schema::Local; @@ -141,14 +141,14 @@ domain-specific methods. sub domain { bless shift, 'Fripost::Schema::Domain'; } -=item B +=item B -Bless the object to C, to access -mailbox-specific methods. +Bless the object to C, to access +user-specific methods. =cut -sub mailbox { bless shift, 'Fripost::Schema::Mailbox'; } +sub user { bless shift, 'Fripost::Schema::User'; } =item B @@ -174,7 +174,7 @@ sub list { bless shift, 'Fripost::Schema::List'; } =item B Bless the object to C, to access -local-specific (mailboxes, aliases and lists) methods. +local-specific (users, aliases and lists) methods. =cut diff --git a/lib/Fripost/Schema/Local.pm b/lib/Fripost/Schema/Local.pm index 49c3d68..400b4e5 100644 --- a/lib/Fripost/Schema/Local.pm +++ b/lib/Fripost/Schema/Local.pm @@ -7,7 +7,7 @@ Local.pm - =head1 DESCRIPTION Local.pm abstracts the LDAP schema definition and provides methods to -search for virtual mailboxes, aliases or lists alltogether. +search for virtual users, aliases or lists alltogether. =cut @@ -29,7 +29,7 @@ use Net::IDN::Encode qw/email_to_ascii email_to_unicode/; Returns a hash with all the (visible) attributes for the given entry. An additional 'type' attribute gives the type of *the* found entry -(possible values are 'mailbox', 'alias', and 'list'). +(possible values are 'user', 'alias', and 'list'). =cut @@ -44,14 +44,14 @@ sub get { base => "fvd=$d,".$self->suffix, scope => 'one', deref => 'never', - filter => "(|(&(objectClass=FripostVirtualMailbox)(fvu=$l)) + filter => "(|(&(objectClass=FripostVirtualUser)(fvu=$l)) (&(objectClass=FripostVirtualAlias)(fva=$l)) (&(objectClass=FripostVirtualList)(fvl=$l)))", attrs => [ qw/fvu description fripostIsStatusActive fripostIsStatusPending fripostOptionalMaildrop - fripostMailboxQuota + fripostUserQuota fva fripostMaildrop fvl fripostListManager/ ] ); @@ -62,7 +62,7 @@ sub get { # The following is not supposed to happen. Note that there is # nothing in the LDAP schema to prevent that, but it's not too - # critical as Postfix search for mailboxes, aliases and lists in + # critical as Postfix searchs for user, aliases and lists in # that order. die "Error: Multiple matching entries found." if $locals->count > 1; my $local = $locals->pop_entry; @@ -74,7 +74,7 @@ sub get { my %ret; if ($local->dn =~ /^fvu=/) { - $ret{type} = 'mailbox'; + $ret{type} = 'user'; $ret{user} = $local->get_value('fvu'); $ret{forwards} = concat($concat, map { email_to_unicode($_) } $local->get_value('fripostOptionalMaildrop')) @@ -113,7 +113,7 @@ sub exists { # We may not have read access to the list commands # The trick is somewhat dirty, but it's safe enough since postfix - # delivers to mailboxes, aliases, and lists with different + # delivers to users, aliases, and lists with different # priorities (and lists have the lowest). my @cmds = qw/admin bounces confirm join leave owner request subscribe unsubscribe bounce sendkey/; my @tests = ( 'fvu='.$l, 'fva='.$l, 'fvl='.$l ); 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__ diff --git a/lib/Fripost/Schema/User.pm b/lib/Fripost/Schema/User.pm new file mode 100644 index 0000000..11f5e28 --- /dev/null +++ b/lib/Fripost/Schema/User.pm @@ -0,0 +1,227 @@ +package Fripost::Schema::User; + +=head1 NAME + +User.pm - + +=head1 DESCRIPTION + +User.pm abstracts the LDAP schema definition and provides methods to +add, list or delete virtual users. + +=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) user under the given domain. The +output is a array of hash references, sorted by user. + +=cut + +sub search { + my $self = shift; + my $d = domain_to_ascii(shift); + my %options = @_; + my $concat = $options{'-concat'}; + + my $users = $self->ldap->search( + base => "fvd=$d,".$self->suffix, + scope => 'one', + deref => 'never', + filter => 'objectClass=FripostVirtualUser', + attrs => [ qw/fvu description fripostIsStatusActive + fripostOptionalMaildrop + fripostUserQuota/ ] + ); + if ($users->code) { + die $options{'-die'}."\n" if defined $options{'-die'}; + die $users->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('fripostUserQuota') // undef + } + } + $users->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 => 'FripostVirtualUser' + , fripostIsStatusActive => $m->{isactive} ? 'TRUE' : 'FALSE' + , userPassword => $m->{password} + ); + $attrs{description} = $m->{description} + if defined $m->{description} and @{$m->{description}}; + $attrs{fripostUserQuota} = $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 user. Note: this will NOT wipe the user 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 user 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