Torus/Driver/ldap.pm

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;
#use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset);
use Data::Transform::Encode qw( var2utf8 var_utf2iso );
use Data::Storage::Handler::File qw( a2f );
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';

# 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;

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
}

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 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;
}

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 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;

}

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