Torus/Driver/ldap.pm

#use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset);
use Data::Transform::Encode qw( var2utf8 var_utf2iso );
use Data::Dumper;

my $hr = "=" x 80 . "\n";

# debugging?
my $DEBUGLEVEL = $config->get("debug_level");
my $TRACELEVEL = $config->get("trace_level");

my $dnCache;
my $criticalCache;
my $msgCache;


# ==================================================
#    configure here
# ==================================================
#my $binddn = 'cn=root, dc=labnet, dc=de';
my $binddn = 'cn=admin, o=netfrag.org, c=de';
#my $binddn = 'cn=admin';

# V1: hardcoded target ou
#my $basedn = 'ou=Adressen, dc=labnet, dc=de';

# V2: now passed-in to "addEntry"

my $cfg_objectclasses = [ qw( 
                Person
                inetOrgPerson 
                organizationalPerson
                pilotPerson
                groupOfNames
                ) ];
#               msMapi
#               outlookPerson

#
# other object classes:
# outlookPerson
# ==================================================


my $ldap;
my $map;


sub getEntry {

  die("getEntry!");
  
  my $basedn = '';
  
  connectStore();

        my $mesg = $ldap->search (  # perform a search
                               base   => $basedn,
                               filter => "(&(sn=*))"
                              );

        $mesg->code && die $mesg->error;

  foreach my $entry ($mesg->all_entries) { 
    $entry->dump;
    print "\n";
  }

  disconnectStore();

}

sub _example {
   print "abcdef", "\n";
        my $result = $ldap->add ( 
                     'cn = Barbara Jensen, o=University of Michigan, c=us',
                      attr => [ 'cn'   => [ 'Barbara Jensen', 'Barbs Jensen' ],
                                'sn'   => 'Jensen',
                                'mail' => 'b.jensen@umich.edu',
                                'objectclass' => ['top', 'person',
                                                  'organizationalPerson',
                                                  'inetOrgPerson' ],
                              ]
                    );

}

sub changeEntry {

  my $dn = shift;
  my $

            $ldap->modify( $dn,
              changes => [
                add     => [ sn => 'Barr' ],              # Add sn=Barr
                delete  => [ faxNumber => []],            # Delete all fax numbers
                delete  => [ telephoneNumber => ['911']], # delete phone number 911
                replace => [ email => 'gbarr@pobox.com']  # change email address
              ]
            );

}


sub prepareEntry {

  my $basedn = shift;
  my $mapiEntry = shift;
  
  my $ldapEntry;

  my $mapfile = '../etc/' . $config->get("fields_mapfile");
  readFieldMapping($mapfile);

  # dump mapi-entry - don't do that! this is large!
  #print Dumper($mapiEntry);
  #exit;

  # utf8-conversion of unmapped mapi-entry - don't do that! this is large!
  #var2utf8($mapiEntry);

  # map entry
  foreach my $mapiKey (keys %{$mapiEntry}) {
    my $ldapKey = $map->{ldap}{$mapiKey};
    my $ldapValue = $mapiEntry->{$mapiKey};
    next if (!$ldapKey);

    # utf8-conversion
    #$ldapKey   = toUTF8($ldapKey);
    #$ldapValue = toUTF8($ldapValue);

    $ldapEntry->{$ldapKey} = $ldapValue;
  }
  
  # utf8-conversion of mapped ldap-entry
  var2utf8($ldapEntry);

  # dump ldap-entry - this is okay
  #print "ldap-entry before adding:", "\n";
  #print STDOUT Dumper($ldapEntry);
    
  # build dn here
  my $entryIdentifier = buildSnCn( {
    #sn => $sn,
    #givenname => $ldapEntry->{givenname},
    LastName => $mapiEntry->{LastName},
    FirstName => $mapiEntry->{FirstName},
    FileAs => $mapiEntry->{FileAs},
    CompanyName => $mapiEntry->{CompanyName},
    EntryID => $mapiEntry->{EntryID},
  } );
  
  my $sn = $entryIdentifier->{sn};
  my $cn = $entryIdentifier->{cn};
  
  if (!$cn) {
    rememberCriticalEntry("mapi", $mapiEntry->{EntryID});
    logError('App', "Couldn't build required ldap-attribute \"cn\". LastName/FirstName/FileAs/CompanyName were empty.");
    return;
  }
  
  # remember all already used "cn"s
  addDnCache($cn);
  
  my $must = {
    cn => $cn,
    sn => $sn,
    member => $ldapEntry->{member},
    objectClass => $cfg_objectclasses,
  };
  # utf8-conversion of must-have fields
  var2utf8($must);

  my $dn = buildDn( { basedn => $basedn, cn => $must->{cn} } );
  rememberMessage($dn, $entryIdentifier->{info});

  return { identifier => $dn, must => $must, may => $ldapEntry };
  
}

sub addEntry {
    
  my $entry_raw = shift;
  
  #print Dumper($entry_raw);
  #return;
  
  my $identifier = $entry_raw->{identifier};
  my $must = $entry_raw->{must};
  my $may = $entry_raw->{may};
  
  my $dn = $identifier;
    
  # delete entry (dn) first
  if (existsEntry('cn', $dn)) {
    print "entry exists (dn='$dn') deleting", "\n" if $DEBUGLEVEL > 3;
    $ldap->delete($dn);
  }

  #print "dn: $dn", "\n";
  #exit;

  my $entry = Net::LDAP::Entry->new;
  $entry->dn($dn);
  
  $entry->add(
    cn => $must->{cn},
    sn => $must->{sn},
    member => $must->{dn},
    objectClass => $must->{objectClass},
   );
    #sn => 'Nachname',
    #cn => 'Vorname Nachname',
   my $result1 = $entry->add(%{$may});

#print Dumper($result1), "\n";
#print Dumper($entry);

  my $result = $entry->update($ldap);
  #print Dumper($ldap->sync());

#print "result:", "\n";
#print Dumper($result);
#exit;

  #print "trace-level > 0: ", ($config->get("trace_level") > 0), "\n";
  #exit;
  
  #traceEntry($mapiEntry, $entry, { error => $error, prefix => $result->error }) if $TRACELEVEL >= 2;
  #return 1 if !$error;

  return $result;

}

sub logError {
  my $type = shift;
  my $message = shift;
  my $options = shift;
  if ($DEBUGLEVEL >= 1) {
    print STDOUT "\n" if $DEBUGLEVEL <= 1;
    print STDOUT "ERROR ($type): $message", "\n" ;
    my $buffer = '';
    foreach (keys %$options) {
      $buffer .= "  $_: $options->{$_}\n" if $options->{$_};
    }
    #print STDOUT Dumper($options), "\n";
    print STDOUT $buffer;
  }
}

sub logInfo {
  my $type = shift;
  my $message = shift;
  if ($DEBUGLEVEL >= 1) {
    print STDOUT "\n" if $DEBUGLEVEL <= 1;
    print STDOUT "INFO ($type): $message", "\n" ;
  }
}

sub traceEntry {
  my $entry_source = shift;
  my $entry_target = shift;
  my $options = shift;
  
  my $logfile = '../log/transfer.log';
  if ($options->{error}) {
    $logfile = '../log/errors.log';
  }
  
  my $dump_source = Dumper($entry_source);
  
  #my $dump_target = Dumper($entry_target);
  my $dump_target = "\n";
  foreach my $attr ($entry_target->attributes) {
    my $subentry = $attr . ": ";
    my @value = $entry_target->get_value($attr);
    if ($#value > 0) {
      #push @value, "\n   ";
      $subentry .= "\n   ";
    }
    $subentry .= join("\n   ", @value);
    $dump_target .= $subentry . "\n";
  }
  
  my $dump = <<EOD;
  $hr
  MAPI-Object:
  $dump_source
  $hr
  Net::LDAP::Entry:
  $dump_target
  $hr
EOD

  $dump = $hr . $options->{prefix} . $dump if $options->{prefix};

  a2f($logfile, $dump);
  
}

sub toUTF8 {
  my $string = shift;
  #return to_utf8( -string => $string, -charset => 'ISO-8859-1');
  print "before: $string", "\n";
  var2utf8(\$string);
  print "after: $string", "\n";
  return $string;
}

sub readFieldMapping {
  my $mapfile = shift;
  if (! -e $mapfile) {
    print "mapfile \"$mapfile\" does not exist.", "\n";
    exit;
  }
  open(FH, '<', $mapfile);
    while(<FH>) {
      s/\r\n/\n/g;
      chomp();
      next if (m/^#/);
      my @entry = split(';', $_);
      my $key = $entry[0];
      my $key_ldap = $entry[1];
      $key_ldap ||= '';
      $map->{mapi}{$key} = 1;
      $map->{ldap}{$key} = $key_ldap;
    }
  close(FH);
}

sub checkOu {
  my $basedn = shift;
  my $ou = shift;

  my $mesg = $ldap->search (                # perform a search
                         base   => $basedn,
                         filter => "(&(ou=$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};

}


sub buildSnCn {
  my $parts = shift;
  
  my $logmsg;
  
  my $cn;
  
  if ($parts->{LastName}) {
    # use pure "sn" first!
    $cn = $parts->{LastName} ;
  
    # add "givenname" to "cn" if exists
    $cn = $parts->{FirstName} . ' ' . $cn if $parts->{FirstName};
  }

  # check if "cn" is already filled, else provide some fallback-mechanism(s) here
    # use "FileAs"
    if (!$cn && $parts->{FileAs}) {
      $cn = $parts->{FileAs};
      $logmsg = "using \"FileAs\" for \"cn\": $cn";
    }
    # use "FirstName"
    if (!$cn && $parts->{FirstName}) {
      $cn = $parts->{FirstName};
      $logmsg = "using \"FirstName\" for \"cn\": $cn";
    }
    # use "CompanyName"
    if (!$cn && $parts->{CompanyName}) {
      $cn = $parts->{CompanyName};
      $logmsg = "using \"CompanyName\" for \"cn\": $cn";
    }

  # handle "must-have"-field "sn"
    my $sn = $parts->{LastName};

  # additional (last) rule: use unique identifier (EntryID) as "cn" if it's still empty
    #$cn = 'ident - ' . $parts->{EntryID} if !$cn;
    if (!$cn) {
      $cn = $parts->{EntryID};
      $logmsg = "\"cn\" was empty, using EntryID.\n  - cn: $cn";
    }

  # fallback to "cn" if "sn" is empty
    $sn = $cn if !$sn;
  
  # check for collisions in "cn"s
    if (dnAlreadyUsed($cn)) {
      #logError('App', "Couldn't use cn='$cn' - already exists!");
      #return;
      $cn .= '-' . $parts->{EntryID};
      $logmsg .= "\n  - modified \"cn\" to prevent name-collision.\n  - cn: $cn";
    }

    #$msgCache->{} = $logmsg;
    logInfo('App::buildCn', $logmsg) if $logmsg;

    return { sn => $sn, cn => $cn, info => $logmsg };
  
}

sub buildDn {
  my $parts = shift;
  
  # build "dn"
  my $dn = join(', ', "cn=" . $parts->{cn}, $parts->{basedn});
  
  # patch dn (remove forbidden characters)
  $dn =~ s/\+/&/g;
  
  return $dn;
}

sub clearDnCache {
  $dnCache = {};
  $msgCache = {};
}

sub addDnCache {
  my $key = shift;
  $dnCache->{$key}++;
}

sub dnAlreadyUsed {
  my $key = shift;
  return exists $dnCache->{$key};
}

sub rememberCriticalEntry {
  my $type = shift;
  my $identifier = shift;
  push @$criticalCache, { type => $type, identifier => $identifier };
}

sub showCriticalEntries {
  return if !$criticalCache;
  my @criticals = @$criticalCache;
  if ($#criticals != -1) {
    print "=" x 60, "\n";
    print "Some errors occoured while processing data, show details? (y|n) ";
    my $answer = <STDIN>;
    print "\n";
    if ($answer =~ m/^y/i) {
      foreach (@criticals) {
        #print join("\n", @criticals);
        #print Dumper($_);
        print $_->{type}, ": ", $_->{identifier}, "\n";
        print "  ", $msgCache->{$_->{identifier}}, "\n";
        delete $msgCache->{$_->{identifier}};
      }
    }
  }
}

sub showGoodEntries {
  print "=" x 60, "\n";
  print "Show good entries? (y|n) ";
  my $answer = <STDIN>;
  print "\n";
  if ($answer =~ m/^y/i) {
    foreach (keys %$msgCache) {
      print $_, ": ", $msgCache->{$_}, "\n" if $msgCache->{$_};
    }
  }
}

sub processResult {

  my $dn = shift;
  my $result = shift;

#print "dn: $dn", "\n";
#print Dumper($result);

  my $error = 0;
  my $error_code;
  my $error_message;
  if ($result) {
    $error_code = $result->code;
    $error_message = $result->error;
  } else {
    $error_code = 'n/a';
    $error_message = "NO RESULT FROM LDAP-SERVER";
  }
  
  if ($error_code) {
    rememberCriticalEntry("ldap", $dn);
    my $errmesg = "(error=$error_message, code=$error_code)";
    rememberMessage($dn, $errmesg);
    logError("LDAP", $errmesg, { dn => $dn } );
    $error = 1;
  } else {
    print "SUCCESS for (dn='$dn')", "\n" if $DEBUGLEVEL > 1;
  }
  
  undef $result;
}

sub rememberMessage {
  my $ident = shift;
  my $mesg = shift;
  $msgCache->{$ident} = $mesg;
}

1;
1	joko	1.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	joko	1.2	#my $binddn = 'cn=root, dc=labnet, dc=de';
20			my $binddn = 'cn=admin, o=netfrag.org, c=de';
21			#my $binddn = 'cn=admin';
22	joko	1.1
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	joko	1.2	# msMapi
36	joko	1.1	# 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;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26