path: root/fripost-newalias

#!/usr/bin/perl

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

=head1 NAME

fripost-newalias - Add a new alias to the system

=head1 SYNOPSIS

B<fripost-newalias> [B<--verbose>] [B<--debug>] [B<--pretend>] 
[I<goto> [I<from>...]]

=head1 DESCRIPTION

B<fripost-newalias> adds a new virtual alias to the system, unless
B<--pretend> is set.
If I<goto> or I<from> are not given, the user is prompted for them.
If I<goto> is not fully qualified, C<fripost.org> is appended.
If I<from> is already an existing username or alias,
B<fripost-newalias> raises an error.

=head1 OPTIONS

=over 8

=item B<--pretend>

Only simulates the insertion. (But still query the LDAP server to ensure
that the virtual domains of aliases are know, for example.)

=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-newalias> 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-newalias>.
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<admin_email>

The I<From:> e-mail address to use. Defaults to C<admin@fripost.org>.

=item I<bind_dn>

The Distinguished Name (DN) to bind to the LDAP directory.
(If not set, B<fripost-newalias> 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-newalias>.

=back


=cut

use FindBin qw($Bin);
use lib "$Bin/lib";

use Env qw /HOME/;
use File::Spec::Functions;

use Encode qw(encode);
use Email::Valid;
use Fripost::Prompt;
use Fripost::Schema;
use IO::Prompt;
use Getopt::Long qw /:config noauto_abbrev no_ignore_case
                             gnu_compat bundling permute nogetopt_compat
                             auto_version auto_help/;
use Pod::Usage;
use MIME::Base64;
use MIME::Lite;
use MIME::QuotedPrint;
use Template;
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},
    '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 );


# Get information
my $goto = fix_username(shift @ARGV);
my @addr = @ARGV;
$goto //= prompt_email("Alias goto address: ", 'is_user');
@addr || push @addr, prompt "Alias from address: ";

# Show goto adress
say "goto adress: $goto";

# Show from adresses
@addr = grep {
    if (Email::Valid->address($_)) {
        # Warn if the domain is unknown.
        my $domain = (split /\@/, $_, 2)[1];
        if ($ldap->domain->search({ domain => $domain })->count) {
            1;
        }
        else {
            warn "WARN: Skipping unknown domain `" .$domain. "'.\n";
            undef;
        }
    }
    else {
        warn "WARN: Skipping invalid address `" .$_. "'.\n";
        undef;
    }
} @addr;
if (@addr == 0) {
    warn "No valid destination adresses. Aborting...\n";
    exit 1;
}
say "from adress: " . (join " ", @addr);
confirm_or_abort();


## Insert alias into database
for my $addr (@addr) {
    my $rs = $ldap->alias->search({ address => $addr });
    if (!$rs->count) {
        if (!$ldap->user->search({ username => $addr })->count) {
            if (!$conf->{pretend}) {
                $ldap->alias->add({ address => $addr, goto => $goto,
                                    isActive => 'TRUE' });
                say "New alias added from $addr to $goto.";
            } else {
                vsay "Pretending, will not add alias."
            }
        }
        else {
            die "Error: Username $addr already exists.\n";
        }
    }
    else {
        print STDERR "Error: Alias $addr already exists. ";
        print STDERR "(Targetting to ";
        print STDERR (join ', ', map { $_->{goto} } ($rs->entries));
        say STDERR ".)";
        exit 1;
    }
}

$ldap->unbind();


### Prepare sending emails
my $tt = Template->new({
    INCLUDE_PATH => "$Bin/templ",
    INTERPOLATE  => 1,
}) || die "$Template::ERROR\n";

my $admin_email = $conf->{admin_email};
$admin_email  //= 'admin@fripost.org';
my $msg = MIME::Lite->new(
    From    => encode('MIME-Q', 'Friposts administratörer') . ' <' .$admin_email. '>',
    Subject => encode('MIME-Q', 'Nya alias till din inkorg'),
    Encoding => 'quoted-printable',
);

{
    my ($vars, $data);
    $vars = {
        addrs => \@addr,
    };

    $tt->process('new_alias.tt', $vars, \$data)
        || die $tt->error(), '\n';
    $msg->data($data);

    $msg->replace(To => $goto);
    
    if (!$conf->{pretend}) {
        confirm_or_abort("Send confirmation? ");
        $msg->send;
        say "Sent verification.";
    }
    else {
        vsay "Pretending, will not send verification.";
    }
}

=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