File: example.pl

package info (click to toggle)
nfqueue-bindings 0.4-3
  • links: PTS
  • area: main
  • in suites: wheezy
  • size: 232 kB
  • sloc: ansic: 257; python: 211; perl: 183; makefile: 28; sh: 25
file content (70 lines) | stat: -rwxr-xr-x 1,260 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
#!/usr/bin/perl -w
#
# see http://search.cpan.org/~atrak/NetPacket-0.04/

use strict;

BEGIN {
	push @INC,"perl";
	push @INC,"build/perl";
	push @INC,"NetPacket-0.04";
};

use nfqueue;

use NetPacket::IP qw(IP_PROTO_TCP);
use NetPacket::TCP;
use Socket qw(AF_INET AF_INET6);

my $q;

sub cleanup()
{
	print "unbind\n";
	$q->unbind(AF_INET);
	print "close\n";
	$q->close();
}

sub cb()
{
	my ($dummy,$payload) = @_;
	print "Perl callback called!\n";
	print "dummy is $dummy\n" if $dummy;
	if ($payload) {
		print "len: " . $payload->get_length() . "\n";

		my $ip_obj = NetPacket::IP->decode($payload->get_data());
		print $ip_obj, "\n";
		print("$ip_obj->{src_ip} => $ip_obj->{dest_ip} $ip_obj->{proto}\n");
		print "Id: " . $payload->swig_id_get() . "\n";

		if($ip_obj->{proto} == IP_PROTO_TCP) {
			# decode the TCP header
			my $tcp_obj = NetPacket::TCP->decode($ip_obj->{data});

			print "TCP src_port: $tcp_obj->{src_port}\n";
			print "TCP dst_port: $tcp_obj->{dest_port}\n";
		}

		$payload->set_verdict($nfqueue::NF_DROP);
	}
}


$q = new nfqueue::queue();

$SIG{INT} = "cleanup";

print "setting callback\n";
$q->set_callback(\&cb);

print "open\n";
$q->fast_open(0, AF_INET);

$q->set_queue_maxlen(5000);

print "trying to run\n";
$q->try_run();