aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xfripost-newdomain222
1 files changed, 191 insertions, 31 deletions
diff --git a/fripost-newdomain b/fripost-newdomain
index 99c2ce3..155e6ae 100755
--- a/fripost-newdomain
+++ b/fripost-newdomain
@@ -9,76 +9,236 @@ use utf8;
fripost-newdomain - Add a new domain to the system
+=head1 SYNOPSIS
+
+B<fripost-newdomain> [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.
+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.
+Several users can manage the same domain togother. (TODO: is that what we
+want?) If B<fripost-newdomain> warns if it is asked to register an existing
+domain to a new owner.
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<--pretend>
+
+Only simulates the insertion. (But still query the LDAP server to ensure
+that I<domain> is not already in the database, and that the owner
+exists.)
+
+=item B<--owner=>I<username>
+
+By default, the user is prompted for the owner of the new domain. It is
+possible to use this option instead. Also, to create a domain that is
+not owned by anyone, hence only managed by the administrators, use
+B<--owner=>I<''>.
+
+=item B<--server_host=>I<host>
+
+The LDAP URI to connect to.
+The default value is read from the configuration file, see B<CONFIGURATION>.
+
+=item B<--bind_dn=>I<binddn>
+
+The Distinguished Name (DN) to bind to the LDAP directory.
+(If not set, B<fripost-newdomain> binds anonymously.)
+The default value is read from the configuration file, see B<CONFIGURATION>.
+
+=item B<--bind_pw=>I<password>
+
+The password to to bind with.
+The default value is read from the configuration file, see B<CONFIGURATION>.
+
+=item B<--base_dn=>I<basedn>
+
+The root DN for everything done by B<fripost-newdomain>.
+The default value is read from the configuration file, see B<CONFIGURATION>.
+
+=item B<--debug>
+
+Debug mode.
+
+=back
+
+=head1 CONFIGURATION
+
+The configuration is read from the file C<$HOME/.fripost.yml>.
+Valid keys include:
+
+=over 4
+
+=item I<server_host>
+
+The LDAP URI to connect to. It has to be set, either in the
+configuration file, or using the command line option B<--server_host>.
+
+=item I<bind_dn>
+
+The Distinguished Name (DN) to bind to the LDAP directory.
+(If not set, B<fripost-newdomain> binds anonymously.)
+
+=item I<bind_pw>
+
+The password to to bind with.
+
+=item I<base_dn>
+
+The root DN for everything done by B<fripost-newdomain>.
+
+=back
+
=cut
use FindBin qw($Bin);
use lib "$Bin/lib";
+use Env qw /HOME/;
+use File::Spec::Functions;
+
use Data::Dumper;
use Fripost::Password;
use Fripost::Prompt;
use Fripost::Schema;
+use Getopt::Long qw /:config noauto_abbrev no_ignore_case
+ gnu_compat bundling permute nogetopt_compat
+ auto_version auto_help/;
+use Pod::Usage;
+use Email::Valid;
use IO::Prompt;
-use Getopt::Long;
use YAML::Syck;
## Get command line options
-our $conf = LoadFile('default.yml');
+our $conf = LoadFile( catfile ($HOME, '.fripost.yml') );
GetOptions(
- 'dbi_dsn' => \$conf->{dbi_dsn},
- 'admuser=s' => \$conf->{admuser},
- 'admpass=s' => \$conf->{admpass},
- 'pretend' => \$conf->{pretend},
-) or die "Unable to get command line options.";
+ 'server_host' => \$conf->{server_host},
+ 'base_dn=s' => \$conf->{base_dn},
+ 'bind_dn=s' => \$conf->{bind_dn},
+ 'bind_pw=s' => \$conf->{bind_pw},
+ 'pretend' => \$conf->{pretend},
+ 'owner=s' => \$conf->{owner},
+ 'debug' => \$conf->{debug},
+ 'man' => sub { pod2usage(-exitstatus => 0,
+ -verbose => 2) }
+) or pod2usage(2);
+
-# Connect to the database
-my $schema = Fripost::Schema->connect(
- $conf->{dbi_dsn}, $conf->{admuser}, $conf->{admpass}, {} #\%dbi_params
-);
+# Connect to the LDAP server
+my $ldap = Fripost::Schema->new( $conf );
+
+# Define the domain that is to be added.
my %domain;
-$domain{domain} = prompt "Domain name: ";
-$domain{description} = prompt_email("Belongs to user: ", 'is_user');
+$domain{domain} = $ARGV[0];
+$domain{domain} //= prompt "Domain name: ";
+$domain{isActive} = 'TRUE';
+if (defined $conf->{owner}) {
+ if ($conf->{owner} eq '') {
+ $domain{owner} = undef
+ }
+ else {
+ Email::Valid->address($conf->{owner})
+ or die "Error: `" .$conf->{owner}. "' is not a valid e-mail.\n";
+ $domain{owner} = $conf->{owner};
+ }
+}
+else {
+ $domain{owner} = prompt_email("Belongs to user: ", 'is_user');
+}
+
+
+# Checks.
+{
+ # Check that the owner exists.
+ die "Error: Unknown user `" .$domain{owner}. "'.\n"
+ unless (not defined $domain{owner})
+ or $ldap->user->search($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 "Warning: 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";
+ }
+}
-## TODO: Make sure the user does exists
-## TODO: Warn if the user has a domain already
if ($conf->{pretend}) {
say "Nothing to do since we are only pretending...";
exit 0;
}
-## Insert domain into database
-my $db_domain = $schema->resultset('Domain')->new(\%domain);
-$db_domain->insert;
-say "New domain $domain{domain} added.";
-sub create_alias {
- my ($schema, $from, $to, $domain) = @_;
-
- my $alias = $schema->resultset('Alias')->new({
- address => $from,
- goto => $to,
- domain => $domain,
- });
+# Add the domain.
+$ldap->domain->add(\%domain);
+print "New domain `" .$domain{domain}. "' added";
+print " for user `" .$domain{owner}. "'" if defined $domain{owner};
+say ".";
- $alias->insert;
- say "Created alias from $from to $to";
+# Create aliases.
+sub create_alias {
+ my ($ldap, $from, $to, $owner) = @_;
+
+ my %alias = (address => $from, goto => $to);
+
+ my $res = $ldap->alias->search(\%alias);
+ if ($res->count) {
+ print STDERR "Warning: 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{owner} = $owner if defined $owner;
+ $alias{isActive} = 'TRUE';
+ $ldap->alias->add( \%alias );
+ say "Created alias from $from to $to.";
}
-create_alias($schema, 'abuse@' . $domain{domain} ,'abuse@fripost.org' ,$domain{domain});
-create_alias($schema, 'postmaster@' . $domain{domain},'postmaster@fripost.org',$domain{domain});
+create_alias($ldap, 'abuse@' . $domain{domain} ,'abuse@fripost.org', $domain{owner});
+create_alias($ldap, 'postmaster@' . $domain{domain},'postmaster@fripost.org', $domain{owner});
=head1 AUTHOR
Stefan Kangas C<< <skangas at skangas.se> >>
+Guilhem Moulin C<< <guilhem at fripost.org> >>
+
=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