Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Binding OpenLDAP and PostgreSQL with Perl

by dfaure (Chaplain)
on May 20, 2004 at 00:25 UTC ( #354795=CUFP: print w/ replies, xml ) Need Help??

Two years ago, I had to "show" through OpenLDAP some datas stored into a PostgreSQL database (only queries, no need to update).

Since I couldn't made working the iODBC stuff of the OpenLDAP sql backend, I use a pinch of Perl to do the job.

OpenLDAP

The LDAP server is configured to use a shell backend, ie. a filter command understanding ldif formated request on the standard input and replying related results in the same format on the standard output.

Here's slapd.conf parameters:

database shell search /var/pg2ldap/backend.pl
PostgreSQL

The mapping with the real datas is made with the help of views providing all necessary field required by the protocol.

Here's a sample view:

create view ldap as select agency as objectclass, (agency || '-' || folderid) as dnqualifier, (fname || ' ' || lname) as cn, lname as sn, fname as givenname, org as o, orgunit as ou, city as l, cp as postalcode, adr as postaladdress, country as c, email as mail, tel as telephonenumber, fax as facsimiletelephonenumber, photo as photoid, cert as certid, comment as description from userspool where state = 'ACTIVE'
Perl

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

This code run terribly slowly for several reasons: a perl process is forked by OpenLDAP for every query received, the "ldif filter to sql condition" conversion grammar is rebuild at every run, answered query are not filtered according to attributes given,...
...sorry, but this is running old code. Though it doesn't take account of latest available modules dealing with LDAP (Net::LDAP::Entry, Net::LDAP::LDIF, DBD::LDAP) you may found it interesting as it shows various use of different modules.

Cheers
Dominique

Comment on Binding OpenLDAP and PostgreSQL with Perl
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://354795]
Approved by valdez
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (5)
As of 2014-12-25 14:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (160 votes), past polls