#!/usr/bin/perl
#
# Replay LDAP TCP sessions to an arbitrary LDAP server from a tcpdump.
# Be sure to adjust the IP addresses that filter the traffic and specify
# where the connections should be made to. Will be memory intensive to
# the tune of the number of connections in the tcpdump file.
#
# Collect the data via:
#
#   tcpdump -vv -c 100000 -s 0 -w ldap-traffic port 389
#
# Install the custom modules via http://search.cpan.org/perldoc/local::lib

use strict;
use warnings;

my $file = shift || die "Usage: $0 ldap-traffic-tcp-dump\n";

# LDAP server IP to filter connections on
my $LDAP_SERVER_IP = '192.0.2.10';

# IP to replay the traffic to
my $DST_IP    = '192.0.2.110';
my $LDAP_PORT = 389;

use IO::Socket::INET;
use Net::Frame::Dump::Offline;
use Net::Write::Layer3;
use Net::Frame::Simple;
use Net::Frame::Layer::IPv4 qw(:consts);
use Net::Frame::Layer::TCP qw(:consts);
use Time::HiRes qw(sleep);

########################################################################
#
# COLLECTION
#
# Build stash of previous full TCP connections. Sessions started prior
# to the tcpdump starting will be ignored.

my %seen;

my $oDump = Net::Frame::Dump::Offline->new( file => $file );
$oDump->start;

my $count = 0;
DGRAM: while ( my $h = $oDump->next ) {
  my $f = Net::Frame::Simple->new(
    raw        => $h->{raw},
    firstLayer => $h->{firstLayer},
    timestamp  => $h->{timestamp},
  );

  my $orig_ipv4;

  for my $l ( $f->layers ) {
    if ( ref $l eq 'Net::Frame::Layer::IPv4' ) {
      next DGRAM if $l->dst ne $LDAP_SERVER_IP;
      $orig_ipv4 = $l;

    } elsif ( ref $l eq 'Net::Frame::Layer::TCP' ) {
      if ( $l->flags & NF_TCP_FLAGS_SYN ) {
        push @{ $seen{ $orig_ipv4->src . $l->src } },
          { ip => $orig_ipv4, tcp => $l };
      } else {
        if ( exists $seen{ $orig_ipv4->src . $l->src } ) {
          push @{ $seen{ $orig_ipv4->src . $l->src } },
            { ip => $orig_ipv4, tcp => $l };
        }
      }
    }
  }
}
$oDump->stop;

########################################################################
#
# REPLAY
#
# Simplistic replay from %seen stash: sends previous payloads over a new
# TCP connection. Disregards server responses, random delay before
# sending next datagram.

for my $conn ( values %seen ) {
  my $io =
    IO::Socket::INET->new( PeerAddr => "$DST_IP:$LDAP_PORT", Proto => "tcp" );

  for my $frame (@$conn) {
    if ( defined $frame->{tcp}->payload
      and length $frame->{tcp}->payload > 0 ) {

      my $epoch = time();
      print "$epoch ", $frame->{ip}->src, ":", $frame->{tcp}->src,
        " ipv4-id ",
        $frame->{ip}->id, " tcp-seq ", $frame->{tcp}->seq, "\n";

      $io->send( $frame->{tcp}->payload );
      # TODO could replicate the timestamps somehow, but that's more work...
      sleep 0.1 + rand;
    }
  }

  # Be a good network citizen (otherwise see RST related logs in directory
  # server error log).
  $io->shutdown(2);
  $io->close();

  #sleep 3; # spacer to try to isolate if there is a specific Packet Of Death
}
