aboutsummaryrefslogtreecommitdiffstats
path: root/fripost-newalias
diff options
context:
space:
mode:
Diffstat (limited to 'fripost-newalias')
-rwxr-xr-xfripost-newalias183
1 files changed, 149 insertions, 34 deletions
diff --git a/fripost-newalias b/fripost-newalias
index 4592522..b638e06 100755
--- a/fripost-newalias
+++ b/fripost-newalias
@@ -11,41 +11,135 @@ fripost-newalias - Add a new alias to the system
=head1 SYNOPSIS
-fripost-newalias
-fripost-newalias GOTO FROM...
+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. It has to be set, either in the
+configuration file, or using the command line option B<--server_host>.
+
+=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::Password;
use Fripost::Prompt;
use Fripost::Schema;
use IO::Prompt;
-use Getopt::Long;
+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('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.";
-
-# Connect to the database
-my $schema = Fripost::Schema->connect(
- $conf->{dbi_dsn}, $conf->{admuser}, $conf->{admpass}, {} #\%dbi_params
-);
+ '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},
+ '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);
@@ -59,51 +153,68 @@ say "goto adress: $goto";
# Show from adresses
@addr = grep {
if (Email::Valid->address($_)) {
- 1;
+ # 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 {
- say "WARN: skipping invalid address $_";
+ warn "WARN: Skipping invalid address `" .$_. "'.\n";
undef;
}
} @addr;
if (@addr == 0) {
- say "No valid destination adresses. Aborting...";
+ 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 = $schema->resultset('Alias')->search({
- address => $addr,
- });
+ my $rs = $ldap->alias->search({ address => $addr });
if (!$rs->count) {
- my $db_alias = $schema->resultset('Alias')->new({
- address => $addr,
- goto => $goto,
- domain => (split /\@/, $addr)[1],
- });
- if (!$conf->{pretend}) {
- $db_alias->insert;
- say "New alias added from $addr to $goto.";
- } else {
- say "Pretending, will not add alias."
+ 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 {
- say "There already exists an alias for $addr.";
+ 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@fripost.org>',
+ From => encode('MIME-Q', 'Friposts administratörer') . ' <' .$admin_email. '>',
Subject => encode('MIME-Q', 'Nya alias till din inkorg'),
Encoding => 'quoted-printable',
);
@@ -126,7 +237,7 @@ my $msg = MIME::Lite->new(
say "Sent verification.";
}
else {
- say "Pretending, will not send verification.";
+ vsay "Pretending, will not send verification.";
}
}
@@ -134,10 +245,14 @@ my $msg = MIME::Lite->new(
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