| 1 |
package Torus::Driver::ldap; |
| 2 |
|
| 3 |
require Exporter; |
| 4 |
our @ISA = qw(Exporter); |
| 5 |
our @EXPORT = qw( ); |
| 6 |
|
| 7 |
use strict; |
| 8 |
use warnings; |
| 9 |
|
| 10 |
# load configuration-data from ini-file |
| 11 |
BEGIN { |
| 12 |
use loadConfig; |
| 13 |
} |
| 14 |
|
| 15 |
use Net::LDAP; |
| 16 |
use Net::LDAP::Entry; |
| 17 |
#use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset); |
| 18 |
use Data::Transform::Encode qw( var2utf8 var_utf2iso ); |
| 19 |
use Data::Storage::Handler::File qw( a2f ); |
| 20 |
use Data::Dumper; |
| 21 |
|
| 22 |
my $hr = "=" x 80 . "\n"; |
| 23 |
|
| 24 |
# debugging? |
| 25 |
my $DEBUGLEVEL = $config->get("debug_level"); |
| 26 |
my $TRACELEVEL = $config->get("trace_level"); |
| 27 |
|
| 28 |
my $dnCache; |
| 29 |
my $criticalCache; |
| 30 |
my $msgCache; |
| 31 |
|
| 32 |
|
| 33 |
# ================================================== |
| 34 |
# configure here |
| 35 |
# ================================================== |
| 36 |
#my $binddn = 'cn=root, dc=labnet, dc=de'; |
| 37 |
my $binddn = 'cn=admin, o=netfrag.org, c=de'; |
| 38 |
#my $binddn = 'cn=admin'; |
| 39 |
|
| 40 |
# V1: hardcoded target ou |
| 41 |
#my $basedn = 'ou=Adressen, dc=labnet, dc=de'; |
| 42 |
|
| 43 |
# V2: now passed-in to "addEntry" |
| 44 |
|
| 45 |
my $cfg_objectclasses = [ qw( |
| 46 |
Person |
| 47 |
inetOrgPerson |
| 48 |
organizationalPerson |
| 49 |
pilotPerson |
| 50 |
groupOfNames |
| 51 |
) ]; |
| 52 |
# msMapi |
| 53 |
# outlookPerson |
| 54 |
|
| 55 |
# |
| 56 |
# other object classes: |
| 57 |
# outlookPerson |
| 58 |
# ================================================== |
| 59 |
|
| 60 |
|
| 61 |
my $ldap; |
| 62 |
my $map; |
| 63 |
|
| 64 |
my $ldap_errors_file = '../log/ldap_errors.log'; |
| 65 |
sub ldapError { |
| 66 |
my $message = shift; |
| 67 |
#print Dumper($message); |
| 68 |
my $textMessage = $message->error . " - code: " . $message->code; |
| 69 |
$textMessage .= " - dn: " . $message->{matchedDN} if $message->{matchedDN}; |
| 70 |
#print "msg: '$textMessage'", "\n"; |
| 71 |
a2f($ldap_errors_file, $textMessage) if !$TRACELEVEL; |
| 72 |
return $message; |
| 73 |
} |
| 74 |
|
| 75 |
sub connectStore { |
| 76 |
|
| 77 |
#print Dumper($config->get("ldapserver_host")); |
| 78 |
|
| 79 |
#$ldap = Net::LDAP->new('localhost', onerror => 'warn'); |
| 80 |
$ldap = Net::LDAP->new( |
| 81 |
$config->get("ldapserver_host"), |
| 82 |
#port => 389, |
| 83 |
#timeout => 120, |
| 84 |
debug => 0, |
| 85 |
#async => 1, |
| 86 |
#onerror => 'warn', |
| 87 |
onerror => \&ldapError, |
| 88 |
#version => 3, |
| 89 |
) |
| 90 |
or die("could not connect to ldap-server!"); |
| 91 |
|
| 92 |
$ldap->bind ( |
| 93 |
$binddn, |
| 94 |
password => 'secret' |
| 95 |
) or die "$@"; |
| 96 |
|
| 97 |
} |
| 98 |
|
| 99 |
sub disconnectStore { |
| 100 |
$ldap->unbind; # take down session |
| 101 |
} |
| 102 |
|
| 103 |
sub getEntry { |
| 104 |
|
| 105 |
die("getEntry!"); |
| 106 |
|
| 107 |
my $basedn = ''; |
| 108 |
|
| 109 |
connectStore(); |
| 110 |
|
| 111 |
my $mesg = $ldap->search ( # perform a search |
| 112 |
base => $basedn, |
| 113 |
filter => "(&(sn=*))" |
| 114 |
); |
| 115 |
|
| 116 |
$mesg->code && die $mesg->error; |
| 117 |
|
| 118 |
foreach my $entry ($mesg->all_entries) { |
| 119 |
$entry->dump; |
| 120 |
print "\n"; |
| 121 |
} |
| 122 |
|
| 123 |
disconnectStore(); |
| 124 |
|
| 125 |
} |
| 126 |
|
| 127 |
sub _example { |
| 128 |
print "abcdef", "\n"; |
| 129 |
my $result = $ldap->add ( |
| 130 |
'cn = Barbara Jensen, o=University of Michigan, c=us', |
| 131 |
attr => [ 'cn' => [ 'Barbara Jensen', 'Barbs Jensen' ], |
| 132 |
'sn' => 'Jensen', |
| 133 |
'mail' => 'b.jensen@umich.edu', |
| 134 |
'objectclass' => ['top', 'person', |
| 135 |
'organizationalPerson', |
| 136 |
'inetOrgPerson' ], |
| 137 |
] |
| 138 |
); |
| 139 |
|
| 140 |
} |
| 141 |
|
| 142 |
sub changeEntry { |
| 143 |
|
| 144 |
my $dn = shift; |
| 145 |
my $ |
| 146 |
|
| 147 |
$ldap->modify( $dn, |
| 148 |
changes => [ |
| 149 |
add => [ sn => 'Barr' ], # Add sn=Barr |
| 150 |
delete => [ faxNumber => []], # Delete all fax numbers |
| 151 |
delete => [ telephoneNumber => ['911']], # delete phone number 911 |
| 152 |
replace => [ email => 'gbarr@pobox.com'] # change email address |
| 153 |
] |
| 154 |
); |
| 155 |
|
| 156 |
} |
| 157 |
|
| 158 |
|
| 159 |
sub prepareEntry { |
| 160 |
|
| 161 |
my $basedn = shift; |
| 162 |
my $mapiEntry = shift; |
| 163 |
|
| 164 |
my $ldapEntry; |
| 165 |
|
| 166 |
my $mapfile = '../etc/' . $config->get("fields_mapfile"); |
| 167 |
readFieldMapping($mapfile); |
| 168 |
|
| 169 |
# dump mapi-entry - don't do that! this is large! |
| 170 |
#print Dumper($mapiEntry); |
| 171 |
#exit; |
| 172 |
|
| 173 |
# utf8-conversion of unmapped mapi-entry - don't do that! this is large! |
| 174 |
#var2utf8($mapiEntry); |
| 175 |
|
| 176 |
# map entry |
| 177 |
foreach my $mapiKey (keys %{$mapiEntry}) { |
| 178 |
my $ldapKey = $map->{ldap}{$mapiKey}; |
| 179 |
my $ldapValue = $mapiEntry->{$mapiKey}; |
| 180 |
next if (!$ldapKey); |
| 181 |
|
| 182 |
# utf8-conversion |
| 183 |
#$ldapKey = toUTF8($ldapKey); |
| 184 |
#$ldapValue = toUTF8($ldapValue); |
| 185 |
|
| 186 |
$ldapEntry->{$ldapKey} = $ldapValue; |
| 187 |
} |
| 188 |
|
| 189 |
# utf8-conversion of mapped ldap-entry |
| 190 |
var2utf8($ldapEntry); |
| 191 |
|
| 192 |
# dump ldap-entry - this is okay |
| 193 |
#print "ldap-entry before adding:", "\n"; |
| 194 |
#print STDOUT Dumper($ldapEntry); |
| 195 |
|
| 196 |
# build dn here |
| 197 |
my $entryIdentifier = buildSnCn( { |
| 198 |
#sn => $sn, |
| 199 |
#givenname => $ldapEntry->{givenname}, |
| 200 |
LastName => $mapiEntry->{LastName}, |
| 201 |
FirstName => $mapiEntry->{FirstName}, |
| 202 |
FileAs => $mapiEntry->{FileAs}, |
| 203 |
CompanyName => $mapiEntry->{CompanyName}, |
| 204 |
EntryID => $mapiEntry->{EntryID}, |
| 205 |
} ); |
| 206 |
|
| 207 |
my $sn = $entryIdentifier->{sn}; |
| 208 |
my $cn = $entryIdentifier->{cn}; |
| 209 |
|
| 210 |
if (!$cn) { |
| 211 |
rememberCriticalEntry("mapi", $mapiEntry->{EntryID}); |
| 212 |
logError('App', "Couldn't build required ldap-attribute \"cn\". LastName/FirstName/FileAs/CompanyName were empty."); |
| 213 |
return; |
| 214 |
} |
| 215 |
|
| 216 |
# remember all already used "cn"s |
| 217 |
addDnCache($cn); |
| 218 |
|
| 219 |
my $must = { |
| 220 |
cn => $cn, |
| 221 |
sn => $sn, |
| 222 |
member => $ldapEntry->{member}, |
| 223 |
objectClass => $cfg_objectclasses, |
| 224 |
}; |
| 225 |
# utf8-conversion of must-have fields |
| 226 |
var2utf8($must); |
| 227 |
|
| 228 |
my $dn = buildDn( { basedn => $basedn, cn => $must->{cn} } ); |
| 229 |
rememberMessage($dn, $entryIdentifier->{info}); |
| 230 |
|
| 231 |
return { identifier => $dn, must => $must, may => $ldapEntry }; |
| 232 |
|
| 233 |
} |
| 234 |
|
| 235 |
sub addEntry { |
| 236 |
|
| 237 |
my $entry_raw = shift; |
| 238 |
|
| 239 |
#print Dumper($entry_raw); |
| 240 |
#return; |
| 241 |
|
| 242 |
my $identifier = $entry_raw->{identifier}; |
| 243 |
my $must = $entry_raw->{must}; |
| 244 |
my $may = $entry_raw->{may}; |
| 245 |
|
| 246 |
my $dn = $identifier; |
| 247 |
|
| 248 |
# delete entry (dn) first |
| 249 |
if (existsEntry('cn', $dn)) { |
| 250 |
print "entry exists (dn='$dn') deleting", "\n" if $DEBUGLEVEL > 3; |
| 251 |
$ldap->delete($dn); |
| 252 |
} |
| 253 |
|
| 254 |
#print "dn: $dn", "\n"; |
| 255 |
#exit; |
| 256 |
|
| 257 |
my $entry = Net::LDAP::Entry->new; |
| 258 |
$entry->dn($dn); |
| 259 |
|
| 260 |
$entry->add( |
| 261 |
cn => $must->{cn}, |
| 262 |
sn => $must->{sn}, |
| 263 |
member => $must->{dn}, |
| 264 |
objectClass => $must->{objectClass}, |
| 265 |
); |
| 266 |
#sn => 'Nachname', |
| 267 |
#cn => 'Vorname Nachname', |
| 268 |
my $result1 = $entry->add(%{$may}); |
| 269 |
|
| 270 |
#print Dumper($result1), "\n"; |
| 271 |
#print Dumper($entry); |
| 272 |
|
| 273 |
my $result = $entry->update($ldap); |
| 274 |
#print Dumper($ldap->sync()); |
| 275 |
|
| 276 |
#print "result:", "\n"; |
| 277 |
#print Dumper($result); |
| 278 |
#exit; |
| 279 |
|
| 280 |
#print "trace-level > 0: ", ($config->get("trace_level") > 0), "\n"; |
| 281 |
#exit; |
| 282 |
|
| 283 |
#traceEntry($mapiEntry, $entry, { error => $error, prefix => $result->error }) if $TRACELEVEL >= 2; |
| 284 |
#return 1 if !$error; |
| 285 |
|
| 286 |
return $result; |
| 287 |
|
| 288 |
} |
| 289 |
|
| 290 |
sub logError { |
| 291 |
my $type = shift; |
| 292 |
my $message = shift; |
| 293 |
my $options = shift; |
| 294 |
if ($DEBUGLEVEL >= 1) { |
| 295 |
print STDOUT "\n" if $DEBUGLEVEL <= 1; |
| 296 |
print STDOUT "ERROR ($type): $message", "\n" ; |
| 297 |
my $buffer = ''; |
| 298 |
foreach (keys %$options) { |
| 299 |
$buffer .= " $_: $options->{$_}\n" if $options->{$_}; |
| 300 |
} |
| 301 |
#print STDOUT Dumper($options), "\n"; |
| 302 |
print STDOUT $buffer; |
| 303 |
} |
| 304 |
} |
| 305 |
|
| 306 |
sub logInfo { |
| 307 |
my $type = shift; |
| 308 |
my $message = shift; |
| 309 |
if ($DEBUGLEVEL >= 1) { |
| 310 |
print STDOUT "\n" if $DEBUGLEVEL <= 1; |
| 311 |
print STDOUT "INFO ($type): $message", "\n" ; |
| 312 |
} |
| 313 |
} |
| 314 |
|
| 315 |
sub traceEntry { |
| 316 |
my $entry_source = shift; |
| 317 |
my $entry_target = shift; |
| 318 |
my $options = shift; |
| 319 |
|
| 320 |
my $logfile = '../log/transfer.log'; |
| 321 |
if ($options->{error}) { |
| 322 |
$logfile = '../log/errors.log'; |
| 323 |
} |
| 324 |
|
| 325 |
my $dump_source = Dumper($entry_source); |
| 326 |
|
| 327 |
#my $dump_target = Dumper($entry_target); |
| 328 |
my $dump_target = "\n"; |
| 329 |
foreach my $attr ($entry_target->attributes) { |
| 330 |
my $subentry = $attr . ": "; |
| 331 |
my @value = $entry_target->get_value($attr); |
| 332 |
if ($#value > 0) { |
| 333 |
#push @value, "\n "; |
| 334 |
$subentry .= "\n "; |
| 335 |
} |
| 336 |
$subentry .= join("\n ", @value); |
| 337 |
$dump_target .= $subentry . "\n"; |
| 338 |
} |
| 339 |
|
| 340 |
my $dump = <<EOD; |
| 341 |
$hr |
| 342 |
MAPI-Object: |
| 343 |
$dump_source |
| 344 |
$hr |
| 345 |
Net::LDAP::Entry: |
| 346 |
$dump_target |
| 347 |
$hr |
| 348 |
EOD |
| 349 |
|
| 350 |
$dump = $hr . $options->{prefix} . $dump if $options->{prefix}; |
| 351 |
|
| 352 |
a2f($logfile, $dump); |
| 353 |
|
| 354 |
} |
| 355 |
|
| 356 |
sub toUTF8 { |
| 357 |
my $string = shift; |
| 358 |
#return to_utf8( -string => $string, -charset => 'ISO-8859-1'); |
| 359 |
print "before: $string", "\n"; |
| 360 |
var2utf8(\$string); |
| 361 |
print "after: $string", "\n"; |
| 362 |
return $string; |
| 363 |
} |
| 364 |
|
| 365 |
sub readFieldMapping { |
| 366 |
my $mapfile = shift; |
| 367 |
if (! -e $mapfile) { |
| 368 |
print "mapfile \"$mapfile\" does not exist.", "\n"; |
| 369 |
exit; |
| 370 |
} |
| 371 |
open(FH, '<', $mapfile); |
| 372 |
while(<FH>) { |
| 373 |
s/\r\n/\n/g; |
| 374 |
chomp(); |
| 375 |
next if (m/^#/); |
| 376 |
my @entry = split(';', $_); |
| 377 |
my $key = $entry[0]; |
| 378 |
my $key_ldap = $entry[1]; |
| 379 |
$key_ldap ||= ''; |
| 380 |
$map->{mapi}{$key} = 1; |
| 381 |
$map->{ldap}{$key} = $key_ldap; |
| 382 |
} |
| 383 |
close(FH); |
| 384 |
} |
| 385 |
|
| 386 |
sub createOuSafe { |
| 387 |
|
| 388 |
#my $basedn = shift; |
| 389 |
#my $cn = shift; |
| 390 |
|
| 391 |
#my $dn = 'cn=' . $cn . ', ' . $basedn; |
| 392 |
my $dn = shift; |
| 393 |
|
| 394 |
#print "orig-dn: $dn", "\n"; |
| 395 |
|
| 396 |
$dn =~ m/ou=([\w|\.]+?)[,|].*/; |
| 397 |
my $ou = $1; |
| 398 |
#print "ou: '$ou'", "\n"; |
| 399 |
|
| 400 |
my $basedn = $dn; |
| 401 |
$basedn =~ s/ou=$ou, //; |
| 402 |
#print "basedn: $basedn", "\n"; |
| 403 |
#exit; |
| 404 |
|
| 405 |
print "checking ou: (basedn='$basedn', ou='$ou')", "\n" if $DEBUGLEVEL > 3; |
| 406 |
# if (checkOu($basedn, $ou)) { |
| 407 |
if (existsEntry('ou', $dn)) { |
| 408 |
return $dn; |
| 409 |
} |
| 410 |
|
| 411 |
if (my @ou_address = split(/\./, $ou)) { |
| 412 |
return createDeepOu($basedn, \@ou_address); |
| 413 |
} else { |
| 414 |
return createOu($dn, $ou); |
| 415 |
} |
| 416 |
|
| 417 |
} |
| 418 |
|
| 419 |
sub createDeepOu { |
| 420 |
my $basedn = shift; |
| 421 |
my $ou_address = shift; |
| 422 |
my $dn = $basedn; |
| 423 |
print "creating deep ou (basedn='$basedn')", "\n" if $DEBUGLEVEL > 3; |
| 424 |
foreach (@$ou_address) { |
| 425 |
my $ou = $_; |
| 426 |
#print "ou: $ou", "\n"; |
| 427 |
$dn = "ou=$ou, " . $dn; |
| 428 |
#print "dn: $dn", "\n"; |
| 429 |
createOu($dn, $ou); |
| 430 |
} |
| 431 |
return $dn; |
| 432 |
} |
| 433 |
|
| 434 |
sub createOu { |
| 435 |
my $dn = shift; |
| 436 |
my $ou = shift; |
| 437 |
print "creating ou (DN='$dn', OU='$ou')", "\n" if $DEBUGLEVEL > 3; |
| 438 |
my $entry = Net::LDAP::Entry->new; |
| 439 |
$entry->dn($dn); |
| 440 |
$entry->add( |
| 441 |
#cn => $cn, |
| 442 |
ou => $ou, |
| 443 |
objectClass => 'organizationalUnit', |
| 444 |
); |
| 445 |
my $result = $entry->update($ldap); |
| 446 |
#return $result; |
| 447 |
return $dn; |
| 448 |
} |
| 449 |
|
| 450 |
sub checkOu { |
| 451 |
my $basedn = shift; |
| 452 |
my $ou = shift; |
| 453 |
|
| 454 |
my $mesg = $ldap->search ( # perform a search |
| 455 |
base => $basedn, |
| 456 |
filter => "(&(ou=$ou))" |
| 457 |
); |
| 458 |
|
| 459 |
#print "search-result-code: ", $mesg->code, "\n"; |
| 460 |
#print "search-result-error: ", $mesg->error, "\n"; |
| 461 |
|
| 462 |
#return; |
| 463 |
#print Dumper($mesg); |
| 464 |
#exit; |
| 465 |
|
| 466 |
#$mesg->code && die $mesg->error; |
| 467 |
|
| 468 |
return 1 if exists $mesg->{entries}; |
| 469 |
|
| 470 |
} |
| 471 |
|
| 472 |
sub existsEntry { |
| 473 |
|
| 474 |
my $ldapType = shift; |
| 475 |
my $dn = shift; |
| 476 |
|
| 477 |
my $filter = "$ldapType =*"; |
| 478 |
#print "using filter: '$filter'", "\n"; |
| 479 |
|
| 480 |
# get part from full LDAP-address |
| 481 |
#print "dn: $dn", "\n"; |
| 482 |
#$dn =~ m/$ldapType=([\w|\.| ]+?)[,|].*/; |
| 483 |
#my $part = $1; |
| 484 |
|
| 485 |
# cut part |
| 486 |
#print "ldapType: $ldapType", "\n"; |
| 487 |
#print "part: $part", "\n"; |
| 488 |
#$dn =~ s/$ldapType=$part, //; |
| 489 |
|
| 490 |
# TODO: |
| 491 |
# - split 'ou' or 'cn' from 'dn' here to create a search-attribute (one) and a $basedn (a parent node) |
| 492 |
# - run search with $filter = 'ou|cn =*' (<part-from-regex>) and $basedn=(<rest-from-regex>) |
| 493 |
|
| 494 |
$filter = "(objectClass=*)"; |
| 495 |
#print "searching for dn='$dn' with filter='$filter'", "\n"; |
| 496 |
my $mesg = $ldap->search ( # perform a search |
| 497 |
base => $dn, |
| 498 |
filter => $filter, |
| 499 |
# filter => "(&(ou=*))" |
| 500 |
); |
| 501 |
|
| 502 |
#print "search-result-code: ", $mesg->code, "\n"; |
| 503 |
#print "search-result-error: ", $mesg->error, "\n"; |
| 504 |
|
| 505 |
#return; |
| 506 |
#print Dumper($mesg); |
| 507 |
#exit; |
| 508 |
|
| 509 |
#$mesg->code && die $mesg->error; |
| 510 |
|
| 511 |
return 1 if exists $mesg->{entries}; |
| 512 |
return 0; |
| 513 |
|
| 514 |
} |
| 515 |
|
| 516 |
sub buildSnCn { |
| 517 |
my $parts = shift; |
| 518 |
|
| 519 |
my $logmsg; |
| 520 |
|
| 521 |
my $cn; |
| 522 |
|
| 523 |
if ($parts->{LastName}) { |
| 524 |
# use pure "sn" first! |
| 525 |
$cn = $parts->{LastName} ; |
| 526 |
|
| 527 |
# add "givenname" to "cn" if exists |
| 528 |
$cn = $parts->{FirstName} . ' ' . $cn if $parts->{FirstName}; |
| 529 |
} |
| 530 |
|
| 531 |
# check if "cn" is already filled, else provide some fallback-mechanism(s) here |
| 532 |
# use "FileAs" |
| 533 |
if (!$cn && $parts->{FileAs}) { |
| 534 |
$cn = $parts->{FileAs}; |
| 535 |
$logmsg = "using \"FileAs\" for \"cn\": $cn"; |
| 536 |
} |
| 537 |
# use "FirstName" |
| 538 |
if (!$cn && $parts->{FirstName}) { |
| 539 |
$cn = $parts->{FirstName}; |
| 540 |
$logmsg = "using \"FirstName\" for \"cn\": $cn"; |
| 541 |
} |
| 542 |
# use "CompanyName" |
| 543 |
if (!$cn && $parts->{CompanyName}) { |
| 544 |
$cn = $parts->{CompanyName}; |
| 545 |
$logmsg = "using \"CompanyName\" for \"cn\": $cn"; |
| 546 |
} |
| 547 |
|
| 548 |
# handle "must-have"-field "sn" |
| 549 |
my $sn = $parts->{LastName}; |
| 550 |
|
| 551 |
# additional (last) rule: use unique identifier (EntryID) as "cn" if it's still empty |
| 552 |
#$cn = 'ident - ' . $parts->{EntryID} if !$cn; |
| 553 |
if (!$cn) { |
| 554 |
$cn = $parts->{EntryID}; |
| 555 |
$logmsg = "\"cn\" was empty, using EntryID.\n - cn: $cn"; |
| 556 |
} |
| 557 |
|
| 558 |
# fallback to "cn" if "sn" is empty |
| 559 |
$sn = $cn if !$sn; |
| 560 |
|
| 561 |
# check for collisions in "cn"s |
| 562 |
if (dnAlreadyUsed($cn)) { |
| 563 |
#logError('App', "Couldn't use cn='$cn' - already exists!"); |
| 564 |
#return; |
| 565 |
$cn .= '-' . $parts->{EntryID}; |
| 566 |
$logmsg .= "\n - modified \"cn\" to prevent name-collision.\n - cn: $cn"; |
| 567 |
} |
| 568 |
|
| 569 |
#$msgCache->{} = $logmsg; |
| 570 |
logInfo('App::buildCn', $logmsg) if $logmsg; |
| 571 |
|
| 572 |
return { sn => $sn, cn => $cn, info => $logmsg }; |
| 573 |
|
| 574 |
} |
| 575 |
|
| 576 |
sub buildDn { |
| 577 |
my $parts = shift; |
| 578 |
|
| 579 |
# build "dn" |
| 580 |
my $dn = join(', ', "cn=" . $parts->{cn}, $parts->{basedn}); |
| 581 |
|
| 582 |
# patch dn (remove forbidden characters) |
| 583 |
$dn =~ s/\+/&/g; |
| 584 |
|
| 585 |
return $dn; |
| 586 |
} |
| 587 |
|
| 588 |
sub clearDnCache { |
| 589 |
$dnCache = {}; |
| 590 |
$msgCache = {}; |
| 591 |
} |
| 592 |
|
| 593 |
sub addDnCache { |
| 594 |
my $key = shift; |
| 595 |
$dnCache->{$key}++; |
| 596 |
} |
| 597 |
|
| 598 |
sub dnAlreadyUsed { |
| 599 |
my $key = shift; |
| 600 |
return exists $dnCache->{$key}; |
| 601 |
} |
| 602 |
|
| 603 |
sub rememberCriticalEntry { |
| 604 |
my $type = shift; |
| 605 |
my $identifier = shift; |
| 606 |
push @$criticalCache, { type => $type, identifier => $identifier }; |
| 607 |
} |
| 608 |
|
| 609 |
sub showCriticalEntries { |
| 610 |
return if !$criticalCache; |
| 611 |
my @criticals = @$criticalCache; |
| 612 |
if ($#criticals != -1) { |
| 613 |
print "=" x 60, "\n"; |
| 614 |
print "Some errors occoured while processing data, show details? (y|n) "; |
| 615 |
my $answer = <STDIN>; |
| 616 |
print "\n"; |
| 617 |
if ($answer =~ m/^y/i) { |
| 618 |
foreach (@criticals) { |
| 619 |
#print join("\n", @criticals); |
| 620 |
#print Dumper($_); |
| 621 |
print $_->{type}, ": ", $_->{identifier}, "\n"; |
| 622 |
print " ", $msgCache->{$_->{identifier}}, "\n"; |
| 623 |
delete $msgCache->{$_->{identifier}}; |
| 624 |
} |
| 625 |
} |
| 626 |
} |
| 627 |
} |
| 628 |
|
| 629 |
sub showGoodEntries { |
| 630 |
print "=" x 60, "\n"; |
| 631 |
print "Show good entries? (y|n) "; |
| 632 |
my $answer = <STDIN>; |
| 633 |
print "\n"; |
| 634 |
if ($answer =~ m/^y/i) { |
| 635 |
foreach (keys %$msgCache) { |
| 636 |
print $_, ": ", $msgCache->{$_}, "\n" if $msgCache->{$_}; |
| 637 |
} |
| 638 |
} |
| 639 |
} |
| 640 |
|
| 641 |
sub processResult { |
| 642 |
|
| 643 |
my $dn = shift; |
| 644 |
my $result = shift; |
| 645 |
|
| 646 |
#print "dn: $dn", "\n"; |
| 647 |
#print Dumper($result); |
| 648 |
|
| 649 |
my $error = 0; |
| 650 |
my $error_code; |
| 651 |
my $error_message; |
| 652 |
if ($result) { |
| 653 |
$error_code = $result->code; |
| 654 |
$error_message = $result->error; |
| 655 |
} else { |
| 656 |
$error_code = 'n/a'; |
| 657 |
$error_message = "NO RESULT FROM LDAP-SERVER"; |
| 658 |
} |
| 659 |
|
| 660 |
if ($error_code) { |
| 661 |
rememberCriticalEntry("ldap", $dn); |
| 662 |
my $errmesg = "(error=$error_message, code=$error_code)"; |
| 663 |
rememberMessage($dn, $errmesg); |
| 664 |
logError("LDAP", $errmesg, { dn => $dn } ); |
| 665 |
$error = 1; |
| 666 |
} else { |
| 667 |
print "SUCCESS for (dn='$dn')", "\n" if $DEBUGLEVEL > 1; |
| 668 |
} |
| 669 |
|
| 670 |
undef $result; |
| 671 |
} |
| 672 |
|
| 673 |
sub rememberMessage { |
| 674 |
my $ident = shift; |
| 675 |
my $mesg = shift; |
| 676 |
$msgCache->{$ident} = $mesg; |
| 677 |
} |
| 678 |
|
| 679 |
1; |
Parent Directory
| 
Revision Log
