aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost/Schema
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Fripost/Schema')
-rw-r--r--lib/Fripost/Schema/Alias.pm177
-rw-r--r--lib/Fripost/Schema/Domain.pm183
-rw-r--r--lib/Fripost/Schema/List.pm192
-rw-r--r--lib/Fripost/Schema/Local.pm161
-rw-r--r--lib/Fripost/Schema/Mailbox.pm203
-rw-r--r--lib/Fripost/Schema/Misc.pm130
6 files changed, 1046 insertions, 0 deletions
diff --git a/lib/Fripost/Schema/Alias.pm b/lib/Fripost/Schema/Alias.pm
new file mode 100644
index 0000000..c413257
--- /dev/null
+++ b/lib/Fripost/Schema/Alias.pm
@@ -0,0 +1,177 @@
+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::Misc qw/concat explode must_attrs email_valid/;
+
+
+=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 = shift;
+ my %options = @_;
+ my $concat = $options{'-concat'};
+
+ my $aliases = $self->ldap->search(
+ base => "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;
+ }
+ return map { { alias => $_->get_value('fva')
+ , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
+ , description => concat($concat, $_->get_value('description'))
+ , maildrop => concat($concat, $_->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->{$_};
+ }
+
+ my ($l,$d) = split /\@/, $a->{alias}, 2;
+
+ eval {
+ &_is_valid($a);
+ my $mesg = $self->ldap->modify(
+ "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->{$_};
+ }
+
+ my ($l,$d) = split /\@/, $a->{alias}, 2;
+
+ eval {
+ die "Missing alias name\n" if $l eq '';
+ &_is_valid($a);
+ die "‘".$a->{alias}."‘ alread exists\n"
+ if $self->local->exists($l,$d,%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 $mesg = $self->ldap->add( "fva=$l,fvd=$d,".$self->suffix,
+ attrs => [ %attrs ] );
+ if ($mesg->code) {
+ die $options{'-die'}."\n" if defined $options{'-die'};
+ die $mesg->error;
+ }
+ };
+ return $@;
+}
+
+=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/ );
+ email_valid( $a->{alias}, -exact => 1 );
+ $a->{maildrop} = [ map { email_valid($_) } @{$a->{maildrop}} ];
+ # TODO: check for cycles?
+}
+
+
+=head1 AUTHOR
+
+Guilhem Moulin C<< <guilhem at fripost.org> >>
+
+=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/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<search> (I<OPTIONS>)
+
+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<get> (I<domain>, I<OPTIONS>)
+
+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<replace> (I<domain>, I<OPTIONS>)
+
+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<< <guilhem at fripost.org> >>
+
+=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/List.pm b/lib/Fripost/Schema/List.pm
new file mode 100644
index 0000000..f3ce4b8
--- /dev/null
+++ b/lib/Fripost/Schema/List.pm
@@ -0,0 +1,192 @@
+package Fripost::Schema::List;
+
+=head1 NAME
+
+List.pm -
+
+=head1 DESCRIPTION
+
+List.pm abstracts the LDAP schema definition and provides methods to
+add, list or delete virtual mailing lists.
+
+=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/;
+
+
+=head1 METHODS
+
+=over 4
+
+=item B<search> (I<domain>, I<OPTIONS>)
+
+List every known (and visible) list under the given domain. The output
+is a array of hash references, sorted by list.
+
+=cut
+
+sub search {
+ my $self = shift;
+ my $domain = shift;
+ my %options = @_;
+ my $concat = $options{'-concat'};
+
+ my $lists = $self->ldap->search(
+ base => "fvd=$domain,".$self->suffix,
+ scope => 'one',
+ deref => 'never',
+ filter => 'objectClass=FripostVirtualList',
+ attrs => [ qw/fvl description fripostIsStatusActive
+ fripostListManager/ ]
+ );
+ if ($lists->code) {
+ die $options{'-die'}."\n" if defined $options{'-die'};
+ die $lists->error;
+ }
+ return map { { list => $_->get_value('fvl')
+ , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
+ , description => concat($concat, $_->get_value('description'))
+ , transport => $_->get_value('fripostListManager')
+ }
+ }
+ $lists->sorted('fvl')
+}
+
+
+=item B<replace> (I<list>, I<OPTIONS>)
+
+Replace an existing list with the given one.
+
+=cut
+
+sub replace {
+ my $self = shift;
+ my $l = shift;
+ my %options = @_;
+
+ $l->{description} = explode ($options{'-concat'}, $l->{description})
+ if defined $l->{description};
+
+ my ($l2,$d) = split /\@/, $l->{list}, 2;
+
+ eval {
+ &_is_valid($l);
+ my $l3 = { fripostIsStatusActive => $l->{isactive} ? 'TRUE' : 'FALSE'
+ , description => $l->{description} };
+ $l3->{fripostListManager} = $l->{transport} if defined $l->{transport};
+ my $mesg = $self->ldap->modify(
+ "fvl=$l2,fvd=$d,".$self->suffix,
+ replace => $l3 );
+ die $mesg->error."\n" if $mesg->code;
+ };
+ return $@;
+}
+
+
+=item B<add> (I<list>, I<OPTIONS>)
+
+Add the given list.
+
+=cut
+
+sub add {
+ my $self = shift;
+ my $l = shift;
+ my %options = @_;
+
+ $l->{description} = explode ($options{'-concat'}, $l->{description})
+ if defined $l->{description};
+
+ my ($l2,$d) = split /\@/, $l->{list}, 2;
+
+ eval {
+ die "Missing list name\n" if $l eq '';
+ must_attrs( $l, 'transport' );
+ &_is_valid($l);
+ die "‘".$l->{list}."‘ alread exists\n"
+ if $self->local->exists($l2,$d,%options);
+
+ my %attrs = ( objectClass => 'FripostVirtualList'
+ , fripostIsStatusActive => $l->{isactive} ? 'TRUE' : 'FALSE'
+ , fripostOwner => $self->whoami
+ , fripostListManager => $l->{transport}
+ );
+ if ($l->{transport} eq 'mailman') {
+ $attrs{fripostListCommand} =
+ [ map { $l2.'-'.$_ }
+ qw/admin bounces confirm join leave loop owner
+ request subscribe unsubscribe/ ];
+ }
+ elsif ($l->{transport} eq 'schleuder') {
+ $attrs{fripostListCommand} =
+ [ map { $l2.'-'.$_ }
+ # TODO: check that
+ qw/request bounce sendkey owner/ ];
+ }
+ $attrs{description} = $l->{description}
+ if defined $l->{description} and @{$l->{description}};
+
+ my $mesg = $self->ldap->add( "fvl=$l2,fvd=$d,".$self->suffix,
+ attrs => [ %attrs ] );
+ if ($mesg->code) {
+ die $options{'-die'}."\n" if defined $options{'-die'};
+ die $mesg->error;
+ }
+ };
+ return $@;
+}
+
+
+
+=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 $l = shift;
+ must_attrs( $l, qw/list isactive/ );
+ email_valid( $l->{list}, -exact => 1 );
+
+ say STDERR $l->{transport};
+
+ die "Invalid transport: ‘".$l->{transport}."‘\n"
+ if defined $l->{transport} and
+ $l->{transport} !~ /^(schleuder|mailman)$/;
+ # TODO: check commands
+}
+
+
+=head1 AUTHOR
+
+Guilhem Moulin C<< <guilhem at fripost.org> >>
+
+=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/Local.pm b/lib/Fripost/Schema/Local.pm
new file mode 100644
index 0000000..79c5420
--- /dev/null
+++ b/lib/Fripost/Schema/Local.pm
@@ -0,0 +1,161 @@
+package Fripost::Schema::Local;
+
+=head1 NAME
+
+Local.pm -
+
+=head1 DESCRIPTION
+
+Local.pm abstracts the LDAP schema definition and provides methods to
+search for virtual mailboxes, aliases or lists alltogether.
+
+=cut
+
+use 5.010_000;
+use strict;
+use warnings;
+use utf8;
+
+use parent 'Fripost::Schema';
+use Fripost::Schema::Misc 'concat';
+
+
+=head1 METHODS
+
+=over 4
+
+=item B<get> (I<local>,I<domain>, I<OPTIONS>)
+
+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').
+
+=cut
+
+sub get {
+ my $self = shift;
+ my $l = shift;
+ my $d = shift;
+ my %options = @_;
+ my $concat = $options{'-concat'};
+
+ my $locals = $self->ldap->search(
+ base => "fvd=$d,".$self->suffix,
+ scope => 'one',
+ deref => 'never',
+ filter => "(|(&(objectClass=FripostVirtualMailbox)(fvu=$l))
+ (&(objectClass=FripostVirtualAlias)(fva=$l))
+ (&(objectClass=FripostVirtualList)(fvl=$l)))",
+ attrs => [ qw/fvu description
+ fripostIsStatusActive
+ fripostOptionalMaildrop
+ fripostMailboxQuota
+ fva fripostMaildrop
+ fvl fripostListManager/ ]
+ );
+ if ($locals->code) {
+ die $options{'-die'}."\n" if defined $options{'-die'};
+ die $locals->error;
+ }
+
+ # 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
+ # that order.
+ die "Error: Multiple matching entries found." if $locals->count > 1;
+ my $local = $locals->pop_entry;
+
+ unless (defined $local) {
+ die $options{'-die'}."\n" if defined $options{'-die'};
+ die "No such such entry ‘".$l.'@'.$d."‘.\n";
+ }
+
+ my %ret;
+ if ($local->dn =~ /^fvu=/) {
+ $ret{type} = 'mailbox';
+ $ret{user} = $local->get_value('fvu');
+ $ret{forwards} = concat($concat, $local->get_value('fripostOptionalMaildrop'))
+ }
+ elsif ($local->dn =~ /^fva=/) {
+ $ret{type} = 'alias';
+ $ret{alias} = $local->get_value('fva');
+ $ret{maildrop} = concat($concat, $local->get_value('fripostMaildrop'))
+ }
+ elsif ($local->dn =~ /^fvl=/) {
+ $ret{type} = 'list';
+ $ret{list} = $local->get_value('fvl');
+ }
+ $ret{isactive} = $local->get_value('fripostIsStatusActive') eq 'TRUE';
+ $ret{description} = concat($concat, $local->get_value('description'));
+
+ return %ret;
+}
+
+
+=item B<exists> (I<local>,I<domain>, I<OPTIONS>)
+
+Returns 1 if the given I<local>@I<domain> exists, and 0 otherwise.
+The authenticated user needs to have search access to the 'entry'
+attribute.
+
+=cut
+
+sub exists {
+ my $self = shift;
+ my $l = shift;
+ my $d = shift;
+ my %options = @_;
+
+ # 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
+ # priorities (and lists have the lowest).
+# $l =~ s/(.*)-(admin|bounces|confirm|join|leave|loop|owner|request|subscribe|unsubscribe|bounce|sendkey)$/$1/;
+ # ^ TODO
+
+ foreach my $t (qw/fvu fva fvl/) {
+ my $mesg = $self->ldap->search( base => "$t=$l,fvd=$d,".$self->suffix,
+ scope => 'base',
+ deref => 'never',
+ filter => 'objectClass=*'
+ );
+ return 1 unless $mesg->code; # 0 Success
+ unless ($mesg->code == 32) { # 32 No such object
+ die $options{'-die'}."\n" if defined $options{'-die'};
+ die $mesg->error;
+ }
+ }
+ return 0;
+}
+
+=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
+
+
+=head1 AUTHOR
+
+Guilhem Moulin C<< <guilhem at fripost.org> >>
+
+=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/Mailbox.pm b/lib/Fripost/Schema/Mailbox.pm
new file mode 100644
index 0000000..61d86a0
--- /dev/null
+++ b/lib/Fripost/Schema/Mailbox.pm
@@ -0,0 +1,203 @@
+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/;
+
+
+=head1 METHODS
+
+=over 4
+
+=item B<search> (I<domain>, I<OPTIONS>)
+
+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 $domain = shift;
+ my %options = @_;
+ my $concat = $options{'-concat'};
+
+ my $mailboxes = $self->ldap->search(
+ base => "fvd=$domain,".$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;
+ }
+ return map { { user => $_->get_value('fvu')
+ , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
+ , description => concat($concat, $_->get_value('description'))
+ , forwards => concat($concat, $_->get_value('fripostOptionalMaildrop'))
+ , quota => $_->get_value('fripostMailboxQuota') // undef
+ }
+ }
+ $mailboxes->sorted('fvu')
+}
+
+
+=item B<replace> (I<mailbox>, I<OPTIONS>)
+
+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->{$_};
+ }
+
+ my ($l,$d) = split /\@/, $m->{user}, 2;
+
+ eval {
+ &_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<passwd> (I<username>, I<password>, I<OPTIONS>)
+
+Change the password of the given user. I<password> is used raw, so you
+may want to hash it before hand.
+
+=cut
+
+sub passwd {
+ my $self = shift;
+ my ($l,$d) = split /\@/, 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<add> (I<mailbox>, I<OPTIONS>)
+
+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->{$_};
+ }
+
+ my ($l,$d) = split /\@/, $m->{user}, 2;
+
+ eval {
+ die "Missing user name\n" if $l eq '';
+ &_is_valid($m);
+ die "‘".$m->{user}."‘ alread exists\n"
+ if $self->local->exists($l,$d,%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;
+ }
+ };
+ return $@;
+}
+
+
+=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/ );
+ 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<< <guilhem at fripost.org> >>
+
+=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/Misc.pm b/lib/Fripost/Schema/Misc.pm
new file mode 100644
index 0000000..be88385
--- /dev/null
+++ b/lib/Fripost/Schema/Misc.pm
@@ -0,0 +1,130 @@
+package Fripost::Schema::Misc;
+
+=head1 NAME
+
+Misc.pm -
+
+=cut
+
+use 5.010_000;
+use strict;
+use warnings;
+use utf8;
+
+use Exporter 'import';
+our @EXPORT_OK = qw /concat get_perms explode
+ must_attrs email_valid/;
+use Email::Valid;
+
+
+# Let the first argument, if defined, intersperse the other arguments.
+sub concat {
+ my $concat = shift;
+
+ if (defined $concat) {
+ return join ($concat, @_);
+ }
+ else {
+ return [ @_ ];
+ }
+}
+
+# The reverse of 'concat': takes a single line, and split it along
+# "concat", if defined. Returns an array reference in any case.
+sub explode {
+ my $concat = shift;
+
+ my $out;
+ if (defined $concat) {
+ $out = [ split /$concat/, $_[0] ];
+ }
+ else {
+ $out = [ @_ ];
+ }
+ [ grep { !/^\s*$/ } @$out ];
+}
+
+
+# This subroutine displays the access that the given DN has on the entry.
+# Possible values are :
+# - '': no rights
+# - a: can create aliases
+# - l: can create lists
+# - al: can create aliases & lists
+# - o: owner
+# - p: postmaster
+sub get_perms {
+ my ($entry, $dn) = @_;
+ my $perms = '';
+
+ $perms .= 'a'
+ if grep { $dn eq $_ or (split /,/,$dn,2)[1] eq $_ }
+ $entry->get_value ('fripostCanCreateAlias');
+
+ $perms .= 'l'
+ if grep { $dn eq $_ or (split /,/,$dn,2)[1] eq $_ }
+ $entry->get_value ('fripostCanCreateList');
+
+ $perms = 'o'
+ if grep { $dn eq $_ } $entry->get_value('fripostOwner');
+
+ $perms = 'p'
+ if grep { $dn eq $_ } $entry->get_value('fripostPostmaster');
+
+ return $perms;
+}
+
+
+# "&must_att $h qw/a b c .../" ensures that attributes a b c... are all
+# defined in the hash reference.
+sub must_attrs {
+ my $h = shift;
+ foreach (@_) {
+ die '‘'.$_."‘: Missing attribute.\n"
+ unless defined $h->{$_} and
+ (ref $h->{$_} eq 'ARRAY' ? @{$h->{$_}} : $h->{$_} ne '')
+ }
+}
+
+
+# Ensure that the first argument is a valid email. Can also be used to
+# check the validity of domains using the '-prefix' option.
+# '-exact' forces the input to be a bare email, ("name <email>" is not
+# allowed).
+sub email_valid {
+ my $in = shift;
+ my %options = @_;
+
+ my $i = $in;
+ $i =~ s/.*<([^>]+)>.*/$1/;
+ my $mesg = $options{'-error'} // "Invalid e-mail";
+ $in = $options{'-prefix'}.$in if defined $options{'-prefix'};
+
+ my $addr = Email::Valid::->address( -address => $in,
+ -tldcheck => 1,
+ -fqdn => 1 );
+ my $match = defined $addr;
+ $match &&= $addr eq $in if $options{'-exact'};
+ die $mesg." ‘".$i."‘\n" unless $match;
+ return $addr;
+}
+
+
+=head1 AUTHOR
+
+Guilhem Moulin C<< <guilhem at fripost.org> >>
+
+=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__
generated by cgit v1.2.3 (git 2.25.1) at 2025-11-04 01:27:33 +0000