fripost-newalias is LDAP ready

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