1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
package Fripost::Schema::Type::User;
use 5.010_000;
use warnings;
use strict;
use base qw/Net::LDAP/;
use Fripost::Schema::Utils;
our $VERSION = '0.01';
#######################################################################
# Search a user, and return the corresponding entries if found. If no
# user is given, returns all users.
# If the user has no domain part, returns matching users for any
# domains.
sub search {
my $self = shift;
my $user = shift;
my ($username, $domain);
($username, $domain) = split /\@/, $user->{username}, 2
if defined $user->{username};
my $base = $self->{_options}->{base_dn};
$base = join ',', ( 'dc='.$domain, $base )
if defined $domain;
my $filter = "(ObjectClass=virtualMailbox)";
$filter = "(&" .$filter. "(uid=" .$username. ")" .")"
if defined $username;
if ($self->{_options}->{debug}) {
say STDERR "DEBUG: Search base: " .$base;
say STDERR "DEBUG: Search filter: " .$filter;
}
my $res = $self->{_ldap}->search(
base => $base,
scope => 'sub',
attrs => [ 'uid', 'gn' , 'sn', 'isActive' ],
filter => $filter
);
die "Error: " .$res->error. "\n" if $res->code;
return $res;
}
# Add the given user
sub add {
my $self = shift;
my $user = shift;
my $base = Fripost::Schema::Utils::mkDN ( $self->{_options}
, $user->{username} );
if ($self->{_options}->{debug}) {
say STDERR "DEBUG: Add base: " .$base;
}
my $res = $self->{_ldap}->add( $base,
attrs => [ objectClass => 'virtualMailbox',
userPassword => $user->{userPassword},
isActive => $user->{isActive}
]
);
die "Error: " .$res->error. "\n" if $res->code;
return $res;
}
# Change password
sub passwd {
my $self = shift;
my $user = shift;
my $base = Fripost::Schema::Utils::mkDN ( $self->{_options}
, $user->{username} );
if ($self->{_options}->{debug}) {
say STDERR "DEBUG: Modify base: " .$base;
}
my $res = $self->{_ldap}->modify( $base,
replace => [ userPassword => $user->{userPassword} ]
);
die "Error: " .$res->error. "\n" if $res->code;
return $res;
}
#######################################################################
1;
=head1 NAME
Fripost::Schema::Type::User -
=head1 AUTHOR
Guilhem Moulin C<< <guilhem at fripost.org> >>
=head1 COPYRIGHT
Copyright 2012 Guilhem Moulin, all rights reserved.
=head1 LICENSE
This program is free software; you can redistribute it and/or modify it
under the same terms as perl itself.
=cut
1; # End of User.pm
__END__
|