|
package Torus::Driver::ldap; |
|
|
|
|
|
require Exporter; |
|
|
our @ISA = qw(Exporter); |
|
|
our @EXPORT = qw( ); |
|
|
|
|
|
use strict; |
|
|
use warnings; |
|
|
|
|
|
# load configuration-data from ini-file |
|
|
BEGIN { |
|
|
use loadConfig; |
|
|
} |
|
|
|
|
|
use Net::LDAP; |
|
|
use Net::LDAP::Entry; |
|
1 |
#use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset); |
#use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset); |
2 |
use Data::Transform::Encode qw( var2utf8 var_utf2iso ); |
use Data::Transform::Encode qw( var2utf8 var_utf2iso ); |
|
use Data::Storage::Handler::File qw( a2f ); |
|
3 |
use Data::Dumper; |
use Data::Dumper; |
4 |
|
|
5 |
my $hr = "=" x 80 . "\n"; |
my $hr = "=" x 80 . "\n"; |
16 |
# ================================================== |
# ================================================== |
17 |
# configure here |
# configure here |
18 |
# ================================================== |
# ================================================== |
19 |
my $binddn = 'cn=root, dc=labnet, dc=de'; |
#my $binddn = 'cn=root, dc=labnet, dc=de'; |
20 |
|
my $binddn = 'cn=admin, o=netfrag.org, c=de'; |
21 |
|
#my $binddn = 'cn=admin'; |
22 |
|
|
23 |
# V1: hardcoded target ou |
# V1: hardcoded target ou |
24 |
#my $basedn = 'ou=Adressen, dc=labnet, dc=de'; |
#my $basedn = 'ou=Adressen, dc=labnet, dc=de'; |
31 |
organizationalPerson |
organizationalPerson |
32 |
pilotPerson |
pilotPerson |
33 |
groupOfNames |
groupOfNames |
|
msMapi |
|
34 |
) ]; |
) ]; |
35 |
|
# msMapi |
36 |
# outlookPerson |
# outlookPerson |
37 |
|
|
38 |
# |
# |
44 |
my $ldap; |
my $ldap; |
45 |
my $map; |
my $map; |
46 |
|
|
|
my $ldap_errors_file = '../log/ldap_errors.log'; |
|
|
sub ldapError { |
|
|
my $message = shift; |
|
|
#print Dumper($message); |
|
|
my $textMessage = $message->error . " - code: " . $message->code; |
|
|
$textMessage .= " - dn: " . $message->{matchedDN} if $message->{matchedDN}; |
|
|
#print "msg: '$textMessage'", "\n"; |
|
|
a2f($ldap_errors_file, $textMessage) if !$TRACELEVEL; |
|
|
return $message; |
|
|
} |
|
|
|
|
|
sub connectStore { |
|
|
|
|
|
#print Dumper($config->get("ldapserver_host")); |
|
|
|
|
|
#$ldap = Net::LDAP->new('localhost', onerror => 'warn'); |
|
|
$ldap = Net::LDAP->new( |
|
|
$config->get("ldapserver_host"), |
|
|
#port => 389, |
|
|
#timeout => 120, |
|
|
debug => 0, |
|
|
#async => 1, |
|
|
#onerror => 'warn', |
|
|
onerror => \&ldapError, |
|
|
#version => 3, |
|
|
) |
|
|
or die("could not connect to ldap-server!"); |
|
|
|
|
|
$ldap->bind ( |
|
|
$binddn, |
|
|
password => 'Geheim' |
|
|
) or die "$@"; |
|
|
|
|
|
} |
|
|
|
|
|
sub disconnectStore { |
|
|
$ldap->unbind; # take down session |
|
|
} |
|
47 |
|
|
48 |
sub getEntry { |
sub getEntry { |
49 |
|
|
328 |
close(FH); |
close(FH); |
329 |
} |
} |
330 |
|
|
|
sub createOuSafe { |
|
|
|
|
|
#my $basedn = shift; |
|
|
#my $cn = shift; |
|
|
|
|
|
#my $dn = 'cn=' . $cn . ', ' . $basedn; |
|
|
my $dn = shift; |
|
|
|
|
|
#print "orig-dn: $dn", "\n"; |
|
|
|
|
|
$dn =~ m/ou=([\w|\.]+?)[,|].*/; |
|
|
my $ou = $1; |
|
|
#print "ou: '$ou'", "\n"; |
|
|
|
|
|
my $basedn = $dn; |
|
|
$basedn =~ s/ou=$ou, //; |
|
|
#print "basedn: $basedn", "\n"; |
|
|
#exit; |
|
|
|
|
|
print "checking ou: (basedn='$basedn', ou='$ou')", "\n" if $DEBUGLEVEL > 3; |
|
|
# if (checkOu($basedn, $ou)) { |
|
|
if (existsEntry('ou', $dn)) { |
|
|
return $dn; |
|
|
} |
|
|
|
|
|
if (my @ou_address = split(/\./, $ou)) { |
|
|
return createDeepOu($basedn, \@ou_address); |
|
|
} else { |
|
|
return createOu($dn, $ou); |
|
|
} |
|
|
|
|
|
} |
|
|
|
|
|
sub createDeepOu { |
|
|
my $basedn = shift; |
|
|
my $ou_address = shift; |
|
|
my $dn = $basedn; |
|
|
print "creating deep ou (basedn='$basedn')", "\n" if $DEBUGLEVEL > 3; |
|
|
foreach (@$ou_address) { |
|
|
my $ou = $_; |
|
|
#print "ou: $ou", "\n"; |
|
|
$dn = "ou=$ou, " . $dn; |
|
|
#print "dn: $dn", "\n"; |
|
|
createOu($dn, $ou); |
|
|
} |
|
|
return $dn; |
|
|
} |
|
|
|
|
|
sub createOu { |
|
|
my $dn = shift; |
|
|
my $ou = shift; |
|
|
print "creating ou (DN='$dn', OU='$ou')", "\n" if $DEBUGLEVEL > 3; |
|
|
my $entry = Net::LDAP::Entry->new; |
|
|
$entry->dn($dn); |
|
|
$entry->add( |
|
|
#cn => $cn, |
|
|
ou => $ou, |
|
|
objectClass => 'organizationalUnit', |
|
|
); |
|
|
my $result = $entry->update($ldap); |
|
|
#return $result; |
|
|
return $dn; |
|
|
} |
|
|
|
|
331 |
sub checkOu { |
sub checkOu { |
332 |
my $basedn = shift; |
my $basedn = shift; |
333 |
my $ou = shift; |
my $ou = shift; |
350 |
|
|
351 |
} |
} |
352 |
|
|
|
sub existsEntry { |
|
|
|
|
|
my $ldapType = shift; |
|
|
my $dn = shift; |
|
|
|
|
|
my $filter = "$ldapType =*"; |
|
|
#print "using filter: '$filter'", "\n"; |
|
|
|
|
|
# get part from full LDAP-address |
|
|
#print "dn: $dn", "\n"; |
|
|
#$dn =~ m/$ldapType=([\w|\.| ]+?)[,|].*/; |
|
|
#my $part = $1; |
|
|
|
|
|
# cut part |
|
|
#print "ldapType: $ldapType", "\n"; |
|
|
#print "part: $part", "\n"; |
|
|
#$dn =~ s/$ldapType=$part, //; |
|
|
|
|
|
# TODO: |
|
|
# - split 'ou' or 'cn' from 'dn' here to create a search-attribute (one) and a $basedn (a parent node) |
|
|
# - run search with $filter = 'ou|cn =*' (<part-from-regex>) and $basedn=(<rest-from-regex>) |
|
|
|
|
|
$filter = "(objectClass=*)"; |
|
|
#print "searching for dn='$dn' with filter='$filter'", "\n"; |
|
|
my $mesg = $ldap->search ( # perform a search |
|
|
base => $dn, |
|
|
filter => $filter, |
|
|
# filter => "(&(ou=*))" |
|
|
); |
|
|
|
|
|
#print "search-result-code: ", $mesg->code, "\n"; |
|
|
#print "search-result-error: ", $mesg->error, "\n"; |
|
|
|
|
|
#return; |
|
|
#print Dumper($mesg); |
|
|
#exit; |
|
|
|
|
|
#$mesg->code && die $mesg->error; |
|
|
|
|
|
return 1 if exists $mesg->{entries}; |
|
|
return 0; |
|
|
|
|
|
} |
|
353 |
|
|
354 |
sub buildSnCn { |
sub buildSnCn { |
355 |
my $parts = shift; |
my $parts = shift; |