fripost-adduser: LDAP ready

7 files changed, 282 insertions, 69 deletions

diff --git a/INSTALL b/INSTALL
index ea6f5c4..c8535d8 100644
--- a/INSTALL
+++ b/INSTALL
@@ -3,8 +3,8 @@ You need several CPAN modules to use these scripts.
 If you use Debian GNU/Linux, you can install them like so:
 
 sudo aptitude install -R libdatetime-format-mysql-perl libdatetime-perl \
-libdbd-mysql-perl libdbix-class-perl libemail-valid-perl libfile-slurp-perl \
-libio-prompt-perl libmime-base64-perl libmime-lite-perl libstring-mkpasswd-perl \
-libtemplate-perl libyaml-syck-perl
+libdigest-perl libemail-valid-perl libfile-slurp-perl libio-prompt-perl \
+libmime-base64-perl libmime-lite-perl libnet-ldap-perl \
+libstring-mkpasswd-perl libtemplate-perl libyaml-syck-perl
 
 This will most probably work for Ubuntu as well.
diff --git a/README b/README
index 6ab96ba..14c5af2 100644
--- a/README
+++ b/README
@@ -10,12 +10,13 @@ skangas@skangas.se
 
 Read installation file INSTALL and follow those instructions. 
 
-Copy file default.yml.template to default.yml, edit file default.yml and add the following
+Copy file fripost.yml.template to ~/.fripost.yml, edit it and add the following
 
-    admuser: <admin username>
-    admpass: <admin password>
+    bind_dn: <admin bind DN>
+    bind_pw: <admin bind password>
 
-where <admin username> and <admin password> are user name and password to the MySQL-server on <remote server> in next section.
+where <admin bind username> and <admin bind password> your own admin DN
+and password.
 
 Configure an locla Mail Transger Agent (MTA) for example exim4:
 
@@ -25,9 +26,9 @@ Choose use smarthost for outgoing and no local e-mail. Choos your IPS's SMTP ser
 
 #. Log in to server
 
-    $ ssh -vNfL 3306:localhost:3306 <remote server>
+    $ ssh -vNfL 389:localhost:389 <remote server>
 
-This opens an ssh-tunnel and returns to standard prompt. Use standard mysql port 3306. 
+This opens an ssh-tunnel and returns to standard prompt. Use standard LDAP port 389.
 
 #. Add a new mailbox.
 
@@ -51,6 +52,9 @@ The script prompts first for go-to address, which is where the new alias is supp
 
     $ fripost-passwd
 
+All these scripts have an integrated manual you can read using e.g.,
+`fripost-adduser --man'. A short help is also available with e.g.,
+`fripost-adduser --help'.
 
 Have fun!
 
diff --git a/default.yml.template b/default.yml.template
deleted file mode 100644
index 6e4314c..0000000
--- a/default.yml.template
+++ /dev/null
@@ -1,6 +0,0 @@
-# default.yml -- defaults for fripost administrative scripts
----
-dbi_dsn: dbi:mysql:mail;host=127.0.0.1;port=3306
-admin_email: admin@fripost.org
-admuser: root
-admpass: 
diff --git a/fripost-adduser b/fripost-adduser
index 5c21ef1..f13868d 100755
--- a/fripost-adduser
+++ b/fripost-adduser
@@ -9,60 +9,174 @@ use utf8;
 
 fripost-adduser - Add a new mailbox to the system
 
+=head1 SYNOPSIS
+
+B<fripost-adduser> [B<--verbose>] [B<--debug>] [B<--pretend>] [I<username>]
+[B<--password=>I<password>]
+
+=head1 DESCRIPTION
+
+B<fripost-adduser> adds a new mailbox to the system, unless B<--pretend>
+is set.
+If no I<username> or I<password> are given, the user is prompted for them.
+If I<username> is not fully qualified, C<fripost.org> is appended.
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<--prentend>
+
+Only simulates the insertion. (But still query the LDAP server to check
+if I<username> is already in the database.)
+
+=item B<--password=>I<password>
+
+By default, the user is prompted for his/her new password, which is
+hashed, salted and then inserted added to the LDAP entry.
+By using B<--password>, I<password> is inserted RAW in the database.
+This can be useful if the user does not want to give the clear copy but
+only a hash, for example.
+Using this option disables the sending of credentials.
+
+=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-adduser> 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-adduser>.
+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-adduser> 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-adduser>.
+
+=back
+
 =cut
 
 use FindBin qw($Bin);
 use lib "$Bin/lib";
 
+use Env qw /HOME/;
+use File::Spec::Functions;
+
 use Data::Dumper;
 use Encode qw(encode);
 use File::Slurp qw(slurp);
 use Fripost::Password;
 use Fripost::Prompt;
 use Fripost::Schema;
-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 IO::Prompt;
-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},
-    'debug'     => \$conf->{debug},
-    'pretend'   => \$conf->{pretend},
-    'verbose'   => \$conf->{verbose},
-) or die "Unable to get command line options.";
-
-sub dsay { say @_ if $conf->{debug}; }
-sub vsay { say @_ if $conf->{verbose} || $conf->{debug}; }
-
-# 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},
+    'debug'       => \$conf->{debug},
+    'pretend'     => \$conf->{pretend},
+    'v|verbose'   => \$conf->{verbose},
+    'password=s'  => \$conf->{password},
+    'man'         => sub { pod2usage(-exitstatus => 0,
+                                     -verbose => 2) }
+) or pod2usage(2);
+
+sub dsay { say STDERR @_ if $conf->{debug}; }
+sub vsay { say STDERR @_ if $conf->{verbose} || $conf->{debug}; }
+
+# Connect to the LDAP server
+my $ldap = Fripost::Schema->new( $conf );
+
+
+# Define the new user
 my $user;
 {
-    my $username = prompt_email("New username: ", 'is_user');
-    my $domain   = (split /\@/, $username)[1];
-    my $maildir  = "$domain/". (split /\@/, $username)[0] . "/Maildir/"; # trailing slash important
-    my $active   = 1;
-    my $password = prompt_password();
+    my $username = $ARGV[0];
+    $username //= prompt_email("New username: ", 'is_user');
+
+    # Default domain
+    $username .= '@fripost.org' unless $username =~ /\@.+$/;
+
+    my ($domain, $login) = split /\@/, $username, 2;
+    my $maildir      = "$domain/$login/Maildir/"; # Trailing slash important
+    my $isActive     = 'TRUE';
+    my ($userPassword, $clearPassword);
+    if ( defined $conf->{password} ) {
+        $userPassword  = $conf->{password};
+    }
+    else {
+        $clearPassword = 'hop'; #prompt_password();
+        $userPassword  = hash( undef, undef, $clearPassword );
+    }
 
     $user = {
-        username => $username,
-        domain   => $domain,
-        maildir  => $maildir,
-        active   => $active,
-        password => $password,
+        username      => $username,
+        maildir       => $maildir,
+        isActive      => $isActive,
+        userPassword  => $userPassword,
     };
+    $user->{clearPassword} = $clearPassword unless defined $conf->{password};
 
     say "User name: $user->{username}";
     say "Password:  (hidden)";
@@ -70,19 +184,25 @@ my $user;
     confirm_or_abort();
 }
 
-die "User already exists"
-    if ($schema->resultset('Mailbox')->search({
-        username => $user->{username} })->count);
+die "Error: User already exists.\n"
+    if $ldap->searchUser($user->{username})->count;
+
 
-## Insert user into database
+## Insert the new user
 if ($conf->{pretend}) {
-    vsay "Did not create user since we are pretending."
+    vsay "Did not create user since we are pretending.";
 }
 else {
-    $schema->resultset('Mailbox')->new($user)->insert;
-    say "New account $user->{username} added.";
+    my %user = %$user;
+    delete $user{clearPassword};
+    $ldap->addUser(\%user);
+    say "New account $user{username} added.";
 }
 
+$ldap->unbind();
+
+
+
 ### Prepare sending emails
 
 my $tt = Template->new({
@@ -90,8 +210,11 @@ my $tt = Template->new({
     INTERPOLATE  => 1,
 }) || die "$Template::ERROR\n";
 
+my $admin_email = 'admin@fripost.org';
+$admin_email = $conf->{admin_email} if defined $conf->{admin_email};
 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', 'Välkommen till Fripost!'),
     Encoding => 'quoted-printable',
 );
@@ -130,11 +253,11 @@ if (confirm("Subscribe user to announce mailing list? ")) {
 }
 
 ### Send login credentials to new user
-{
+if (exists $user->{clearPassword}) {
     my ($vars, $data);
     $vars = {
         user => $user->{username},
-        pass => $user->{password},
+        pass => $user->{clearPassword},
     };
 
     $tt->process('user_info.tt', $vars, \$data)
@@ -164,10 +287,14 @@ if (confirm("Subscribe user to announce mailing list? ")) {
 
 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
diff --git a/fripost.yml.template b/fripost.yml.template
new file mode 100644
index 0000000..f278790
--- /dev/null
+++ b/fripost.yml.template
@@ -0,0 +1,8 @@
+# fripost.yml -- defaults for fripost administrative scripts
+# To be moved to ~/.fripost.yml
+---
+server_host: ldap://127.0.0.1:389
+admin_email: admin@fripost.org
+bind_dn: cn=admin,ou=managers,dc=mail,dc=fripost,dc=org
+bind_pw: xxxxxx
+base_dn: dc=mail,dc=fripost,dc=org
diff --git a/lib/Fripost/Prompt.pm b/lib/Fripost/Prompt.pm
index d90d42d..95ea7ea 100755
--- a/lib/Fripost/Prompt.pm
+++ b/lib/Fripost/Prompt.pm
@@ -15,7 +15,7 @@ use Data::Dumper;
 use Email::Valid;
 use Exporter;
 use IO::Prompt;
-use String::MkPasswd qw/mkpasswd/;
+use Fripost::Password qw/mkpasswd/;
 
 our @EXPORT = qw(confirm confirm_or_abort fix_username prompt_email prompt_password);
 our @ISA = qw(Exporter);
@@ -49,20 +49,20 @@ sub prompt_email {
     my ($msg, $is_username) = @_;
     $msg //= "Enter email: ";
     my $email;
-    while (not defined $email) {
+    do {
         $email = prompt $msg;
 
         if ($is_username) {
             $email = fix_username($email);
         }
 
-        if (!Email::Valid->address($email)) {
+        unless (Email::Valid->address($email)) {
             undef $email;
             say "This is not a valid e-mail address. Try again."
         }
     }
+    until (defined $email);
     return $email;
-    
 }
 
 sub prompt_password {
@@ -71,7 +71,7 @@ sub prompt_password {
     $msg2 //= "Enter new password again (blank for random): ";
 
     my $password;
-    while (not defined $password) {
+    do {
         $password   = prompt $msg,  -e => '*';
         my $confirm = prompt $msg2, -e => '*';
         unless ($password eq $confirm) {
@@ -79,13 +79,10 @@ sub prompt_password {
             say "Passwords do not match";
         }
     }
+    until (defined $password);
 
-    if (!length $password) {
-        $password = mkpasswd(
-            -length => 10,
-            -minnum => 2,
-            -minspecial => 2,
-        );
+    if ($password eq '') {
+        $password = mkpasswd();
         say "Using password: $password";    
     }
     return $password;
diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm
index c9cc832..8124a54 100755
--- a/lib/Fripost/Schema.pm
+++ b/lib/Fripost/Schema.pm
@@ -3,10 +3,93 @@ package Fripost::Schema;
 use 5.010_000;
 use strict;
 
-use base qw/DBIx::Class::Schema/;
+use base qw/Net::LDAP/;
 our $VERSION = '0.01';
 
-  __PACKAGE__->load_namespaces();
+# Initialize a connection to the LDAP host.
+sub new {
+    my $class = shift;
+    my $h = shift;
+
+    my $self = {options => $h};
+    bless $self, $class;
+    
+    my $ldap = Net::LDAP->new ( $h->{server_host} )
+        or die "Error: Cannot initialize connection to LDAP server.\n"; 
+
+    my $mesg;
+    if ( (defined $h->{bind_dn}) and $h->{bind_dn} ne '' ) {
+        $self->_dsay( "Binding to DN `" .$h->{bind_dn}. "'." );
+        $mesg = $ldap->bind( $h->{bind_dn}, password => $h->{bind_pw} );
+    }
+    else {
+        # Anonymous bind
+        $self->_dsay( "Anonymous bind." );
+        $mesg = $ldap->bind();
+    }
+    die "Error: " .$mesg->error. "\n" if $mesg->code;
+    
+    $self->{ldap} = $ldap;
+    return $self;
+}
+
+
+# Search a user, and return the corresponding entries if found. If no
+# user is given, returns all users.
+sub searchUser {
+    my $self = shift;
+    
+    my $base = join ',', ('ou=mailboxes',$self->{options}->{base_dn});
+    my $filter = "(ObjectClass=virtualMailbox)";
+
+    $filter = "(&" .$filter. "(uid=" .$_[0]. ")" .")"
+        if defined $_[0];
+
+    my $res = $self->{ldap}->search(
+                  base   => $base,
+                  scope  => 'one',
+                  attrs  => [ 'uid', 'gn' , 'sn', 'maildir', 'isActive' ],
+                  filter => $filter
+            );
+    die "Error: " .$res->error. "\n" if $res->code;
+
+    return $res;
+}
+
+# Add a user
+sub addUser {
+    my $self = shift;
+    my $user = shift;
+
+    my $base = join ',', ('ou=mailboxes',$self->{options}->{base_dn});
+
+    my $res = $self->{ldap}->add( 'uid=' .$user->{username}. ',' .$base,
+                attrs => [ uid          => $user->{username},
+                           objectClass  => [ 'top', 'virtualMailbox' ],
+                           userPassword => $user->{userPassword},
+                           maildir      => $user->{maildir},
+                           isActive     => $user->{isActive}
+                         ]
+              );
+    die "Error: " .$res->error. "\n" if $res->code;
+    return $res;
+}
+
+
+# Disconnect to the LDAP server.
+sub unbind {
+    $_[0]->{ldap}->unbind();
+}
+
+
+# Debug print.
+sub _dsay {
+    my $self = shift;
+    return unless (exists $self->{options}->{debug}) and $self->{options}->{debug};
+    print STDERR "Debug: ";
+    say STDERR @_;
+}
+
 
 1;
 
@@ -16,11 +99,11 @@ Fripost::Schema -
 
 =head1 AUTHOR
 
-Stefan Kangas C<< <skangas at skangas.se> >>
+Guilhem Moulin C<< <guilhem at fripost.org> >>
 
 =head1 COPYRIGHT
 
-Copyright 2010,2011 Stefan Kangas, all rights reserved.
+Copyright 2012 Guilhem Moulin, all rights reserved.
 
 =head1 LICENSE