/[cvs]/nfo/perl/scripts/outlook2ldap/libs/Torus/Driver/ldap.pm
ViewVC logotype

Diff of /nfo/perl/scripts/outlook2ldap/libs/Torus/Driver/ldap.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by joko, Sat Jan 18 17:41:16 2003 UTC revision 1.3 by joko, Mon Jan 20 15:56:57 2003 UTC
# Line 1  Line 1 
 package Torus::Driver::ldap;  
   
 require Exporter;  
 our @ISA = qw(Exporter);  
 our @EXPORT = qw( );  
   
 use strict;  
 use warnings;  
   
 # load configuration-data from ini-file  
 BEGIN {  
   use loadConfig;  
 }  
   
 use Net::LDAP;  
 use Net::LDAP::Entry;  
1  #use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset);  #use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset);
2  use Data::Transform::Encode qw( var2utf8 var_utf2iso );  use Data::Transform::Encode qw( var2utf8 var_utf2iso );
 use Data::Storage::Handler::File qw( a2f );  
3  use Data::Dumper;  use Data::Dumper;
4    
5  my $hr = "=" x 80 . "\n";  my $hr = "=" x 80 . "\n";
# Line 61  my $cfg_objectclasses = [ qw( Line 44  my $cfg_objectclasses = [ qw(
44  my $ldap;  my $ldap;
45  my $map;  my $map;
46    
 my $ldap_errors_file = '../log/ldap_errors.log';  
 sub ldapError {  
   my $message = shift;  
 #print Dumper($message);  
   my $textMessage = $message->error . " - code: " . $message->code;  
   $textMessage .= " - dn: " . $message->{matchedDN} if $message->{matchedDN};  
   #print "msg: '$textMessage'", "\n";  
   a2f($ldap_errors_file, $textMessage) if !$TRACELEVEL;  
   return $message;  
 }  
   
 sub connectStore {  
   
   #print Dumper($config->get("ldapserver_host"));  
   
   #$ldap = Net::LDAP->new('localhost', onerror => 'warn');  
   $ldap = Net::LDAP->new(  
     $config->get("ldapserver_host"),  
     #port => 389,  
     #timeout => 120,  
     debug => 0,  
     #async => 1,  
     #onerror => 'warn',  
     onerror => \&ldapError,  
     #version => 3,  
   )  
   or die("could not connect to ldap-server!");  
     
   $ldap->bind (  
     $binddn,  
     password => 'secret'  
   ) or die "$@";  
   
 }  
   
 sub disconnectStore {  
   $ldap->unbind;   # take down session  
 }  
47    
48  sub getEntry {  sub getEntry {
49    
# Line 383  sub readFieldMapping { Line 328  sub readFieldMapping {
328    close(FH);    close(FH);
329  }  }
330    
 sub createOuSafe {  
     
   #my $basedn = shift;  
   #my $cn = shift;  
   
   #my $dn = 'cn=' . $cn . ', ' . $basedn;  
   my $dn = shift;  
   
   #print "orig-dn: $dn", "\n";  
     
   $dn =~ m/ou=([\w|\.]+?)[,|].*/;  
   my $ou = $1;  
   #print "ou: '$ou'", "\n";  
     
   my $basedn = $dn;  
   $basedn =~ s/ou=$ou, //;  
   #print "basedn: $basedn", "\n";  
   #exit;  
     
   print "checking ou: (basedn='$basedn', ou='$ou')", "\n" if $DEBUGLEVEL > 3;  
 #  if (checkOu($basedn, $ou)) {  
   if (existsEntry('ou', $dn)) {  
     return $dn;  
   }  
     
   if (my @ou_address = split(/\./, $ou)) {  
     return createDeepOu($basedn, \@ou_address);  
   } else {  
     return createOu($dn, $ou);  
   }  
     
 }  
   
 sub createDeepOu {  
   my $basedn = shift;  
   my $ou_address = shift;  
   my $dn = $basedn;  
   print "creating deep ou (basedn='$basedn')", "\n" if $DEBUGLEVEL > 3;  
   foreach (@$ou_address) {  
     my $ou = $_;  
     #print "ou: $ou", "\n";  
     $dn = "ou=$ou, " . $dn;  
     #print "dn: $dn", "\n";  
     createOu($dn, $ou);  
   }  
   return $dn;  
 }  
   
 sub createOu {  
   my $dn = shift;  
   my $ou = shift;  
   print "creating ou (DN='$dn', OU='$ou')", "\n" if $DEBUGLEVEL > 3;  
   my $entry = Net::LDAP::Entry->new;  
   $entry->dn($dn);  
   $entry->add(  
     #cn => $cn,  
     ou => $ou,  
     objectClass => 'organizationalUnit',  
   );  
   my $result = $entry->update($ldap);  
   #return $result;  
   return $dn;  
 }  
   
331  sub checkOu {  sub checkOu {
332    my $basedn = shift;    my $basedn = shift;
333    my $ou = shift;    my $ou = shift;
# Line 469  sub checkOu { Line 350  sub checkOu {
350    
351  }  }
352    
 sub existsEntry {  
     
   my $ldapType = shift;  
   my $dn = shift;  
     
   my $filter = "$ldapType =*";  
   #print "using filter: '$filter'", "\n";  
   
   # get part from full LDAP-address  
   #print "dn: $dn", "\n";  
   #$dn =~ m/$ldapType=([\w|\.| ]+?)[,|].*/;  
   #my $part = $1;  
   
   # cut part  
   #print "ldapType: $ldapType", "\n";  
   #print "part: $part", "\n";  
   #$dn =~ s/$ldapType=$part, //;  
   
   # TODO:  
   # - split 'ou' or 'cn' from 'dn' here to create a search-attribute (one) and a $basedn (a parent node)  
   # - run search with $filter = 'ou|cn =*' (<part-from-regex>) and $basedn=(<rest-from-regex>)  
     
   $filter = "(objectClass=*)";  
   #print "searching for dn='$dn' with filter='$filter'", "\n";  
   my $mesg = $ldap->search (                # perform a search  
                          base   => $dn,  
                          filter => $filter,  
 #                         filter => "(&(ou=*))"  
                         );  
     
   #print "search-result-code: ", $mesg->code, "\n";  
   #print "search-result-error: ", $mesg->error, "\n";  
     
   #return;  
   #print Dumper($mesg);  
   #exit;  
     
   #$mesg->code && die $mesg->error;  
   
   return 1 if exists $mesg->{entries};  
   return 0;  
   
 }  
353    
354  sub buildSnCn {  sub buildSnCn {
355    my $parts = shift;    my $parts = shift;
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed