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

package LATMOS::Accounts::Bases::Ad;

use 5.010000;
use strict;
use warnings;

use base qw(LATMOS::Accounts::Bases::Ldap);
use Net::LDAP;
use Net::LDAP::Entry;
use Net::LDAP::Control::Paged;
use Net::LDAP::Constant qw( LDAP_CONTROL_PAGED ); 
use Net::LDAP::Util     qw( escape_filter_value );
use Unicode::Map8;
use Unicode::String qw(utf16);
use LATMOS::Accounts::Log;

our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0];

=head1 NAME

LATMOS::Ad - Perl extension for blah blah blah

=head1 SYNOPSIS

  use LATMOS::Ad;
  blah blah blah

=head1 DESCRIPTION

Stub documentation for LATMOS::Ad, created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.

Blah blah blah.

=head1 FUNCTIONS

=cut

=head2 new(%config)

Create a new LATMOS::Ad object for windows AD $domain.

config:

=over 4

=item domain

The Active directory domain

=item server (optional)

If set, try to connect to this server, if not set, a dns query is performed
to find AD server, first responding is used.

=item ssl

If set, try to connect using ssl

=item OBJECT_container

The sub path where to find object type of OBJECT and where they should
be created

=back

=cut

sub new {
    my ($class, %config) = @_;
    
    $config{domain} or do {
        la_log(LA_ERR,
            "Cannot instanciate base %s w/o domain name",
            $config{label} || '(unknown label)'
        );
        return;
    };

    my $self = {
        _top_dn => join(',', map { "dc=$_" } split('\.', $config{domain})),
    };

    bless($self, $class);
}

sub load {
    my ($self) = @_;

    # If already load, just say ok !
    $self->{_ldap} and return 1;

    # At this point, if still no $server, DNS search

    my $ldap;
    my @ldapservers = ($self->config('server')
        ? ($self->_ldap_url($self->config('server')))
        : ($self->_query_zone_ads)) or do {
        la_log(LA_ERR,
            "Cannot find any ldap server for domain %s", $self->ad_domain);
        return;
    };
    foreach my $tryserv (@ldapservers) {
        $self->log(LA_DEBUG, "Trying to connect to ldap %s", $tryserv);
        $ldap = Net::LDAP->new(
            $tryserv,
        ) and last;
    }
 
    if($ldap) {
        $self->log(LA_DEBUG, "Connect to ldap server done");
    } else {
        $self->log(LA_ERR, "Cannot connect to any ldap server");
        return; # cannot connect to any ldap :\
    };

    my $login = $self->config('login');
    $login =~ m/@/ or $login .= '@' . $self->ad_domain;

    my $msg = $ldap->bind($login, password => $self->config('password'));
    $msg->code and do {
        $self->log(LA_ERR, "Cannot bind ldap: %s", $msg->error);
        return;
    };

    $self->{_ldap} = $ldap;
    return 1;
}

sub _query_zone_ads {
    my ($self) = @_;
    require Net::DNS;
    my @urllist;

    my $resolver = Net::DNS::Resolver->new;
    my $query = $resolver->query("_ldap._tcp.dc._msdcs." . $self->ad_domain,
        "SRV") or return;
    foreach my $rr (
        sort { $a->priority <=> $b->priority || $a->weight <=> $b->weight }
        grep { $_->type eq 'SRV' } $query->answer) {
        push(@urllist, $self->_ldap_url($rr->target)); # $rr->port)); don't use port
    }

    @urllist
}

=head2 ad_domain

Return the active directory zone

=cut

sub ad_domain {
    return $_[0]->config('domain')
}

1;

__END__

=head1 SEE ALSO

=head1 AUTHOR

Olivier Thauvin, E<lt>olivier.thauvin@aerov.jussieu.frE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008 CNRS SA/CETP/LATMOS

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.


=cut