#!/usr/bin/perl -w
# Copyright (c) 2009 by James F. Carter
# Licensed under Gnu Public License version 2.0 (or at the user's option,
# any later version).  See /usr/share/doc/licenses/GPL-2.0.txt .  As
# detailed in that file, there is NO WARRANTY for this program.  

# Creates a tun/tap mirror interface.  All traffic received from it is sent
# right back out again.  Command line arguments:
#	TunnelMirror ipaddr [interface]
# The IP address is required.  It should be a suitable (set of) argument(s)
# to ifconfig, for example 127.0.1.89/30.  The interface ID (e.g. tun0) is 
# optional.  

# The interface is a "tun" type, i.e. handles internal IP frames, not Ethernet
# packets.  

# Suppose you have a Kerberos KDC on host X and you want users authenticating
# on X to use X's own KDC.  The KDC does not listen on loopback interfaces.  
# However, it doesn't realize that this is looping back and listens on it 
# automatically.  In /etc/krb5.conf prepend to your realm's list of KDCs:
#	kdc = 127.0.1.89
# or whatever IP address you put on the tunnel.  The address chosen is not
# critical so long as you don't shadow a real address or net, which is
# why the 127.x.x.x range is useful.  Let b = number of bits (here, 30),
# and N = 2^(32-b) (here N = 4).  Addresses that are a multiple of N, or
# 1 less than a multiple (here, 88 and 91) are reserved as broadcast 
# addresses, so don't use them.  That's why I picked 89 rather than 88.

use strict;

use Linux::TunTap;

		# Arrange command line arguments
my (@args, $ipaddr);
die "Usage: TunnelMirror ipaddr [interface], ipaddr is required\n"
	unless 1 <= @ARGV && @ARGV <= 2;
$ipaddr = $ARGV[0];
push(@args, NAME => $ARGV[1]) if @ARGV == 2;

		# Allocate the tunnel device.
my $tap = Linux::TunTap->new(@args) or
    die "Can't allocate tunnel device $ARGV[0]: $!\n";
my $ifc = $tap->{interface};
# warn "Tunnel device name: $ifc\n"; #unless @args; #DEBUG

		# Configure an IP address on the tunnel device.
my $cmd = "ifconfig $ifc $ipaddr";
0 == system $cmd or 
    die "'$cmd' failed, giving up.\n";

		# Do the mirror thing.
my ($packet, $rc);
while ($packet = $tap->get_raw()) {
    $rc = $tap->put_raw($packet);
    warn "Error writing packet: $!\n" unless defined($rc);
}
die "Error reading packet: $!\n";