LDAP Debugger#

We had the privilege to work with Aaron Spangler on a project a number of years ago.

We had an issue where we could not figure out issues between a obscure LDAP server and a more obscure LDAP client.

Arron wrote this Perl tool to help track down the issue.

The tool is a go-between the LDAP Client and the LDAP server. Could have been done with a Packet Analyzer but they were not available to us at the time.

The LDAP debugger listens on a port for LDAP traffic and each request that is received form the LDAP Client is repeated to the LDAP server.

The response from the LDAP server is received and repeated to the client.

The messages are "dumped" in a formatted message to STOUT or a file.

Now almost everyone can get to a Packet Analyzer. But at that time, this was a life saver.

Output#

Typical output would look like:

Client --> Server (Request) \{
    searchRequest => {
      timeLimit => 60,
      baseObject => "ou=butler,ou=people,dc=willeke,dc=com",
      filter => {
        present => "objectclass"
      },
      sizeLimit => 0,
      typesOnly => 0,
      derefAliases => 0,
      attributes => [
        "objectclass"
      ],
      scope => 2
    },
    controls => [
      {
        critical => 1,
        value => "0\204\0\0\0\5\2\1d\4\0",
        type => "1.2.840.113556.1.4.319"
      }
    ],
    messageID => 52
  }
Client <-- Server (Response) \{
    protocolOp => {
      searchResEntry => {
        objectName => "cn=tv,ou=butler,ou=people,dc=willeke,dc=com",
        attributes => [
          {
            type => "objectclass",
            vals => [
              "inetOrgPerson",
              "organizationalPerson",
              "Person",
              "ndsLoginProperties",
              "Top",
              "dicPersonInfo",
              "DirXML-PasswordSyncStatusUser",
              "posixAccount",
              "shadowAccount",
              "sambaSamAccount"
            ]
          }
        ]
      }
    },
    messageID => 52
  }
  

Source Code#

Before using this, please review the GNU Public licenseContent unavailable! (broken link)https://ldapwiki.com/wiki/images/out.png and our Standard Disclaimer

#!/usr/bin/perl
#
# Copyright Sep 01,2002 Aaron Spangler under the GNU Public License
#
use strict;
use Data::Dumper;
use IO::Socket;
use Convert::ASN1 qw/asn_read/;
use IO::Select;

# comment the next two lines out to send to screen.
open F, ">ldaptrace.log";
select F;

my $server = "192.168.1.8:389";

my $locallistenport = 1389;

my $lsn = new IO::Socket::INET( Listen => 1, LocalPort => $locallistenport )
  or die;

$SIG{__DIE__} = \&cleansocks;
$SIG{INT}     = \&cleansocks;

my $sel = new IO::Select($lsn);

my %connects = ();
my %clients  = ();

print "ready for connections\n";
dumpstatus();
while ( my @ready = $sel->can_read ) {
	foreach my $fh (@ready) {
		if ( $fh == $lsn ) {

			# Create a new socket
			my $client = $lsn->accept;
			print "new client\n";
			my $server = new IO::Socket::INET($server)
			  or warn "server connect failed";
			$sel->add($client);
			$sel->add($server);
			$connects{$client} = $server;
			$connects{$server} = $client;
			$clients{$client}  = 1;
			dumpstatus();
		}
		else {

			# Process socket
			#print "packet\n";
			my $fh2 = $connects{$fh};
			if ( !handle( $fh, $fh2 ) ) {
				print "Closing\n";

				# problem so close it
				$sel->remove($fh);
				$sel->remove($fh2);
				$fh->close;
				$fh2->close if defined $fh2;

				# cleanup
				delete $connects{$fh};
				delete $connects{$fh2};
				delete $clients{$fh};
				delete $clients{$fh2};
				dumpstatus();
			}
		}
	}
}

# still seems to leave a few lingering..
sub cleansocks {
	print "cleaning up...\n";

	# ignore errors
	eval {
		$lsn->shutdown(2);
		$lsn->close();
		$_ && $_->shutdown(2) foreach keys %connects;
		$_ && $_->close foreach keys %connects;
	};
}

sub dumpstatus {

	#print Dumper(\%connects);
	if (%connects) {
		print "Connections: ", scalar( keys %connects ) / 2, "\n";
	}
	else {
		print "\nNo Connections.\n\n\n\n\n";
	}
}

#
# data waiting from fh1 to go to fh2
#
sub handle {
	my ( $fh1, $fh2 ) = @_;

	# show direction header
	if ( $clients{$fh1} ) {
		print "Client --> Server ";
	}
	elsif ( $clients{$fh2} ) {
		print "Client <-- Server ";
	}
	else {
		print "???    <-> ???    ";
	}

	my $data;
	my $size = asn_read( $fh1, $data );
	print "done\n" and return undef if $size < 1;

	#print "length $size:\n";
	parse_packet($data);
	print "write failed\n" and return undef if $size != syswrite( $fh2, $data );
	1;

}

sub rawdump {
	my ($data) = @_;
	my $length = length($data);
	my @data = unpack( "C*", $data );
	my ( $x, $y );

	# do up to 16 bytes per row
	for ( $y = 0 ; $y < $length ; $y += 16 ) {
		for ( $x = 0 ; $x < 16 ; $x++ ) {
			if ( $x + $y < $length ) {
				my $c = $data[ $x + $y ];
				if ( $c >= 32 && $c < 127 ) {

					# printable
					printf " %c ", $c;
				}
				else {

					# non-printable show hex instead
					printf "%02x ", $c;
				}
			}
			else {

				# out of data range, so just padd
				printf "   ";
			}
		}
		printf "\n";
	}
}

sub parse_packet {
	my ($pdu) = @_;

	#  print "read ",length($pdu),"\n";
	use Net::LDAP::Message;
	use Net::LDAP::ASN qw(LDAPRequest LDAPResponse);
	local $Data::Dumper::Indent    = 1;
	local $Data::Dumper::Quotekeys = 0;
	local $Data::Dumper::Terse     = 1;
	local $Data::Dumper::Useqq     = 1;
	my $result;

	if ( $result = $LDAPResponse->decode($pdu) ) {
		print "(Response) ", Dumper( \$result );
	}
	elsif ( $result = $LDAPRequest->decode($pdu) ) {
		print "(Request) ", Dumper( \$result );
	}
	else {
		print "(Raw)\n";
		rawdump($pdu);
	}
}

More Information#

There might be more information for this subject on one of the following:

• Tools