http://www.perlmonks.org?node_id=133389
Category: Networking Code
Author/Contact Info Carl Forde cforde@attglobal.net
Description: This is something I'd been thinking about doing for a while. The other day I saw Simple UDP example anyone? and decided it was time.

The way to use it is to change the first 5 variable declarations to suit, make sure the server is running, run this script (which will redirect requests to the server) and start the client. The client will think it's talking to the server and the server will think it is talking to the client. Meanwhile the script is displaying their conversation for you to see. Great for debugging UDP applications when you don't have real networking tools available. With a little tinkering you could also, uhmm, diddle with the conversation...

update: improved formatting and link

#!/usr/bin/perl -w

# Simple "man in the middle" for UDP traffic that echos the conversati
+on
# to the console.
#
# Accepts a connection from a client and forwards the data to a server
+,
# captures the server response and forwards it to the client. It keeps
# passing data between them until a timeout occurs.


use strict;
use IO::Socket;
use IO::Select;
use 5.6.1;            # untested on anything else

my $request_port = 370;        # server port
my $answer_port  = 9370;    # client port
my $server_name  = 'localhost';    # where to send what I received
my $server_port  = 670;        # port on which to send it
my $timeout      = 15;        # seconds to wait for new data to arrive

my $client_listen;        # connection from client
my $client_send;        # connection to client
my $server_send;        # connection to/from server

my $connections;        # handle to the sockets I'm listening to
my $data;            # what I received
my @ready;            # which sockets have pending data
my $flags;            # udp flags, passed along blindly


$client_listen = IO::Socket::INET->new(    Proto=>"udp",    # connecti
+on for client to talk to me
                    LocalPort=>$request_port)
    or die "Unable to listen to UDP port $request_port: $@";
$client_listen->recv($data, 65536, $flags);        # block for initial
+ client connection

$client_send = IO::Socket::INET->new(    Proto    => "udp",     # conn
+ect back to client
                    PeerPort => $client_listen->peerport,
                    PeerAddr => $client_listen->peerhost)
    or die "Unable to open UDP connection to $client_listen->peerhost,
+ $client_listen->peerport: $@";

$server_send = IO::Socket::INET->new(    Proto     => "udp",     # "tw
+o-way" connect to server
                    PeerPort  => $server_port,
                    PeerAddr  => $server_name,
                    LocalPort => $answer_port)
    or die "Unable to open UDP connection to $server_name, $server_por
+t: $@";

$connections = new IO::Select($client_listen);
$connections->add($server_send);    # now ready to listen in both dire
+ctions

display("client", $data);
$server_send->send($data, $flags);    # send to the server what the cl
+ient sent to me

while (@ready = $connections->can_read($timeout)) {
    foreach my $connection (@ready) {        # wait for more data to a
+rrive
        $connection->recv($data, 65536, $flags);

        if ($connection == $client_listen) {    # something to send to
+ the server
            display("client", $data);
            $server_send->send($data, $flags)
                or die "Unable to send to Server: $@";

        } elsif ($connection == $server_send) { # something to send to
+ the client
            display("server", $data);
            $client_send->send($data, $flags)
                or die "Unable to send to Client: $@";
        }                    # shouldn't be anything else
    }
}

# timed out, now clean up

$connections->remove($client_listen);
$connections->remove($server_send);
$client_listen->close();
$server_send->close();

exit;


# display the data in both hex and text format eg.
# [Client => Server (48 bytes) 2001-12-19 16:30:31]
# 0000: 4869206d 6f6d2120 4d616b69 6e672066    Hi m om!  Maki ng f
# 0010: 7269656e 64732026 20686176 696e6720    rien ds &  hav ing
# 0020: 66756e2e 2053656e 64206d6f 6e65792e    fun.  Sen d mo ney.
#
sub display {
    my ($origin, $data) = @_;
    my ($j, $k);
    my $hexstring = c2x($data);
    my @data = ($data =~ /(.{4})/sg);
    my @hexdata = ($hexstring =~ /(.{8})/g);
    my $extra = length($data) % 4;

    if ($extra > 0) {
        ($data[$#data+1]) = ($data =~ /(.{$extra})$/);
        $extra *= 2;
        ($hexdata[$#hexdata+1]) = ($hexstring =~ /(.{$extra})$/);
    }
    print "[Client";
    ($origin eq "client") ? print " => " : print " <= ";
    print "Server (" . length($data) . " bytes) " . ISO_time() . "]\n"
+;

    for ($j = 0; $j <= $#data; $j += 4) {
        print n2x($j *4) .": ";
        $k = (($j + 3) < $#data) ? ($j +3) : $#data;

        print "$_ " foreach @hexdata[$j..$k];

        if ($k == $#data) {        # last line
            my $leftover;
            foreach (@hexdata[$j..$k]) {
                $leftover .= "$_ ";
            }
            my $spaces = 36 - length($leftover);

            print " "x$spaces;    # make following text line up nicely
        }
        print "   ";

        foreach (@data[$j..$k]) {
            $_ =~ tr/[ -~]/./c;    # handle unprintables
            print "$_ ";
        }
        print "\n";
    }
    print "\n";
}

# Convert a character string to a hex string
#
sub c2x {
    return unpack('H*', pack('a*', @_))
}

# Convert an integer number to a hex string
#
sub n2x {
    return unpack('H*', pack('n*', @_))
}

# Convert a Unix epoch timestamp to ISO 8601 standard format
# or return an ISO 8601 format timestamp for the current time
#
sub ISO_time {
    my ($second, $minute, $hour, $day, $month, $year) =
        ($_[0]) ? (localtime($_[0]))[0..5] : (localtime())[0..5];

    return sprintf("%4d-%02d-%02d %02d:%02d:%02d",
            $year+1900, $month+1, $day, $hour, $minute, $second);
}

update: corrected hardcoded port for connection back to client