package Fripost::Commands::add_domain; use 5.010_000; use warnings; use strict; use utf8; =head1 NAME add_domain - Add a new virtual domain. =cut use FindBin qw($Bin); use lib "$Bin/lib"; use Fripost::Password; use Fripost::Prompt; use Fripost::Schema; use Email::Valid; our $VERSION = '0.01'; sub main { my $ldap = shift; my $conf = shift; # Define the domain that is to be added. my %domain; $domain{domain} = shift; $domain{owner} = shift; $domain{isActive} = 'TRUE'; prompt_if_undefined ( "New domain name: ", \$domain{domain}, [ 'Invalid domain' => sub { Email::Valid->address('fake@'.$_) } , 'Domain exists' => sub { defined $conf->{force} or $ldap->domain->search({ domain => $_ })->count == 0 } ] ); prompt_if_undefined ( "Belongs to user: ", \$domain{owner}, [ rewrite => sub { fix_username $_ } , 'Invalid e-mail' => sub { Email::Valid->address($_) } , 'Unknown domain' => sub { $ldap->domain->search({ domain => (split /\@/, $_, 2)[1] })->count } , 'Unknown username' => sub { $ldap->user->search({ username => $_ })->count } , "Already owns `$domain{domain}'" => sub { $ldap->domain->search({ domain => $domain{domain}, owner => $_ })->count == 0 } ] ) unless defined $domain{owner} and $domain{owner} eq ''; undef $domain{owner} if $domain{owner} eq ''; if ($conf->{pretend}) { say STDERR "Did not add the domain since we are pretending." if $conf->{verbose} or $conf->{debug}; } else { # Add the domain. $ldap->domain->add(\%domain); if (defined $domain{owner}) { say "New domain `" .$domain{domain}. "' added for user `" .$domain{owner}. "'."; } else { say "New non self-managed domain `" .$domain{domain}. "' added."; } create_alias($ldap, 'abuse@' . $domain{domain}, 'abuse@fripost.org'); create_alias($ldap, 'postmaster@' . $domain{domain}, 'postmaster@fripost.org'); } } # Create aliases. sub create_alias { my ($ldap, $from, $to) = @_; my %alias = (address => $from, goto => $to); my $res = $ldap->alias->search(\%alias); if ($res->count) { say STDERR "WARN: Alias $alias{address} already exists." ." (Targetting to " . (join ', ', map { $_->{goto} } $res->entries) .".)"; return if grep { $_->{goto} eq $alias{goto} } $res->entries; } $alias{isActive} = 'TRUE'; $ldap->alias->add( \%alias ); say "Created alias from $from to $to."; } =head1 AUTHOR Stefan Kangas C<< >> Guilhem Moulin C<< >> =head1 COPYRIGHT Copyright 2010,2011 Stefan Kangas. 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. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. =cut 1; # End of add_domain.pm __END__