Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/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

In reply to UDP sniffer by cforde

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others meditating upon the Monastery: (16)
    As of 2015-07-07 17:55 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (93 votes), past polls