aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem.moulin@fripost.org>2012-04-18 02:06:01 +0200
committerGuilhem Moulin <guilhem.moulin@fripost.org>2012-04-18 02:06:01 +0200
commit0467c0a622c5aa0b2b63615b2b36f31f4272bcd1 (patch)
treed6bf9a35484cb189ca0503b43e79fb8d7f125b7c
parentc108460517f2569b9cfeca073c889a35d6d77cd4 (diff)
Implemented the changes on the LDAP schema.
-rwxr-xr-xfripost-adduser23
-rwxr-xr-xfripost-newdomain30
-rwxr-xr-xlib/Fripost/Schema.pm225
-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
6 files changed, 378 insertions, 218 deletions
diff --git a/fripost-adduser b/fripost-adduser
index bd73aea..a3c78a8 100755
--- a/fripost-adduser
+++ b/fripost-adduser
@@ -18,7 +18,8 @@ B<fripost-adduser> [B<--verbose>] [B<--debug>] [B<--pretend>] [I<username>]
B<fripost-adduser> adds a new virtual mailbox to the system, unless
B<--pretend> is set.
-If no I<username> or I<password> are given, the user is prompted for them.
+If I<username> or I<password> are not given, the user is prompted for
+them.
If I<username> is not fully qualified, C<fripost.org> is appended.
If I<username> is already an existing username or alias,
B<fripost-adduser> raises an error.
@@ -35,7 +36,7 @@ that I<username> is not already in the database.)
=item B<--password=>I<password>
By default, the user is prompted for his/her new password, which is
-hashed, salted and then inserted added to the LDAP entry.
+hashed, salted and then added to the LDAP entry.
By using B<--password>, I<password> is inserted RAW in the database.
This can be useful if the user does not want to give the clear copy but
only a hash, for example.
@@ -147,12 +148,14 @@ GetOptions(
sub dsay { say STDERR @_ if $conf->{debug}; }
sub vsay { say STDERR @_ if $conf->{verbose} || $conf->{debug}; }
+
# Connect to the LDAP server
my $ldap = Fripost::Schema->new( $conf );
# Define the new user
my $user;
+my ($domain, $login);
{
my $username;
if (defined $ARGV[0]) {
@@ -163,7 +166,8 @@ my $user;
else {
$username = prompt_email("New username: ", 'is_user');
}
- my ($domain, $login) = split /\@/, $username, 2;
+ # TODO: Ensure that the domain is valid.
+ ($login, $domain) = split /\@/, $username, 2;
my $maildir = "$domain/$login/Maildir/"; # Trailing slash important
my $isActive = 'TRUE';
my ($userPassword, $clearPassword);
@@ -171,7 +175,7 @@ my $user;
$userPassword = $conf->{password};
}
else {
- $clearPassword = 'hop'; #prompt_password();
+ $clearPassword = prompt_password();
$userPassword = hash( undef, undef, $clearPassword );
}
@@ -190,11 +194,12 @@ my $user;
}
-# Check if the username already exists, or is an existing alias.
{
+ # Ensure that the username doesn't already exist.
die "Error: User `" .$user->{username}. "' already exists.\n"
if $ldap->user->search($user->{username})->count;
+ # Ensure that the username doesn't correspond to an existing alias.
my $res = $ldap->alias->search({ address => $user->{username} });
if ($res->count) {
print STDERR "Error: Alias `" .$user->{username}. "' already exists. ";
@@ -203,9 +208,13 @@ my $user;
say STDERR ".)";
exit 1;
}
- exit 1;
+
+ # Warn if the domain is unknown.
+ warn "WARN: Unknown domain `" .$domain. "'.\n"
+ unless $ldap->domain->search({ domain => $domain })->count;
}
+
## Insert the new user
if ($conf->{pretend}) {
vsay "Did not create user since we are pretending.";
@@ -213,7 +222,7 @@ if ($conf->{pretend}) {
else {
my %user = %$user;
delete $user{clearPassword};
- $ldap->addUser(\%user);
+ $ldap->user->add(\%user);
say "New account $user{username} added.";
}
diff --git a/fripost-newdomain b/fripost-newdomain
index 155e6ae..8ab48bf 100755
--- a/fripost-newdomain
+++ b/fripost-newdomain
@@ -11,14 +11,14 @@ fripost-newdomain - Add a new domain to the system
=head1 SYNOPSIS
-B<fripost-newdomain> [B<--debug>] [B<--pretend>]
+B<fripost-newdomain> [B<--verbose>] [B<--debug>] [B<--pretend>]
[B<--owner=>I<username>] [I<domain>]
=head1 DESCRIPTION
B<fripost-newdomain> adds a new virtual domain to the system, unless
B<--pretend> is set.
-If no I<domain> is given, the user is prompted for it.
+If I<domain> is not given, the user is prompted for it.
By default, B<fripost-newdomain> prompts for the owner of the new
domain; Use B<--owner=>I<''> to create a "global" domain, only managed
by the administrators.
@@ -64,6 +64,10 @@ The default value is read from the configuration file, see B<CONFIGURATION>.
The root DN for everything done by B<fripost-newdomain>.
The default value is read from the configuration file, see B<CONFIGURATION>.
+=item B<-v>, B<--verbose>
+
+Verbose mode.
+
=item B<--debug>
Debug mode.
@@ -128,10 +132,13 @@ GetOptions(
'pretend' => \$conf->{pretend},
'owner=s' => \$conf->{owner},
'debug' => \$conf->{debug},
+ 'v|verbose' => \$conf->{verbose},
'man' => sub { pod2usage(-exitstatus => 0,
-verbose => 2) }
) or pod2usage(2);
+sub vsay { say STDERR @_ if $conf->{verbose} || $conf->{debug}; }
+
# Connect to the LDAP server
my $ldap = Fripost::Schema->new( $conf );
@@ -141,6 +148,7 @@ my $ldap = Fripost::Schema->new( $conf );
my %domain;
$domain{domain} = $ARGV[0];
$domain{domain} //= prompt "Domain name: ";
+# TODO: Ensure that the domain is valid.
$domain{isActive} = 'TRUE';
if (defined $conf->{owner}) {
if ($conf->{owner} eq '') {
@@ -157,7 +165,6 @@ else {
}
-# Checks.
{
# Check that the owner exists.
die "Error: Unknown user `" .$domain{owner}. "'.\n"
@@ -177,7 +184,7 @@ else {
# warning.
my $res = $ldap->domain->search({ domain => $domain{domain} });
if ($res->count) {
- print STDERR "Warning: Domain `" .$domain{domain}. "' already exists.";
+ print STDERR "WARN: Domain `" .$domain{domain}. "' already exists.";
my @owners;
map { push @owners, $_->{owner} if defined $_->{owner} } ($res->entries);
if (@owners) {
@@ -191,16 +198,21 @@ else {
if ($conf->{pretend}) {
- say "Nothing to do since we are only pretending...";
+ vsay "Nothing to do since we are only pretending...";
exit 0;
}
# Add the domain.
$ldap->domain->add(\%domain);
-print "New domain `" .$domain{domain}. "' added";
-print " for user `" .$domain{owner}. "'" if defined $domain{owner};
-say ".";
+if (defined $domain{owner}) {
+ print "New domain `" .$domain{domain}. "' added";
+ print " for user `" .$domain{owner}. "'" if defined $domain{owner};
+ say ".";
+}
+else {
+ say "New non self-managed domain `" .$domain{domain}. "' added.";
+}
# Create aliases.
@@ -211,7 +223,7 @@ sub create_alias {
my $res = $ldap->alias->search(\%alias);
if ($res->count) {
- print STDERR "Warning: Alias `" .$alias{address}. "' already exists.";
+ print STDERR "WARN: Alias `" .$alias{address}. "' already exists.";
print STDERR "(Targetting to ";
print STDERR (join ', ', map { '`' .$_->{goto}. "'"} ($res->entries));
say STDERR ".)";
diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm
index 5b57cd3..22c6064 100755
--- a/lib/Fripost/Schema.pm
+++ b/lib/Fripost/Schema.pm
@@ -6,6 +6,9 @@ use strict;
use Fripost::Schema::Search;
use Fripost::Schema::Type;
+use Fripost::Schema::Type::User;
+use Fripost::Schema::Type::Domain;
+use Fripost::Schema::Type::Alias;
use base qw/Net::LDAP/;
our $VERSION = '0.01';
@@ -55,13 +58,13 @@ sub search {
my $self = shift;
my $res;
if ( $self->{_type} == MAILBOX ) {
- $res = $self->_searchUser(@_)
+ $res = $self->Fripost::Schema::Type::User::search(@_)
}
elsif ( $self->{_type} == DOMAIN ) {
- $res = $self->_searchDomain(@_)
+ $res = $self->Fripost::Schema::Type::Domain::search(@_)
}
elsif ( $self->{_type} == ALIAS ) {
- $res = $self->_searchAlias(@_)
+ $res = $self->Fripost::Schema::Type::Alias::search(@_)
}
else {
die "Something weird happened. Please report."
@@ -72,230 +75,46 @@ sub search {
}
-# Add.
sub add {
my $self = shift;
if ( $self->{_type} == MAILBOX ) {
- $self->_addUser(@_)
+ $self->Fripost::Schema::Type::User::add(@_)
}
elsif ( $self->{_type} == DOMAIN ) {
- $self->_addDomain(@_)
+ $self->Fripost::Schema::Type::Domain::add(@_)
}
elsif ( $self->{_type} == ALIAS ) {
- $self->_addAlias(@_)
+ $self->Fripost::Schema::Type::Alias::add(@_)
}
else {
- die "Something weird happened. Please report."
- }
-}
-
-
-# Disconnect to the LDAP server.
-sub unbind {
- $_[0]->{_ldap}->unbind();
-}
-
-
-#######################################################################
-# Search
-
-# Search a user, and return the corresponding entries if found. If no
-# user is given, returns all users.
-sub _searchUser {
- 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;
-}
-
-
-# Search a domain, and return the corresponding entries if found. If no
-# domain is given, returns all domains. If the given domain has a
-# defined owner, scope the search for this very owner only. If the
-# owner is undefined, but still exists, scope the search to the "global"
-# domains only.
-sub _searchDomain {
- my $self = shift;
-
- my $base = $self->{_options}->{base_dn};
- if (exists $_[0]->{owner}) {
- if (defined $_[0]->{owner}) {
- $base = join ',', ('uid='.$_[0]->{owner},'ou=mailboxes',$base);
- }
- else {
- $base = join ',', ('ou=domains',$base);
- }
+ die "Something weird happened. Please report.";
}
-
- my $filter = '(ObjectClass=virtualDomain)';
- $filter = "(&" .$filter. "(dc=" .$_[0]->{domain}. ")" .")"
- if defined $_[0]->{domain};
-
- my $res = $self->{_ldap}->search(
- base => $base,
- scope => 'subtree',
- attrs => [ 'dc', 'isActive' ],
- filter => $filter
- );
- die "Error: " .$res->error. "\n" if $res->code;
-
- return $res;
}
-# Search an alias, and return the corresponding entries if found. If no
-# alias is given, returns all aliases. If the given alias has a
-# defined owner, scope the search for this very owner only. If the
-# owner is undefined, but still exists, scope the search to the "global"
-# domains only.
-sub _searchAlias {
+sub password {
my $self = shift;
-
- my $base = $self->{_options}->{base_dn};
- if (exists $_[0]->{owner}) {
- if (defined $_[0]->{owner}) {
- $base = join ',', ('uid='.$_[0]->{owner},'ou=mailboxes',$base);
- }
- else {
- $base = join ',', ('ou=domains',$base);
- }
- }
- $base = 'dc=' .$_[0]->{domain}. ',' .$base
- if (exists $_[0]->{owner}) and (defined $_[0]->{domain});
-
- 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];
+ if ( $self->{_type} == MAILBOX ) {
+ $self->Fripost::Schema::Type::User::pwd(@_);
}
- elsif ($#filters > 0) {
- $filter = '(&' . (join '', @filters) . ')';
+ elsif ( $self->{_type} == DOMAIN ) {
+ die "Cannot change the password of a domain.";
}
-
- 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
-
-# Add a user
-sub _addUser {
- my $self = shift;
- my $user = shift;
-
- my $base = join ',', ('ou=mailboxes',$self->{_options}->{base_dn});
-
- my $res = $self->{_ldap}->add( 'uid=' .$user->{username}. ',' .$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;
-}
-
-
-# Add a domain.
-sub _addDomain {
- my $self = shift;
- my $domain = shift;
-
- my $base = $self->{_options}->{base_dn};
- if (defined $domain->{owner}) {
- $base = join ',', ('uid=' .$domain->{owner},'ou=mailboxes',$base)
+ elsif ( $self->{_type} == ALIAS ) {
+ die "Cannot change the password of an alias.";
}
else {
- $base = join ',', ('ou=domains',$base);
+ die "Something weird happened. Please report.";
}
-
- my $res = $self->{_ldap}->add( 'dc=' .$domain->{domain}. ',' .$base,
- attrs => [ dc => $domain->{domain},
- objectClass => [ 'top', 'virtualDomain' ],
- isActive => $domain->{isActive}
- ]
- );
- die "Error: " .$res->error. "\n" if $res->code;
- return $res;
}
-# Add an alias
-sub _addAlias {
- 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 = $self->{_options}->{base_dn};
- if (defined $alias->{owner}) {
- $base = join ',', ('uid=' .$alias->{owner},'ou=mailboxes',$base)
- }
- else {
- $base = join ',', ('ou=domains',$base);
- }
- $base = 'mailTarget='.$alias->{goto}.
- ','.'dc='. (split /\@/, $alias->{address}, 2)[1].
- ','.$base;
-
- my @attrs = ( mailLocalAddress => $alias->{address}
- , isActive => $alias->{isActive} );
- my $res;
- if ($self->_searchAlias($alias)->count) {
- $res = $self->{_ldap}->modify( $base, attrs => [ @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;
+# Disconnect to the LDAP server.
+sub unbind {
+ $_[0]->{_ldap}->unbind();
}
-
-#######################################################################
-# Miscellaneous
-
# Debug print.
sub _dsay {
my $self = shift;
@@ -306,6 +125,8 @@ sub _dsay {
}
+#######################################################################
+
1;
=head1 NAME
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__