Basically, the script read its standard input and decode the ldif requests parameters given by the server. Due to the hierarchical nature of LDAP directories, it has to react differently according notably to base, scope and suffix parameters values in order to re-create the LDAP tree structure. Since the tree structure is really application dependent, the following code only shows the data transfer from the database to the LDAP server.
Also, LDAP search requests filters are translated into sql WHERE condition with the help of the Parse::RecDescent module.
Once found, datas are dumped on the standard output following the ldif format with binary values properly base64 encoded.
use strict;
use Parse::RecDescent;
use DBI;
use MIME::Base64;
my $host = "localhost";
my $port = 5432;
my $dbname = "my_db";
my $username = "username";
my $password = "password";
# <...>
# In a search request, the server feeds us the scope and dereference f
+ields
# in the numeric form used by the protocol. ldapsearch(1) takes these
# fields as arguments in symbolic form. These arrays convert between
# the two representations.
my @scopes = ("base", "onelevel", "subtree");
my @derefs = ("never", "search", "find", "always");
my $dataSource = "dbi:Pg:dbname=$dbname;host=$host;port=$port";
my $operation = <>;
chop($operation);
if ($operation eq "SEARCH") {
my ($suffix, $base, $scope, $deref, $sizelimit, $timelimit, $filte
+r);
my ($attrsonly, @attrs);
while (<>) {
if (/^suffix: (.*)$/) { $suffix = $1; }
elsif (/^base: (.*)$/) { $base = $1; }
elsif (/^scope: (.*)$/) { $scope = $scopes[$1]; }
elsif (/^deref: (.*)$/) { $deref = $derefs[$1]; }
elsif (/^sizelimit: (.*)$/) { $sizelimit = $1; }
elsif (/^timelimit: (.*)$/) { $timelimit = $1; }
elsif (/^filter: (.*)$/) { $filter = $1; }
elsif (/^attrsonly: (.*)$/) { $attrsonly = $1; }
elsif (/^attrs: (.*)$/) { if ($1 eq "all") {
@attrs = ();
} else {
@attrs = split / /, $1;
}
}
# <...>
LdapUserDatasDNAttrs($base, $filter);
# <...>
}
}
# <...>
sub LdapUserDatasDNAttrs {
my ($suffix, $filter) = @_;
my $sqlCond = TranslateLdapFilter($filter);
my ($dnQualifier) = ($suffix =~ /^dnQualifier=([^,]+),/);
print "dn: $suffix\n";
print "objectClass: top\n";
print "objectClass: person\n";
print "objectClass: organizationalPerson\n";
print "objectClass: inetOrgPerson\n";
print "dnQualifier: $dnQualifier\n";
my $dbh = DBI->connect($dataSource, $username, $password,
{AutoCommit => 0, RaiseError => 1})
|| die "Can't connect: $DBI::errstr";
$dbh->commit;
my $statement = "
SELECT cn,
sn,
givenname,
o,
ou,
c,
l,
postalcode,
postaladdress,
mail,
telephonenumber,
facsimiletelephonenumber,
photoid,
certid,
description
FROM ldap
WHERE (dnqualifier = '$dnQualifier') AND ($sqlCond);
";
my $sth = $dbh->prepare($statement)
|| die "Can't prepare: $DBI::errstr";
$sth->execute
|| die "Can't execute statement: $DBI::errstr";
while(my @row = $sth->fetchrow_array) {
my ($cn,
$sn,
$givenName,
$o,
$ou,
$c,
$l,
$postalCode,
$postalAddress,
$mail,
$telephoneNumber,
$facsimileTelephoneNumber,
$photoId,
$certId,
$description) = (@row);
print "cn: $cn\n" if ($cn ne '');
print "givenName: $givenName\n" if ($givenName ne '');
print "sn: $sn\n" if ($sn ne '');
print "o: $o\n" if ($o ne '');
print "ou: $ou\n" if ($ou ne '');
print "c: $c\n" if ($c ne '');
print "l: $l\n" if ($l ne '');
print "postalCode: $postalCode\n" if ($postalCode ne '');
print "postalAddress: $postalAddress\n"
if ($postalAddress ne '');
print "mail: $mail\n" if ($mail ne '');
print "telephoneNumber: $telephoneNumber\n"
if ($telephoneNumber ne '');
print "facsimileTelephoneNumber: $facsimileTelephoneNumber\n"
if ($facsimileTelephoneNumber ne '');
my $photo = '';
my $photoFd = $dbh->func($photoId,
$dbh->{pg_INV_READ},
'lo_open');
my $buff = '';
while($dbh->func($photoFd, $buff, 57 * 1000, 'lo_read')) {
$photo .= $buff;
}
$dbh->func($photoFd, 'lo_close');
my $photoB64 = MIME::Base64::encode($photo, "\n ");
print "jpegPhoto:: $photoB64\n";
my $cert = '';
my $certFd = $dbh->func($certId,
$dbh->{pg_INV_READ},
'lo_open');
$buff = '';
while($dbh->func($certFd, $buff, 57 * 1000, 'lo_read')) {
$cert .= $buff;
}
my $certB64 = MIME::Base64::encode($cert, "\n ");
print "userCertificate:: $certB64\n";
print "description: $description\n" if ($description ne '');
}
print "\n";
$dbh->commit;
$sth->finish;
$dbh->disconnect;
}
sub TranslateLdapFilter {
my ($filter) = @_;
my $grammar = q{
{ my $oper;
sub decode {
my ($str) = @_;
$str =~ s/\\\\([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
return $str;
}
}
translate: request
request: request_and
| request_or
| request_not
| request_data
request_and: '(&' request request ')' # & operator
{ "($item[2]) AND ($item[3])"; }
request_or: '(|' request request ')' # | operator
{ "($item[2]) OR ($item[3])"; }
request_not: '(!' request ')' # ! operator
{ "NOT ($item[2])"; }
request_data: '(' attr '=~' query ')' # sounds like
{ "soundex($item{attr}) = soundex($item{query_value})"; }
| '(' attr '=' query ')' # other forms
{ "lower($item{attr}) $oper lower($item{query})"; }
attr: /[A-Za-z0-9]+/i
{ "$item[1]"; }
query: /[^\)]*/
{ my ($str) = decode($item[1]);
if(($str =~ tr/*/%/) > 0) {
$oper = 'LIKE';
} else {
$oper = '=';
}
"'$str'";
}
};
$::RD_HINT = 1;
my $parser = new Parse::RecDescent($grammar) or die "Bad grammar!\
+n";
return $parser->translate($filter);
}