2 files changed, 95 insertions, 15 deletions

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