source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Ad.pm @ 1037

Last change on this file since 1037 was 1037, checked in by nanardon, 12 years ago

Kill redondant and not generic _param function

  • Property svn:keywords set to Id Rev
File size: 3.6 KB
Line 
1package LATMOS::Accounts::Bases::Ad;
2
3use 5.010000;
4use strict;
5use warnings;
6
7use base qw(LATMOS::Accounts::Bases::Ldap);
8use Net::LDAP;
9use Net::LDAP::Entry;
10use Net::LDAP::Control::Paged;
11use Net::LDAP::Constant qw( LDAP_CONTROL_PAGED ); 
12use Net::LDAP::Util     qw( escape_filter_value );
13use Unicode::Map8;
14use Unicode::String qw(utf16);
15use LATMOS::Accounts::Log;
16
17our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0];
18
19=head1 NAME
20
21LATMOS::Ad - Perl extension for blah blah blah
22
23=head1 SYNOPSIS
24
25  use LATMOS::Ad;
26  blah blah blah
27
28=head1 DESCRIPTION
29
30Stub documentation for LATMOS::Ad, created by h2xs. It looks like the
31author of the extension was negligent enough to leave the stub
32unedited.
33
34Blah blah blah.
35
36=head1 FUNCTIONS
37
38=cut
39
40=head2 new(%options)
41
42Create a new LATMOS::Ad object for windows AD $domain.
43
44options:
45
46=over 4
47
48=item domain
49
50The Active directory domain
51
52=item server (optional)
53
54If set, try to connect to this server, if not set, a dns query is performed
55to find AD server, first responding is used.
56
57=item ssl
58
59If set, try to connect using ssl
60
61=item OBJECT_container
62
63The sub path where to find object type of OBJECT and where they should
64be created
65
66=back
67
68=cut
69
70sub new {
71    my ($class, %options) = @_;
72   
73    $options{domain} or return;
74    my $self = {
75        _server => $options{server},
76        _ad_domain => $options{domain},
77        _top_dn => join(',', map { "dc=$_" } split('\.', $options{domain})),
78        _login => $options{login},
79        _password => $options{password},
80        _ssl => $options{ssl},
81    };
82
83    bless($self, $class);
84}
85
86sub load {
87    my ($self) = @_;
88
89    # If already load, just say ok !
90    $self->{_ldap} and return 1;
91
92    # At this point, if still no $server, DNS search
93
94    my $ldap;
95    my @ldapservers = ($self->{_server}
96        ? ($self->_ldap_url($self->{_server}))
97        : ($self->_query_zone_ads)) or do {
98        la_log(LA_ERR,
99            "Cannot find any ldap server for domain %s", $self->ad_domain);
100        return;
101    };
102    foreach my $tryserv (@ldapservers) {
103        $self->log(LA_DEBUG, "Trying to connect to ldap %s", $tryserv);
104        $ldap = Net::LDAP->new(
105            $tryserv,
106        ) and last;
107    }
108 
109    if($ldap) {
110        $self->log(LA_DEBUG, "Connect to ldap server done");
111    } else {
112        $self->log(LA_ERR, "Cannot connect to any ldap server");
113        return; # cannot connect to any ldap :\
114    };
115
116    my $login = $self->{_login};
117    $login =~ m/@/ or $login .= '@' . $self->ad_domain;
118
119    my $msg = $ldap->bind($login, password => $self->{_password});
120    $msg->code and do {
121        $self->log(LA_ERR, "Cannot bind ldap: %s", $msg->error);
122        return;
123    };
124
125    $self->{_ldap} = $ldap;
126    return 1;
127}
128
129sub _query_zone_ads {
130    my ($self) = @_;
131    require Net::DNS;
132    my @urllist;
133
134    my $resolver = Net::DNS::Resolver->new;
135    my $query = $resolver->query("_ldap._tcp.dc._msdcs." . $self->ad_domain,
136        "SRV") or return;
137    foreach my $rr (
138        sort { $a->priority <=> $b->priority || $a->weight <=> $b->weight }
139        grep { $_->type eq 'SRV' } $query->answer) {
140        push(@urllist, $self->_ldap_url($rr->target)); # $rr->port)); don't use port
141    }
142
143    @urllist
144}
145
146=head2 ad_domain
147
148Return the active directory zone
149
150=cut
151
152sub ad_domain {
153    return $_[0]->{_ad_domain}
154}
155
1561;
157
158__END__
159
160=head1 SEE ALSO
161
162=head1 AUTHOR
163
164Olivier Thauvin, E<lt>olivier.thauvin@aerov.jussieu.frE<gt>
165
166=head1 COPYRIGHT AND LICENSE
167
168Copyright (C) 2008 CNRS SA/CETP/LATMOS
169
170This library is free software; you can redistribute it and/or modify
171it under the same terms as Perl itself, either Perl version 5.10.0 or,
172at your option, any later version of Perl 5 you may have available.
173
174
175=cut
Note: See TracBrowser for help on using the repository browser.