aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem.moulin@fripost.org>2012-04-15 22:04:31 +0200
committerGuilhem Moulin <guilhem.moulin@fripost.org>2012-04-15 22:04:31 +0200
commit033af5c7de65c2ba38c45ba649ad29823bfb7141 (patch)
tree5b9f93fe22dd61c71b0a711c0fefa8e91d1d6c31 /lib/Fripost
parentb1fe11c6c9ae79bd8714ba7e627cff1665198fd4 (diff)
fripost-adduser: LDAP ready
Diffstat (limited to 'lib/Fripost')
-rwxr-xr-xlib/Fripost/Prompt.pm19
-rwxr-xr-xlib/Fripost/Schema.pm91
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