database shell
search   /var/pg2ldap/backend.pl

##</code><code>##

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'

##</code><code>##

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 fields
# 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, $filter);
	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);
}