Определить исходный порт пакета IPv4 с perl

Question

У меня есть скрипт perl, который считывает и обрабатывает пакеты IPv4 из интерфейса TunTap. Лишенный немного вниз, это выглядит следующим образом:

#!/usr/bin/perl 
use warnings; 
use strict; 
use Common; 
use Linux::TunTap; 
use NetPacket::IP; 
use IO::Socket; 
$|++; 

###### Predecs ##### 
my $tun; 
my %config = Loadconfig(); 

$tun = Linux::TunTap->new(NAME => $config{'localtun_name'}) 
or die "Couldn't connect to Interface $config{localtun_name}\n"; 
print "Interface up: " . $tun->{interface} . "\n"; 

while (my $rawdata = $tun->get_raw()) { 
     $rawdata =~ s/^....//; # Strip the TunTap header 
     my $packet = NetPacket::IP->decode($rawdata); 
     print "$packet->{id} $packet->{src_ip} -> $packet->{dest_ip} $packet->{proto} $packet->{len}\n"; 
     # Do some processing here 
} 

Для маршрутизации причин, мне нужно знать порт источника данных. Я не нашел способ сделать это с помощью NetPacket::IP, так есть ли другой способ определить это? В настоящее время я использую только NetPacket::IP по причинам отладки, поэтому я действительно не настроен на этот модуль, в частности, если другой модуль позволит мне извлечь исходный порт в дополнение к порядковому номеру, размеру, IP-адресу источника и IP-адресу назначения.

Answer 1

NetPacket::IP касается только IP-пакетов, не имеющих понятия портов. Порты работают только на уровне TCP/UDP (или на том, что вы наложили поверх IP), так что вам нужно, например, NetPacket::TCP для получения этой информации. Вероятно, вам придется посмотреть на $ packet -> {proto}, чтобы решить, какой модуль (TCP или UDP) вы хотите использовать для синтаксического анализа layer4.

Если вы уверены, что вам не понадобятся дополнительные поля заголовков, для которых будут иметь смысл модули более высокого уровня NetPacket, вы можете использовать тот факт, что исходный порт находится в первых 16 битах заголовка как для TCP и UDP, так что можно сказать

# Untested, so I'm not sure about the case returned in 
# $packet->{proto} 
if($packet->{proto} eq 'tcp' or $packet->{proto} eq 'udp') { 
    $port = unpack('n', $packet->{data}); 
    ... 
} 

Edit: КСТАТИ, используя SUBSTR() вместо замены регулярных выражений должен быть быстрее, если это вызывает озабоченность.