fripost-newdomain is LDAP ready.

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