Programming Jabber

The ldapr script

While the explanation might be long, the actual script, shown in Example 10-17, is relatively short. Written in Perl, the ldapr script uses the Jabber::Connection library.

Example 10-17. The ldapr script, written in Perl

use strict; use Jabber::Connection; use Jabber::NodeFactory; use Jabber::NS qw(:all); use Net::LDAP; my $ldapsrv = 'cicero'; my $basedn = 'dc=demo,dc=org'; my $ldap = Net::LDAP->new($ldapsrv) or die $@; debug("connecting to Jabber"); my $c = new Jabber::Connection( server => 'localhost:9389', localname => 'ldap.cicero', ns => 'jabber:component:accept', ); unless ($c->connect()) { die "Oops: ".$c->lastError; } debug("registering IQ handlers"); $c->register_handler('iq',\&iq_browse); $c->register_handler('iq',\&iq_notimpl); debug("authenticating"); $c->auth('pass'); debug("waiting for requests"); $c->start; sub iq_browse { my $node = shift; return unless $node->attr('type') eq IQ_GET and my $query = $node->getTag('', NS_BROWSE); my ($obj) = $node->attr('to') =~ /\/(.*)$/; debug("request: $obj"); my $result = $ldap->search( base => $obj ? join(',', $obj, $basedn) : $basedn, filter => "(objectclass=*)", scope => 'one', ); if ($result->code) { debug("search error: ".$result->error); } else { foreach my $entry ($result->all_entries) { my $e = strip($entry->dn, $basedn); debug("found: $e"); my $item = $query->insertTag(isUser($e) ? "user" : "item"); $item->attr('jid', join('/', $ID, $e)); $item->attr('name', [split(/,/, $e)]->[0]); } } $node = toFrom($node); ...