Altering a packet and writing to network layer

[nexus024]

I am trying to write a program that will continuously sniff eth0 for a specific UDP packet thats being sent to a specific destination IP, alter the data of the packet, and finally transmit it to the destination. My script compiles find and runs fine until it finds the specific packet and tries to alter the payload of the data. Hopefully someone can give me some insight on why it might be doing this...

script.pl
#!/usr/bin/perl -w
#
# Custom script:
# A program to catch specific outgoing UDP packets, alter the
# payload data, and then write the packet onto the network layer.

# Destination IP address
my $DEST_IP='192.246.40.56';

# The unprivileged uid/gid under which we should run.
my $UNPRIV="200";

use Net::Pcap;
use FileHandle;
use strict;
use English;
use NetPacket::IP qw(IP_PROTO_UDP);
use NetPacket::UDP;
use Net::RawSock;


while ( 1 ) {

my $pid = fork();
if ( ! defined $pid ) { die "Unable to fork. Yikes." };

if ( $pid ) {
# Parent process (running as root) will wait for
# child. If child exits, we'll create another one.
wait();
sleep(1); # To keep us from respawning too fast if necessary.
} else {
print "Script starting\n";

# Child process will do actual sniffing.
# First, create our packet capturing device
my($pcap_t) = create_pcap();

unless ( $pcap_t ) {
die "Unable to create pcap";
}

# Let's stop running as root. Since we already
# have our pcap descriptor, we can still use it.
$EGID="$UNPRIV $UNPRIV"; # setgid and setgroups()
$GID=$UNPRIV;
$UID=$UNPRIV; $EUID=$UNPRIV;

# Capture packets forever.
Net::Pcap::loop($pcap_t, -1, \&process_pkt, 0);

# Technically, we shouldn't get here since the loop
# is infinite (-1), but just in case, close and exit.
Net::Pcap::close($pcap_t);
exit 1;
}
}

sub create_pcap {
my $promisc = 0; # We're only looking for packets destined to us,
# so no need for promiscuous mode.
my $snaplen = 135; # Allows a max of 80 characters in the domain name

my $to_ms = 0; # timeout
my $opt=1; # Sure, optimisation is good...
my($err,$net,$mask,$dev,$filter_t);

my $filter = "udp dst port 49169 and dst host $DEST_IP";

# Look up an appropriate device (eth0 usually)
$dev = Net::Pcap::lookupdev(\$err);
$dev or die "Net::Pcap::lookupdev failed. Error was $err";
#$dev = "eth0";

if ( (Net::Pcap::lookupnet($dev, \$net, \$mask, \$err) ) == -1 ) {
die "Net::Pcap::lookupnet failed. Error was $err";
}

# Actually open up our descriptor
my $pcap_t = Net::Pcap::open_live($dev, $snaplen, $promisc, $to_ms, \$err);
$pcap_t || die "Can't create packet descriptor. Error was $err";

if ( Net::Pcap::compile($pcap_t, \$filter_t, $filter, $opt, $net) == -1 ) {
die "Unable to compile filter string '$filter'\n";
}

# Make sure our sniffer only captures those bytes we want in
# our filter.
Net::Pcap::setfilter($pcap_t, $filter_t);

# Return our pcap descriptor
$pcap_t;
}

# Routine to process the packet -- called by Net::Pcap::loop()
# every time an appropriate packet is snagged.
sub process_pkt {
my($data) = @_;

my($ip_obj) = NetPacket::IP->decode($data);

if($ip_obj->{proto} == IP_PROTO_UDP) {

#decode the udp header
my($udp_obj) = NetPacket::UDP->decode($ip_obj->{data});

#replace protocol 68 with protocol 0
$udp_obj->{data} =~ s/68/0/g;

#re-encode the packet
$ip_obj->{data} = $udp_obj->encode($ip_obj);
$data = $ip_obj->encode;
#my($pkt) = $data->encode;
}

#write the packet to the network layer
Net::RawSock::write_ip($data);
}

error messages
nick@nick-desktop:~/Desktop$ sudo perl sniffer2.pl
Script starting
Use of uninitialized value in right bitshift (>>) at /usr/local/share/perl/5.8.7/NetPacket/IP.pm line 151.
Use of uninitialized value in bitwise and (&) at /usr/local/share/perl/5.8.7/NetPacket/IP.pm line 152.
Use of uninitialized value in unpack at /usr/local/share/perl/5.8.7/NetPacket/IP.pm line 163.
Use of uninitialized value in right bitshift (>>) at /usr/local/share/perl/5.8.7/NetPacket/IP.pm line 115.
Use of uninitialized value in right bitshift (>>) at /usr/local/share/perl/5.8.7/NetPacket/IP.pm line 116.
Use of uninitialized value in right bitshift (>>) at /usr/local/share/perl/5.8.7/NetPacket/IP.pm line 117.
Use of uninitialized value in bitwise and (&) at /usr/local/share/perl/5.8.7/NetPacket/IP.pm line 118.
Use of uninitialized value in right bitshift (>>) at /usr/local/share/perl/5.8.7/NetPacket/IP.pm line 115.
Use of uninitialized value in right bitshift (>>) at /usr/local/share/perl/5.8.7/NetPacket/IP.pm line 116.
Use of uninitialized value in right bitshift (>>) at /usr/local/share/perl/5.8.7/NetPacket/IP.pm line 117.
Use of uninitialized value in bitwise and (&) at /usr/local/share/perl/5.8.7/NetPacket/IP.pm line 118.
Use of uninitialized value in numeric eq (==) at sniffer2.pl line 102.

[cat45]

Apologies for answering an old post, but even with the error in his script, it helped me with an idea for my code. So, I'm answering in case it will help someone in the future.

I was working on something similiar and found the problem I detailed below. I already had it all typed up, but it didn't make sense that you had the same problem, and I looked closer and you don't have the same problem. I'm leaving the second problem below, since you will probably run into that problem next.

Your current problem is with this bolded line:
sub process_pkt {
my($data) = @_;

The loop method of Net::Pcap takes 4 arguments, the handle to the Packet Capture, the number of packets to count, a callback function, and a user defined scalar for identification purposes ( call it $var ). Your user defined $var = 0 from the loop call. The call back function is handed 3 variables by the loop method, in this order: The user defined $var from above, header information for the packet, and the packet itself. By only declaring a single variable to take all of the input, your $data="0". Try this instead
sub process_pkt {
my($u, $h, $data) = @_;



Below is the original post I had started, if you have the same IP.pm I do, you will see this also.
_______________________________________
In IP.pm, the encode method assigns the caller to $self

my $self = shift;

Then it sets the bits of the flags and fragment offset to $offset

$offset = $self->{flags} << 13;
$offset = $offset | (($self->{foffset} >> 3) & 0x1fff);

Next, it creates the header in $hdr with a pack() call
$hdr = pack('CCnnnCCna4a4a*', $tmp, $self->{tos},$self->{len},
$self->{id}, $self->{offset}, $self->{ttl}, $self->{proto},
$zero, $src_ip, $dest_ip, $self->{options});


I bolded the bad part, there is no 'offset' key in hash self, there is a 'foffset' key, but we OR'd that with the 'flags' key to create $offset. That line should read, imho

$hdr = pack('CCnnnCCna4a4a*', $tmp, $self->{tos},$self->{len},
$self->{id}, $offset, $self->{ttl}, $self->{proto},
$zero, $src_ip, $dest_ip, $self->{options});


There is a similiar typo in the pack() of the packet itself that needs to be changed also. I have NetPacket 0.04. At least changing those made my error go away. Though, from the errors you are seeing, I think your problem is a line or two before you get to the pack(). This module hasn't been modified in six years and has a couple of unimplemented functions. I'll be contacting the author, but not sure if he is still maintaining this. I wouldn't consider this for anything production.