From: Dobrica Pavlinusic <dpavlin@rot13.org>
Date: Mon, 23 Mar 2009 20:26:48 +0000 (+0000)
Subject: simple LDAP server which reads data from Koha
X-Git-Url: http://git.rot13.org/?p=virtual-ldap;a=commitdiff_plain;h=97697527827da534e72c5ed16d577df9ff21f837;ds=sidebyside

simple LDAP server which reads data from Koha
indexed by otherPager which is cardnumber in Koha
---

diff --git a/bin/ldap-koha.pl b/bin/ldap-koha.pl
new file mode 100755
index 0000000..d50ebbc
--- /dev/null
+++ b/bin/ldap-koha.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use IO::Select;
+use IO::Socket;
+use lib 'lib';
+use LDAP::Koha;
+
+my $port = 2389;
+
+my $sock = IO::Socket::INET->new(
+	Listen => 5,
+	Proto => 'tcp',
+	Reuse => 1,
+	LocalPort => $port,
+) || die;
+
+warn "# listening on $port";
+
+my $sel = IO::Select->new($sock);
+my %Handlers;
+while (my @ready = $sel->can_read) {
+	foreach my $fh (@ready) {
+		if ($fh == $sock) {
+			# let's create a new socket
+			my $psock = $sock->accept;
+			$sel->add($psock);
+			$Handlers{*$psock} = LDAP::Koha->new($psock);
+		} else {
+			my $result = $Handlers{*$fh}->handle;
+			if ($result) {
+				# we have finished with the socket
+				$sel->remove($fh);
+				$fh->close;
+				delete $Handlers{*$fh};
+			}
+		}
+	}
+}
+
+1;
diff --git a/lib/LDAP/Koha.pm b/lib/LDAP/Koha.pm
new file mode 100644
index 0000000..3c7c1de
--- /dev/null
+++ b/lib/LDAP/Koha.pm
@@ -0,0 +1,107 @@
+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=200903160021'
+#
+
+our $dsn      = 'DBI:mysql:dbname=';
+our $database = 'koha';
+our $user     = 'unconfigured-user';
+our $passwd   = 'unconfigured-password';
+
+require 'config.pl' if -e 'config.pl';
+
+my $dbh = DBI->connect($dsn . $database, $user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;
+
+my $sth = $dbh->prepare(q{
+	select
+		userid			as uid,
+		firstname		as givenName,
+		surname			as sn,
+		cardnumber		as otherPager,
+		email			as mail
+	from borrowers
+	where
+		cardnumber = ?
+});
+
+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;
+}
+
+# the search operation
+sub search {
+	my $self = shift;
+	my $reqData = shift;
+	print "searching...\n";
+
+	warn "# request = ", dump($reqData);
+
+	my $base = $reqData->{'baseObject'}; # FIXME use it?
+
+	my @entries;
+	if ( $reqData->{'filter'}->{'equalityMatch'}->{'attributeDesc'} eq 'otherPager' ) {
+
+		my $value = $reqData->{'filter'}->{'equalityMatch'}->{'assertionValue'} || die "no value?";
+
+		$sth->execute( $value );
+
+		warn "# ", $sth->rows, " results for: $value\n";
+
+		while (my $row = $sth->fetchrow_hashref) {
+
+			warn "## row = ",dump( $row );
+
+			my $dn = 'uid=' . $row->{uid} || die "no uid";
+			$dn =~ s{[@\.]}{,dc=}g;
+
+			my $entry = Net::LDAP::Entry->new;
+			$entry->dn( $dn );
+			$entry->add( %$row );
+
+			#warn "## entry ",dump( $entry );
+
+			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;