| 1 |
#use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset); |
| 2 |
use Data::Transform::Encode qw( var2utf8 var_utf2iso ); |
| 3 |
use Data::Dumper; |
| 4 |
|
| 5 |
my $hr = "=" x 80 . "\n"; |
| 6 |
|
| 7 |
# debugging? |
| 8 |
my $DEBUGLEVEL = $config->get("debug_level"); |
| 9 |
my $TRACELEVEL = $config->get("trace_level"); |
| 10 |
|
| 11 |
my $dnCache; |
| 12 |
my $criticalCache; |
| 13 |
my $msgCache; |
| 14 |
|
| 15 |
|
| 16 |
# ================================================== |
| 17 |
# configure here |
| 18 |
# ================================================== |
| 19 |
#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 |
| 24 |
#my $basedn = 'ou=Adressen, dc=labnet, dc=de'; |
| 25 |
|
| 26 |
# V2: now passed-in to "addEntry" |
| 27 |
|
| 28 |
my $cfg_objectclasses = [ qw( |
| 29 |
Person |
| 30 |
inetOrgPerson |
| 31 |
organizationalPerson |
| 32 |
pilotPerson |
| 33 |
groupOfNames |
| 34 |
) ]; |
| 35 |
# msMapi |
| 36 |
# outlookPerson |
| 37 |
|
| 38 |
# |
| 39 |
# other object classes: |
| 40 |
# outlookPerson |
| 41 |
# ================================================== |
| 42 |
|
| 43 |
|
| 44 |
my $ldap; |
| 45 |
my $map; |
| 46 |
|
| 47 |
|
| 48 |
sub getEntry { |
| 49 |
|
| 50 |
die("getEntry!"); |
| 51 |
|
| 52 |
my $basedn = ''; |
| 53 |
|
| 54 |
connectStore(); |
| 55 |
|
| 56 |
my $mesg = $ldap->search ( # perform a search |
| 57 |
base => $basedn, |
| 58 |
filter => "(&(sn=*))" |
| 59 |
); |
| 60 |
|
| 61 |
$mesg->code && die $mesg->error; |
| 62 |
|
| 63 |
foreach my $entry ($mesg->all_entries) { |
| 64 |
$entry->dump; |
| 65 |
print "\n"; |
| 66 |
} |
| 67 |
|
| 68 |
disconnectStore(); |
| 69 |
|
| 70 |
} |
| 71 |
|
| 72 |
sub _example { |
| 73 |
print "abcdef", "\n"; |
| 74 |
my $result = $ldap->add ( |
| 75 |
'cn = Barbara Jensen, o=University of Michigan, c=us', |
| 76 |
attr => [ 'cn' => [ 'Barbara Jensen', 'Barbs Jensen' ], |
| 77 |
'sn' => 'Jensen', |
| 78 |
'mail' => 'b.jensen@umich.edu', |
| 79 |
'objectclass' => ['top', 'person', |
| 80 |
'organizationalPerson', |
| 81 |
'inetOrgPerson' ], |
| 82 |
] |
| 83 |
); |
| 84 |
|
| 85 |
} |
| 86 |
|
| 87 |
sub changeEntry { |
| 88 |
|
| 89 |
my $dn = shift; |
| 90 |
my $ |
| 91 |
|
| 92 |
$ldap->modify( $dn, |
| 93 |
changes => [ |
| 94 |
add => [ sn => 'Barr' ], # Add sn=Barr |
| 95 |
delete => [ faxNumber => []], # Delete all fax numbers |
| 96 |
delete => [ telephoneNumber => ['911']], # delete phone number 911 |
| 97 |
replace => [ email => 'gbarr@pobox.com'] # change email address |
| 98 |
] |
| 99 |
); |
| 100 |
|
| 101 |
} |
| 102 |
|
| 103 |
|
| 104 |
sub prepareEntry { |
| 105 |
|
| 106 |
my $basedn = shift; |
| 107 |
my $mapiEntry = shift; |
| 108 |
|
| 109 |
my $ldapEntry; |
| 110 |
|
| 111 |
my $mapfile = '../etc/' . $config->get("fields_mapfile"); |
| 112 |
readFieldMapping($mapfile); |
| 113 |
|
| 114 |
# dump mapi-entry - don't do that! this is large! |
| 115 |
#print Dumper($mapiEntry); |
| 116 |
#exit; |
| 117 |
|
| 118 |
# utf8-conversion of unmapped mapi-entry - don't do that! this is large! |
| 119 |
#var2utf8($mapiEntry); |
| 120 |
|
| 121 |
# map entry |
| 122 |
foreach my $mapiKey (keys %{$mapiEntry}) { |
| 123 |
my $ldapKey = $map->{ldap}{$mapiKey}; |
| 124 |
my $ldapValue = $mapiEntry->{$mapiKey}; |
| 125 |
next if (!$ldapKey); |
| 126 |
|
| 127 |
# utf8-conversion |
| 128 |
#$ldapKey = toUTF8($ldapKey); |
| 129 |
#$ldapValue = toUTF8($ldapValue); |
| 130 |
|
| 131 |
$ldapEntry->{$ldapKey} = $ldapValue; |
| 132 |
} |
| 133 |
|
| 134 |
# utf8-conversion of mapped ldap-entry |
| 135 |
var2utf8($ldapEntry); |
| 136 |
|
| 137 |
# dump ldap-entry - this is okay |
| 138 |
#print "ldap-entry before adding:", "\n"; |
| 139 |
#print STDOUT Dumper($ldapEntry); |
| 140 |
|
| 141 |
# build dn here |
| 142 |
my $entryIdentifier = buildSnCn( { |
| 143 |
#sn => $sn, |
| 144 |
#givenname => $ldapEntry->{givenname}, |
| 145 |
LastName => $mapiEntry->{LastName}, |
| 146 |
FirstName => $mapiEntry->{FirstName}, |
| 147 |
FileAs => $mapiEntry->{FileAs}, |
| 148 |
CompanyName => $mapiEntry->{CompanyName}, |
| 149 |
EntryID => $mapiEntry->{EntryID}, |
| 150 |
} ); |
| 151 |
|
| 152 |
my $sn = $entryIdentifier->{sn}; |
| 153 |
my $cn = $entryIdentifier->{cn}; |
| 154 |
|
| 155 |
if (!$cn) { |
| 156 |
rememberCriticalEntry("mapi", $mapiEntry->{EntryID}); |
| 157 |
logError('App', "Couldn't build required ldap-attribute \"cn\". LastName/FirstName/FileAs/CompanyName were empty."); |
| 158 |
return; |
| 159 |
} |
| 160 |
|
| 161 |
# remember all already used "cn"s |
| 162 |
addDnCache($cn); |
| 163 |
|
| 164 |
my $must = { |
| 165 |
cn => $cn, |
| 166 |
sn => $sn, |
| 167 |
member => $ldapEntry->{member}, |
| 168 |
objectClass => $cfg_objectclasses, |
| 169 |
}; |
| 170 |
# utf8-conversion of must-have fields |
| 171 |
var2utf8($must); |
| 172 |
|
| 173 |
my $dn = buildDn( { basedn => $basedn, cn => $must->{cn} } ); |
| 174 |
rememberMessage($dn, $entryIdentifier->{info}); |
| 175 |
|
| 176 |
return { identifier => $dn, must => $must, may => $ldapEntry }; |
| 177 |
|
| 178 |
} |
| 179 |
|
| 180 |
sub addEntry { |
| 181 |
|
| 182 |
my $entry_raw = shift; |
| 183 |
|
| 184 |
#print Dumper($entry_raw); |
| 185 |
#return; |
| 186 |
|
| 187 |
my $identifier = $entry_raw->{identifier}; |
| 188 |
my $must = $entry_raw->{must}; |
| 189 |
my $may = $entry_raw->{may}; |
| 190 |
|
| 191 |
my $dn = $identifier; |
| 192 |
|
| 193 |
# delete entry (dn) first |
| 194 |
if (existsEntry('cn', $dn)) { |
| 195 |
print "entry exists (dn='$dn') deleting", "\n" if $DEBUGLEVEL > 3; |
| 196 |
$ldap->delete($dn); |
| 197 |
} |
| 198 |
|
| 199 |
#print "dn: $dn", "\n"; |
| 200 |
#exit; |
| 201 |
|
| 202 |
my $entry = Net::LDAP::Entry->new; |
| 203 |
$entry->dn($dn); |
| 204 |
|
| 205 |
$entry->add( |
| 206 |
cn => $must->{cn}, |
| 207 |
sn => $must->{sn}, |
| 208 |
member => $must->{dn}, |
| 209 |
objectClass => $must->{objectClass}, |
| 210 |
); |
| 211 |
#sn => 'Nachname', |
| 212 |
#cn => 'Vorname Nachname', |
| 213 |
my $result1 = $entry->add(%{$may}); |
| 214 |
|
| 215 |
#print Dumper($result1), "\n"; |
| 216 |
#print Dumper($entry); |
| 217 |
|
| 218 |
my $result = $entry->update($ldap); |
| 219 |
#print Dumper($ldap->sync()); |
| 220 |
|
| 221 |
#print "result:", "\n"; |
| 222 |
#print Dumper($result); |
| 223 |
#exit; |
| 224 |
|
| 225 |
#print "trace-level > 0: ", ($config->get("trace_level") > 0), "\n"; |
| 226 |
#exit; |
| 227 |
|
| 228 |
#traceEntry($mapiEntry, $entry, { error => $error, prefix => $result->error }) if $TRACELEVEL >= 2; |
| 229 |
#return 1 if !$error; |
| 230 |
|
| 231 |
return $result; |
| 232 |
|
| 233 |
} |
| 234 |
|
| 235 |
sub logError { |
| 236 |
my $type = shift; |
| 237 |
my $message = shift; |
| 238 |
my $options = shift; |
| 239 |
if ($DEBUGLEVEL >= 1) { |
| 240 |
print STDOUT "\n" if $DEBUGLEVEL <= 1; |
| 241 |
print STDOUT "ERROR ($type): $message", "\n" ; |
| 242 |
my $buffer = ''; |
| 243 |
foreach (keys %$options) { |
| 244 |
$buffer .= " $_: $options->{$_}\n" if $options->{$_}; |
| 245 |
} |
| 246 |
#print STDOUT Dumper($options), "\n"; |
| 247 |
print STDOUT $buffer; |
| 248 |
} |
| 249 |
} |
| 250 |
|
| 251 |
sub logInfo { |
| 252 |
my $type = shift; |
| 253 |
my $message = shift; |
| 254 |
if ($DEBUGLEVEL >= 1) { |
| 255 |
print STDOUT "\n" if $DEBUGLEVEL <= 1; |
| 256 |
print STDOUT "INFO ($type): $message", "\n" ; |
| 257 |
} |
| 258 |
} |
| 259 |
|
| 260 |
sub traceEntry { |
| 261 |
my $entry_source = shift; |
| 262 |
my $entry_target = shift; |
| 263 |
my $options = shift; |
| 264 |
|
| 265 |
my $logfile = '../log/transfer.log'; |
| 266 |
if ($options->{error}) { |
| 267 |
$logfile = '../log/errors.log'; |
| 268 |
} |
| 269 |
|
| 270 |
my $dump_source = Dumper($entry_source); |
| 271 |
|
| 272 |
#my $dump_target = Dumper($entry_target); |
| 273 |
my $dump_target = "\n"; |
| 274 |
foreach my $attr ($entry_target->attributes) { |
| 275 |
my $subentry = $attr . ": "; |
| 276 |
my @value = $entry_target->get_value($attr); |
| 277 |
if ($#value > 0) { |
| 278 |
#push @value, "\n "; |
| 279 |
$subentry .= "\n "; |
| 280 |
} |
| 281 |
$subentry .= join("\n ", @value); |
| 282 |
$dump_target .= $subentry . "\n"; |
| 283 |
} |
| 284 |
|
| 285 |
my $dump = <<EOD; |
| 286 |
$hr |
| 287 |
MAPI-Object: |
| 288 |
$dump_source |
| 289 |
$hr |
| 290 |
Net::LDAP::Entry: |
| 291 |
$dump_target |
| 292 |
$hr |
| 293 |
EOD |
| 294 |
|
| 295 |
$dump = $hr . $options->{prefix} . $dump if $options->{prefix}; |
| 296 |
|
| 297 |
a2f($logfile, $dump); |
| 298 |
|
| 299 |
} |
| 300 |
|
| 301 |
sub toUTF8 { |
| 302 |
my $string = shift; |
| 303 |
#return to_utf8( -string => $string, -charset => 'ISO-8859-1'); |
| 304 |
print "before: $string", "\n"; |
| 305 |
var2utf8(\$string); |
| 306 |
print "after: $string", "\n"; |
| 307 |
return $string; |
| 308 |
} |
| 309 |
|
| 310 |
sub readFieldMapping { |
| 311 |
my $mapfile = shift; |
| 312 |
if (! -e $mapfile) { |
| 313 |
print "mapfile \"$mapfile\" does not exist.", "\n"; |
| 314 |
exit; |
| 315 |
} |
| 316 |
open(FH, '<', $mapfile); |
| 317 |
while(<FH>) { |
| 318 |
s/\r\n/\n/g; |
| 319 |
chomp(); |
| 320 |
next if (m/^#/); |
| 321 |
my @entry = split(';', $_); |
| 322 |
my $key = $entry[0]; |
| 323 |
my $key_ldap = $entry[1]; |
| 324 |
$key_ldap ||= ''; |
| 325 |
$map->{mapi}{$key} = 1; |
| 326 |
$map->{ldap}{$key} = $key_ldap; |
| 327 |
} |
| 328 |
close(FH); |
| 329 |
} |
| 330 |
|
| 331 |
sub checkOu { |
| 332 |
my $basedn = shift; |
| 333 |
my $ou = shift; |
| 334 |
|
| 335 |
my $mesg = $ldap->search ( # perform a search |
| 336 |
base => $basedn, |
| 337 |
filter => "(&(ou=$ou))" |
| 338 |
); |
| 339 |
|
| 340 |
#print "search-result-code: ", $mesg->code, "\n"; |
| 341 |
#print "search-result-error: ", $mesg->error, "\n"; |
| 342 |
|
| 343 |
#return; |
| 344 |
#print Dumper($mesg); |
| 345 |
#exit; |
| 346 |
|
| 347 |
#$mesg->code && die $mesg->error; |
| 348 |
|
| 349 |
return 1 if exists $mesg->{entries}; |
| 350 |
|
| 351 |
} |
| 352 |
|
| 353 |
|
| 354 |
sub buildSnCn { |
| 355 |
my $parts = shift; |
| 356 |
|
| 357 |
my $logmsg; |
| 358 |
|
| 359 |
my $cn; |
| 360 |
|
| 361 |
if ($parts->{LastName}) { |
| 362 |
# use pure "sn" first! |
| 363 |
$cn = $parts->{LastName} ; |
| 364 |
|
| 365 |
# add "givenname" to "cn" if exists |
| 366 |
$cn = $parts->{FirstName} . ' ' . $cn if $parts->{FirstName}; |
| 367 |
} |
| 368 |
|
| 369 |
# check if "cn" is already filled, else provide some fallback-mechanism(s) here |
| 370 |
# use "FileAs" |
| 371 |
if (!$cn && $parts->{FileAs}) { |
| 372 |
$cn = $parts->{FileAs}; |
| 373 |
$logmsg = "using \"FileAs\" for \"cn\": $cn"; |
| 374 |
} |
| 375 |
# use "FirstName" |
| 376 |
if (!$cn && $parts->{FirstName}) { |
| 377 |
$cn = $parts->{FirstName}; |
| 378 |
$logmsg = "using \"FirstName\" for \"cn\": $cn"; |
| 379 |
} |
| 380 |
# use "CompanyName" |
| 381 |
if (!$cn && $parts->{CompanyName}) { |
| 382 |
$cn = $parts->{CompanyName}; |
| 383 |
$logmsg = "using \"CompanyName\" for \"cn\": $cn"; |
| 384 |
} |
| 385 |
|
| 386 |
# handle "must-have"-field "sn" |
| 387 |
my $sn = $parts->{LastName}; |
| 388 |
|
| 389 |
# additional (last) rule: use unique identifier (EntryID) as "cn" if it's still empty |
| 390 |
#$cn = 'ident - ' . $parts->{EntryID} if !$cn; |
| 391 |
if (!$cn) { |
| 392 |
$cn = $parts->{EntryID}; |
| 393 |
$logmsg = "\"cn\" was empty, using EntryID.\n - cn: $cn"; |
| 394 |
} |
| 395 |
|
| 396 |
# fallback to "cn" if "sn" is empty |
| 397 |
$sn = $cn if !$sn; |
| 398 |
|
| 399 |
# check for collisions in "cn"s |
| 400 |
if (dnAlreadyUsed($cn)) { |
| 401 |
#logError('App', "Couldn't use cn='$cn' - already exists!"); |
| 402 |
#return; |
| 403 |
$cn .= '-' . $parts->{EntryID}; |
| 404 |
$logmsg .= "\n - modified \"cn\" to prevent name-collision.\n - cn: $cn"; |
| 405 |
} |
| 406 |
|
| 407 |
#$msgCache->{} = $logmsg; |
| 408 |
logInfo('App::buildCn', $logmsg) if $logmsg; |
| 409 |
|
| 410 |
return { sn => $sn, cn => $cn, info => $logmsg }; |
| 411 |
|
| 412 |
} |
| 413 |
|
| 414 |
sub buildDn { |
| 415 |
my $parts = shift; |
| 416 |
|
| 417 |
# build "dn" |
| 418 |
my $dn = join(', ', "cn=" . $parts->{cn}, $parts->{basedn}); |
| 419 |
|
| 420 |
# patch dn (remove forbidden characters) |
| 421 |
$dn =~ s/\+/&/g; |
| 422 |
|
| 423 |
return $dn; |
| 424 |
} |
| 425 |
|
| 426 |
sub clearDnCache { |
| 427 |
$dnCache = {}; |
| 428 |
$msgCache = {}; |
| 429 |
} |
| 430 |
|
| 431 |
sub addDnCache { |
| 432 |
my $key = shift; |
| 433 |
$dnCache->{$key}++; |
| 434 |
} |
| 435 |
|
| 436 |
sub dnAlreadyUsed { |
| 437 |
my $key = shift; |
| 438 |
return exists $dnCache->{$key}; |
| 439 |
} |
| 440 |
|
| 441 |
sub rememberCriticalEntry { |
| 442 |
my $type = shift; |
| 443 |
my $identifier = shift; |
| 444 |
push @$criticalCache, { type => $type, identifier => $identifier }; |
| 445 |
} |
| 446 |
|
| 447 |
sub showCriticalEntries { |
| 448 |
return if !$criticalCache; |
| 449 |
my @criticals = @$criticalCache; |
| 450 |
if ($#criticals != -1) { |
| 451 |
print "=" x 60, "\n"; |
| 452 |
print "Some errors occoured while processing data, show details? (y|n) "; |
| 453 |
my $answer = <STDIN>; |
| 454 |
print "\n"; |
| 455 |
if ($answer =~ m/^y/i) { |
| 456 |
foreach (@criticals) { |
| 457 |
#print join("\n", @criticals); |
| 458 |
#print Dumper($_); |
| 459 |
print $_->{type}, ": ", $_->{identifier}, "\n"; |
| 460 |
print " ", $msgCache->{$_->{identifier}}, "\n"; |
| 461 |
delete $msgCache->{$_->{identifier}}; |
| 462 |
} |
| 463 |
} |
| 464 |
} |
| 465 |
} |
| 466 |
|
| 467 |
sub showGoodEntries { |
| 468 |
print "=" x 60, "\n"; |
| 469 |
print "Show good entries? (y|n) "; |
| 470 |
my $answer = <STDIN>; |
| 471 |
print "\n"; |
| 472 |
if ($answer =~ m/^y/i) { |
| 473 |
foreach (keys %$msgCache) { |
| 474 |
print $_, ": ", $msgCache->{$_}, "\n" if $msgCache->{$_}; |
| 475 |
} |
| 476 |
} |
| 477 |
} |
| 478 |
|
| 479 |
sub processResult { |
| 480 |
|
| 481 |
my $dn = shift; |
| 482 |
my $result = shift; |
| 483 |
|
| 484 |
#print "dn: $dn", "\n"; |
| 485 |
#print Dumper($result); |
| 486 |
|
| 487 |
my $error = 0; |
| 488 |
my $error_code; |
| 489 |
my $error_message; |
| 490 |
if ($result) { |
| 491 |
$error_code = $result->code; |
| 492 |
$error_message = $result->error; |
| 493 |
} else { |
| 494 |
$error_code = 'n/a'; |
| 495 |
$error_message = "NO RESULT FROM LDAP-SERVER"; |
| 496 |
} |
| 497 |
|
| 498 |
if ($error_code) { |
| 499 |
rememberCriticalEntry("ldap", $dn); |
| 500 |
my $errmesg = "(error=$error_message, code=$error_code)"; |
| 501 |
rememberMessage($dn, $errmesg); |
| 502 |
logError("LDAP", $errmesg, { dn => $dn } ); |
| 503 |
$error = 1; |
| 504 |
} else { |
| 505 |
print "SUCCESS for (dn='$dn')", "\n" if $DEBUGLEVEL > 1; |
| 506 |
} |
| 507 |
|
| 508 |
undef $result; |
| 509 |
} |
| 510 |
|
| 511 |
sub rememberMessage { |
| 512 |
my $ident = shift; |
| 513 |
my $mesg = shift; |
| 514 |
$msgCache->{$ident} = $mesg; |
| 515 |
} |
| 516 |
|
| 517 |
1; |
Parent Directory
| 
Revision Log
