aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost/Schema
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Fripost/Schema')
-rw-r--r--lib/Fripost/Schema/Type/Alias.pm108
-rw-r--r--lib/Fripost/Schema/Type/Domain.pm110
-rw-r--r--lib/Fripost/Schema/Type/User.pm100
3 files changed, 318 insertions, 0 deletions
diff --git a/lib/Fripost/Schema/Type/Alias.pm b/lib/Fripost/Schema/Type/Alias.pm
new file mode 100644
index 0000000..fa78d6f
--- /dev/null
+++ b/lib/Fripost/Schema/Type/Alias.pm
@@ -0,0 +1,108 @@
+package Fripost::Schema::Type::Alias;
+
+use 5.010_000;
+use warnings;
+use strict;
+
+use base qw/Net::LDAP/;
+our $VERSION = '0.01';
+
+
+#######################################################################
+
+# Search an alias, and return the corresponding entries if found. If no
+# alias is given, returns all aliases.
+# Filters on values of both keys `address' and `goto' (unless they are
+# undefined).
+sub search {
+ my $self = shift;
+
+ my $base = $self->{_options}->{base_dn};
+
+ my @filters = ('(ObjectClass=virtualAliases)');
+ push @filters, '(mailLocalAddress=' .$_[0]->{address}. ')'
+ if defined $_[0]->{address};
+ push @filters, '(mailTarget=' .$_[0]->{goto}. ')'
+ if defined $_[0]->{goto};
+
+ my $filter;
+ if ($#filters == 0 ) {
+ $filter = $filters[0];
+ }
+ elsif ($#filters > 0) {
+ $filter = '(&' . (join '', @filters) . ')';
+ }
+
+ my $res = $self->{_ldap}->search(
+ base => $base,
+ scope => 'subtree',
+ attrs => [ 'mailLocalAddress', 'mailTarget', 'isActive' ],
+ filter => $filter
+ );
+ die "Error: " .$res->error. "\n" if $res->code;
+
+ return $res;
+}
+
+# Add the given alias
+sub add {
+ my $self = shift;
+ my $alias = shift;
+
+ # TODO: detect cycles
+ die "Error: Cannot create alias `" .$alias->{address}.
+ "' targetting to itself.\n"
+ if $alias->{address} eq $alias->{goto};
+
+ my $base = join ',', ( 'mailTarget='.$alias->{goto}
+ , 'dc='. (split /\@/, $alias->{address}, 2)[1]
+ , 'ou=domains'
+ , $self->{_options}->{base_dn} );
+
+ my @attrs = ( mailLocalAddress => $alias->{address}
+ , isActive => $alias->{isActive} );
+ my $res;
+ if ($self->search($alias)->count) {
+ $res = $self->{_ldap}->modify( $base, add => [ @attrs ] );
+ }
+ else {
+ $res = $self->{_ldap}->add( $base,
+ attrs => [ mailTarget => $alias->{goto}
+ , objectClass => [ 'top',
+ 'inetLocalMailRecipient',
+ 'virtualAliases' ],
+ @attrs
+ ]
+ );
+ }
+ die "Error: " .$res->error. "\n" if $res->code;
+ return $res;
+}
+
+
+#######################################################################
+
+1;
+
+=head1 NAME
+
+Fripost::Schema::Type::Alias -
+
+=head1 AUTHOR
+
+Guilhem Moulin C<< <guilhem at fripost.org> >>
+
+=head1 COPYRIGHT
+
+Copyright 2012 Guilhem Moulin, all rights reserved.
+
+=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 of Alias.pm
+
+__END__
diff --git a/lib/Fripost/Schema/Type/Domain.pm b/lib/Fripost/Schema/Type/Domain.pm
new file mode 100644
index 0000000..f85ea87
--- /dev/null
+++ b/lib/Fripost/Schema/Type/Domain.pm
@@ -0,0 +1,110 @@
+package Fripost::Schema::Type::Domain;
+
+use 5.010_000;
+use warnings;
+use strict;
+
+use base qw/Net::LDAP/;
+our $VERSION = '0.01';
+
+
+#######################################################################
+
+# Search a domain, and return the corresponding entries if found. If no
+# domain is given, returns all domains.
+# Filters on values of both keys `domain' and `owner' (unless they are
+# undefined).
+sub search {
+ my $self = shift;
+
+ my ($base, $owner);
+ $base = join ',', ('ou=domains',$self->{_options}->{base_dn});
+ $owner = join ',', ( 'uid='.$_[0]->{owner}
+ , 'ou=mailboxes'
+ , $self->{_options}->{base_dn} )
+ if defined $_[0]->{owner};
+
+ my @filters = ('(ObjectClass=virtualDomain)');
+ push @filters, "(dc=" .$_[0]->{domain}. ")" if defined $_[0]->{domain};
+ push @filters, "(owner=" .$owner. ")" if defined $_[0]->{owner};
+ my $filter;
+ if ($#filters == 0) {
+ $filter = $filters[0];
+ }
+ elsif ($#filters > 0) {
+ $filter = "(&" . (join '', @filters) . ")";
+ }
+
+ my $res = $self->{_ldap}->search(
+ base => $base,
+ scope => 'one',
+ attrs => [ 'dc', 'owner', 'isActive' ],
+ filter => $filter
+ );
+ die "Error: " .$res->error. "\n" if $res->code;
+ return $res;
+}
+
+# Add the given domain. If it already exists, adds the new owner; Or
+# fails if the new domains is not self-manageable.
+sub add {
+ my $self = shift;
+ my $domain = shift;
+
+ my ($base, $owner);
+ $base = join ',', ( 'dc='.$domain->{domain}
+ , 'ou=domains'
+ , $self->{_options}->{base_dn} );
+ $owner = join ',', ( 'uid='.$domain->{owner}
+ , 'ou=mailboxes'
+ , $self->{_options}->{base_dn} )
+ if defined $domain->{owner};
+
+ my $res;
+ if ($self->search({ domain => $domain->{domain} })->count) {
+ die "Error: Cannot create self-managed domain `"
+ .$domain->{domain}. "' since it already exists.\n"
+ unless defined $domain->{owner};
+ $res = $self->{_ldap}->modify( $base, add => [ owner => $owner ] );
+ }
+ else {
+ my @attrs = ( dc => $domain->{domain},
+ , objectClass => [ 'top', 'virtualDomain' ],
+ , isActive => $domain->{isActive}
+ );
+ push @attrs, (owner => $owner)
+ if defined $domain->{owner};
+ $res = $self->{_ldap}->add( $base, attrs => [ @attrs ] );
+ }
+ die "Error: " .$res->error. "\n" if $res->code;
+ return $res;
+}
+
+
+#######################################################################
+
+
+1;
+
+=head1 NAME
+
+Fripost::Schema::Type::Domain -
+
+=head1 AUTHOR
+
+Guilhem Moulin C<< <guilhem at fripost.org> >>
+
+=head1 COPYRIGHT
+
+Copyright 2012 Guilhem Moulin, all rights reserved.
+
+=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 of Domain.pm
+
+__END__
diff --git a/lib/Fripost/Schema/Type/User.pm b/lib/Fripost/Schema/Type/User.pm
new file mode 100644
index 0000000..09c3aa0
--- /dev/null
+++ b/lib/Fripost/Schema/Type/User.pm
@@ -0,0 +1,100 @@
+package Fripost::Schema::Type::User;
+
+use 5.010_000;
+use warnings;
+use strict;
+
+use base qw/Net::LDAP/;
+our $VERSION = '0.01';
+
+
+#######################################################################
+
+# Search a user, and return the corresponding entries if found. If no
+# user is given, returns all users.
+# Filters on the value of the key `uid' only (unless it is undefined).
+sub search {
+ my $self = shift;
+
+ my $base = join ',', ('ou=mailboxes',$self->{_options}->{base_dn});
+
+ my $filter = "(ObjectClass=virtualMailbox)";
+ $filter = "(&" .$filter. "(uid=" .$_[0]. ")" .")"
+ if defined $_[0];
+
+ my $res = $self->{_ldap}->search(
+ base => $base,
+ scope => 'one',
+ attrs => [ 'uid', 'gn' , 'sn', 'maildir', 'isActive' ],
+ filter => $filter
+ );
+ die "Error: " .$res->error. "\n" if $res->code;
+ return $res;
+}
+
+
+# Add the given user
+sub add {
+ my $self = shift;
+ my $user = shift;
+
+ my $base = join ',', ( 'uid=' .$user->{username}
+ , 'ou=mailboxes'
+ , $self->{_options}->{base_dn} );
+
+ my $res = $self->{_ldap}->add( $base,
+ attrs => [ uid => $user->{username},
+ objectClass => [ 'top', 'virtualMailbox' ],
+ userPassword => $user->{userPassword},
+ maildir => $user->{maildir},
+ isActive => $user->{isActive}
+ ]
+ );
+ die "Error: " .$res->error. "\n" if $res->code;
+ return $res;
+}
+
+
+# Change password
+sub pwd {
+ my $self = shift;
+ my $user = shift;
+
+ my $base = join ',', ( 'uid=' .$user->{username}
+ , 'ou=mailboxes'
+ , $self->{_options}->{base_dn} );
+
+ my $res = $self->{_ldap}->modify( $base,
+ replace => [ userPassword => $user->{userPassword} ]
+ );
+ die "Error: " .$res->error. "\n" if $res->code;
+ return $res;
+}
+
+
+#######################################################################
+
+1;
+
+=head1 NAME
+
+Fripost::Schema::Type::User -
+
+=head1 AUTHOR
+
+Guilhem Moulin C<< <guilhem at fripost.org> >>
+
+=head1 COPYRIGHT
+
+Copyright 2012 Guilhem Moulin, all rights reserved.
+
+=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 of User.pm
+
+__END__
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 23:01:05 +0000