Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Integrating systems using Net::LDAP::Server and RDBMS

by dpavlin (Friar)
on Mar 29, 2009 at 20:43 UTC ( [id://754027]=CUFP: print w/replies, xml ) Need Help??

Let's assume that we have two systems, one which support LDAP user accounts and other system, based on relational database (Koha, in this example) which has user information which you would like to expose using LDAP for first system.

We could export all data required into institution LDAP, but that would push a lot of junk which is really required only by one application. Worse yet, some of that data is somewhat sensitive because it include serial numbers (SID) and data from RFID cards.

But, since application supports LDAP and we have Net::LDAP::Server it should be easy! And it really is.

LDAP server accessing Koha database using DBI is really converter of LDAP search query into SQL where syntax which is than appended to initial select which returns attribute values for LDAP entry which will be returned for search request.

This small example will hopefully be useful to other people who would like to integrate two systems by exposing user data via LDAP protocol. Just remember that pushing real valid usable data back to LDAP always makes more sense if that data is useful for current or future systems...

package LDAP::Koha; use strict; use warnings; use Data::Dump qw/dump/; use lib '../lib'; use Net::LDAP::Constant qw(LDAP_SUCCESS); use Net::LDAP::Server; use base 'Net::LDAP::Server'; use fields qw(); use DBI; # XXX test with: # # ldapsearch -h localhost -p 2389 -b dc=ffzg,dc=hr -x 'otherPager=2009 +03160021' # our $dsn = 'DBI:mysql:dbname='; our $database = 'koha'; our $user = 'unconfigured-user'; our $passwd = 'unconfigured-password'; our $max_results = 10; # 100; # FIXME require 'config.pl' if -e 'config.pl'; my $dbh = DBI->connect($dsn . $database, $user,$passwd, { RaiseError = +> 1, AutoCommit => 1 }) || die $DBI::errstr; # Net::LDAP::Entry will lc all our attribute names anyway, so # we don't really care about correctCapitalization for LDAP # attributes which won't pass through DBI my $sql_select = q{ select trim(userid) as uid, firstname as givenName, surname as sn, concat(firstname,' ',surname) as cn, -- SAFEQ specific mappings from UMgr-LDAP.conf surname as displayName, rfid_sid as pager, email as mail, categorycode as organizationalUnit, borrowernumber as objectGUID, concat('/home/',borrowernumber) as homeDirectory from borrowers }; # we need reverse LDAP -> SQL mapping for where clause my $ldap_sql_mapping = { 'uid' => 'userid', 'objectGUID' => 'borrowernumber', 'displayName' => 'surname', 'sn' => 'surname', 'pager' => 'rfid_sid', }; # attributes which are same for whole set, but somehow # LDAP clients are sending they anyway and we don't # have them in database my $ldap_ignore = { 'objectclass' => 1, }; sub __sql_column { my $name = shift; $ldap_sql_mapping->{$name} || $name; } use constant RESULT_OK => { 'matchedDN' => '', 'errorMessage' => '', 'resultCode' => LDAP_SUCCESS }; # constructor sub new { my ($class, $sock) = @_; my $self = $class->SUPER::new($sock); print "connection from: ", $sock->peerhost(), "\n"; return $self; } # the bind operation sub bind { my $self = shift; my $reqData = shift; warn "# bind ",dump($reqData); return RESULT_OK; } our @values; our @limits; sub __ldap_search_to_sql { my ( $how, $what ) = @_; warn "### how $how\n"; if ( $how eq 'equalityMatch' && defined $what ) { my $name = $what->{attributeDesc} || warn "ERROR: no attribute +Desc?"; my $value = $what->{assertionValue} || warn "ERROR: no asserti +onValue?"; if ( ! $ldap_ignore->{ $name } ) { push @limits, __sql_column($name) . ' = ?'; push @values, $value; } } elsif ( $how eq 'substrings' ) { foreach my $substring ( @{ $what->{substrings} } ) { my $name = $what->{type} || warn "ERROR: no type?"; while ( my($op,$value) = each %$substring ) { push @limits, __sql_column($name) . ' LIKE ?'; if ( $op eq 'any' ) { $value = '%' . $value . '%'; } else { warn "UNSUPPORTED: op $op - using plain $value"; } push @values, $value; } } } elsif ( $how eq 'present' ) { my $name = __sql_column( $what ); push @limits, "$name IS NOT NULL and length($name) > 1"; ## XXX length(foo) > 1 to avoid empty " " strings } else { warn "UNSUPPORTED: how $how what ",dump( $what ); } } # the search operation sub search { my $self = shift; my $reqData = shift; print "searching...\n"; warn "# " . localtime() . " request = ", dump($reqData); my $base = $reqData->{'baseObject'}; # FIXME use it? my @entries; if ( $reqData->{'filter'} ) { my $sql_where = ''; @values = (); foreach my $join_with ( keys %{ $reqData->{'filter'} } ) { warn "## join_with $join_with\n"; @limits = (); if ( ref $reqData->{'filter'}->{ $join_with } ) { foreach my $filter ( @{ $reqData->{'filter'}->{ $join_ +with } } ) { warn "### filter ",dump($filter),$/; foreach my $how ( keys %$filter ) { if ( $how eq 'or' ) { __ldap_search_to_sql( %$_ ) foreach ( @{ $ +filter->{$how} } ); } else { __ldap_search_to_sql( $how, $filter->{$how +} ); } warn "## limits ",dump(@limits), " values ",du +mp(@values); } } $sql_where .= ' ' . join( " $join_with ", @limits ); } else { __ldap_search_to_sql( $join_with, $reqData->{'filter'} +->{$join_with} ); } } if ( $sql_where ) { $sql_where = " where $sql_where"; } warn "# SQL:\n$sql_select $sql_where\n# DATA: ",dump( @values +); my $sth = $dbh->prepare( $sql_select . $sql_where . " LIMIT $m +ax_results" ); # XXX remove limit? $sth->execute( @values ); warn "# ", $sth->rows, " results for ",dump( $reqData->{'filte +r'} ); while (my $row = $sth->fetchrow_hashref) { warn "## row = ",dump( $row ); my $dn = 'uid=' . $row->{uid} || die "no uid"; $dn =~ s{[@\.]}{,dc=}g; $dn .= ',' . $base unless $dn =~ m{dc}i; my $entry = Net::LDAP::Entry->new; $entry->dn( $dn ); $entry->add( objectClass => [ "person", "organizationalPerson", "inetOrgPerson", "hrEduPerson", ] ); $entry->add( %$row ); #$entry->changetype( 'modify' ); warn "### entry ",$entry->dump( \*STDERR ); push @entries, $entry; } } else { warn "UNKNOWN request: ",dump( $reqData ); } return RESULT_OK, @entries; } # the rest of the operations will return an "unwilling to perform" 1;

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://754027]
Approved by Arunbear
Front-paged by Arunbear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others sharing their wisdom with the Monastery: (4)
As of 2024-03-28 21:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found