diff options
| -rwxr-xr-x | fripost-adduser | 23 | ||||
| -rwxr-xr-x | fripost-newdomain | 30 | ||||
| -rwxr-xr-x | lib/Fripost/Schema.pm | 225 | ||||
| -rw-r--r-- | lib/Fripost/Schema/Type/Alias.pm | 108 | ||||
| -rw-r--r-- | lib/Fripost/Schema/Type/Domain.pm | 110 | ||||
| -rw-r--r-- | lib/Fripost/Schema/Type/User.pm | 100 |
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__ |