#!/usr/bin/perl -w
# $Id: flypaperd.txt,v 1.1 2006/10/08 11:38:06 jfranken Exp $
# Author: Johannes Franken <jfranken@jfranken.de>
# vim: ft=perl:ts=4

use strict;
use IPTables::IPv4::IPQueue qw(:constants);
use NetPacket::IP           qw(:ALL);
use NetPacket::TCP          qw(:ALL);
use NetPacket::UDP          qw(:ALL);
use Unix::Syslog            qw(:macros);
use Unix::Syslog            qw(:subs);
use POSIX                   'setsid';



sub daemonize {
	chdir '/'                 or die "Can't chdir to /: $!";
	open STDIN, '/dev/null'   or die "Can't read /dev/null: $!";
	open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
	defined(my $pid = fork)   or die "Can't fork: $!";
	exit if $pid;
	setsid                    or die "Can't start a new session: $!";
	open STDERR, '>&STDOUT'   or die "Can't dup stdout: $!";
}


sub writelog($) {
# Write a message to syslog about the protocol and port of the given ippacket
	# USAGE: writelog($ippacket);
	my ($message, $proto, $ipaddr);
	my $ippacket=shift;

	$proto =$ippacket->{proto};
	$ipaddr=$ippacket->{src_ip};

	if ($proto == IP_PROTO_TCP) {
	 $message="TCP-port " . NetPacket::TCP->decode($ippacket->{data})->{dest_port};
	} elsif  ($proto == IP_PROTO_UDP) {
	 $message="UDP-port " . NetPacket::UDP->decode($ippacket->{data})->{dest_port};
	} else {
	$message="IP-protocol $proto";
	}
	openlog "flypaperd", LOG_PID | LOG_PERROR, LOG_AUTH;
	syslog LOG_WARNING, "lockout $ipaddr, who tried $message";
	closelog;
}


###########################################
#
# MAIN
# 

# Check if ip_queue is available and accessible.
open(IP_QUEUE,"</proc/net/ip_queue")
	or die "ERROR: Missing kernel support. Please modprobe ip_queue\n";

unless (<IP_QUEUE>=~m/: 0\n$/) {
	die "ERROR: 'QUEUE' target is in use by another process.\n";
}
close IP_QUEUE;


daemonize();

# Create pidfile (if $flypaperdpidfile environment variable is set)
if (my $pidfile=$ENV{"flypaperdpidfile"}) {
	open (PIDFILE,">$pidfile");
	print PIDFILE "$$";
	close PIDFILE;
}

# Attach to QUEUE target
my $ipq = new IPTables::IPv4::IPQueue(
	copy_mode  => IPQ_COPY_PACKET,
	copy_range => 1500);


while (1) {
	# Wait for a packet from QUEUE target
    my $msg = $ipq->get_message; 
    my $ippacket = NetPacket::IP->decode($msg->payload);

    # Put the sender of this packet on the blacklist
    system("iptables -I flypaper -s " . $ippacket->{src_ip} . " -j DROP");

    # Drop the packet
    $ipq->set_verdict($msg->packet_id, NF_DROP);

    # Log this incident
    writelog($ippacket);
}