From ccc5ce7bf9abe341119acb0aa4a8a138add41dc7 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Tue, 5 Jun 2012 09:49:33 +0200 Subject: Changing the command names to something more intuitive (hopefully). --- lib/Fripost/Commands/add_domain.pm | 150 +++++++++++++++++++++++++++++++++++++ 1 file changed, 150 insertions(+) create mode 100644 lib/Fripost/Commands/add_domain.pm (limited to 'lib/Fripost/Commands/add_domain.pm') diff --git a/lib/Fripost/Commands/add_domain.pm b/lib/Fripost/Commands/add_domain.pm new file mode 100644 index 0000000..4d53e35 --- /dev/null +++ b/lib/Fripost/Commands/add_domain.pm @@ -0,0 +1,150 @@ +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; +use IO::Prompter; + +our $VERSION = '0.01'; + +sub main { + my $ldap = shift; + my $conf = shift; + + # Define the domain that is to be added. + my %domain; + $domain{domain} = $_[0]; + $domain{domain} //= prompt "Domain name: "; + $domain{isActive} = 'TRUE'; + + # Ensure that the domain is valid. + die "Error: Invalid domain `$domain{domain}'.\n" + unless Email::Valid->address('fake@'.$domain{domain}); + + $domain{owner} = $_[1]; + $domain{owner} //= prompt_email("Belongs to user: ", 'is_user'); + + if ($domain{owner} eq '') { + $domain{owner} = undef + } + else { + die "Error: $domain{owner} is not a valid e-mail.\n" + unless Email::Valid->address($domain{owner}); + } + + # Check that the owner exists. + die "Error: Unknown user `" .$domain{owner}. "'.\n" + unless (not defined $domain{owner}) + or $ldap->user->search({ username => $domain{owner} })->count; + + # Check that the owner doesn't already own this very domain, or that the + # domain isn't an existing "global" domain. + if ($ldap->domain->search(\%domain)->count) { + print STDERR "Error: Domain `" .$domain{domain}. "' already exists"; + print STDERR " for user `" .$domain{owner}. "'" if defined $domain{owner}; + say STDERR "."; + exit 1; + } + + # If the domain exists (but is eg, owned by someone else), produce a + # warning. + my $res = $ldap->domain->search({ domain => $domain{domain} }); + if ($res->count) { + print STDERR "WARN: Domain `" .$domain{domain}. "' already exists."; + my @owners; + map { push @owners, @{$_->{owner}} if defined $_->{owner} } $res->entries; + if (@owners) { + print STDERR " (Owned by "; + print STDERR (join ', ', map { '`' .$_. "'"} @owners); + print STDERR ".)"; + } + print STDERR "\n"; + } + + 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}) { + 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_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) { + print STDERR "WARN: Alias $alias{address} already exists."; + print STDERR "(Targetting to "; + print STDERR (join ', ', map { $_->{goto} } $res->entries); + say STDERR ".)"; + return unless 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__ -- cgit v1.2.3