#!/usr/bin/perl

use 5.010_000;
use warnings;
use strict;
use utf8;

=head1 NAME

fripost-newdomain - Add a new domain to the system

=head1 SYNOPSIS

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 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.
Several users can manage the same domain together. (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<-v>, B<--verbose>

Verbose mode.

=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. Defaults to C<ldap://127.0.0.1:389>.

=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 YAML::Syck;

## Get command line options
our $conf = LoadFile( catfile ($HOME, '.fripost.yml') );

GetOptions(
    'server_host=s' => \$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},
    '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 );


# Define the domain that is to be added.
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 '') {
        $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');
}


{
    # 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}) {
    vsay "Nothing to do since we are only pretending...";
    exit 0;
}


# 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 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 "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{owner} = $owner if defined $owner;
    $alias{isActive} = 'TRUE';
    $ldap->alias->add( \%alias );
    say "Created alias from $from to $to.";
}

create_alias($ldap, 'abuse@' . $domain{domain}     ,'abuse@fripost.org', $domain{owner});
create_alias($ldap, 'postmaster@' . $domain{domain},'postmaster@fripost.org', $domain{owner});

$ldap->unbind();


=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
under the same terms as perl itself.

=cut