#!/afs/athena/contrib/perl5/perl -w
#!/usr/athena/bin/perl -w
#
# This program forges a 'FIN-ACK' TCP control packet.  This makes it
# possible to close TCP connections which are stuck in LAST_ACK
# because the other side fell off the face of the planet.
# (For more information, run "pod2man tcp-fin.pl | groff -man"...)
#
# Written by Albert Dvornik (bert@mit.edu)
#
# $Id$

use strict;
use Socket;
use FileHandle;

#### assembling packets

sub default ($$) { defined($_[1]) ? $_[1] : $_[0]; }
sub break2  ($)  { (($_[0] >> 8) & 0xFF, $_[0] & 0xFF); }
sub break4  ($)  { (($_[0] >> 24) & 0xFF, ($_[0] >> 16) & 0xFF,
		    ($_[0] >> 8) & 0xFF, $_[0] & 0xFF); }

# Yes, this implements a checksum as per RFC1071.  Trust me.
sub xsum { 0xFFFF - ((unpack("%32S*", $_[0]) % 0xFFFF) ||
		     unpack("%16S*", pack("L", unpack("%32S*", $_[0])))); }

#   0                   1                   2                   3   
#   0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 
#  +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#  |version|  (5)  |      TOS      |          total length         |
#  +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#  |         identification        | *** |           (0)           |
#  +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#  |      TTL      |    protocol   |          IP checksum          |
#  +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#  |                       source address                          |
#  +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#  |                    destination address                        |
#  +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#     (no header options are supported)
#
#  *** flags:   don't fragment (0 or 1)

sub ip_header {
    my %IP = @_;
    my (@data);

    # we have no options, so we hardcode header length ("IHL") to 5
    push @data, ((default 4, $IP{'version'}) << 4) | 5;
    push @data,  (default 0, $IP{'TOS'});
    push @data, break2(default 0, $IP{'total length'});
    push @data, break2(default 0, $IP{'identification'});
    # we ignore fragmentation and only possibly set "Don't Fragment"...
    push @data, ((default 0, $IP{"don't fragment"}) << 6), 0;
    push @data,  (default 255, $IP{'TTL'});
    # default protocol is TCP (6).
    push @data,  (default 6, $IP{'protocol'});
    push @data, break2(default 0, $IP{'IP checksum'});

    pack("C12 a4 a4", @data, $IP{'source address'},$IP{'destination address'});
}

#   0                   1                   2                   3   
#   0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 
#  +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#  |          source port          |       destination port        |
#  +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#  |                          seq number                           |
#  +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#  |                          ack number                           |
#  +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#  |  data |           |U|A|P|R|S|F|                               |
#  | offset|    (0)    |R|C|S|S|Y|I|            window             |
#  |       |           |G|K|H|T|N|N|                               |
#  +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#  |         TCP checksum          |         urgent pointer        |
#  +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#     (sending of options isn't supported)
#  +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
#  |                           TCP data                            |
#  +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+

sub tcp_body {
    my %TCP = @_;
    my (@data);

    push @data, break2(default 0, $TCP{'source port'});
    push @data, break2(default 0, $TCP{'destination port'});
    push @data, break4(default 0, $TCP{'seq number'});
    push @data, break4(default 0, $TCP{'ack number'});

    push @data, ((default 0, $TCP{'data offset'}) << 4);
    push @data, ((default 0, $TCP{'URG'}) << 5 |
		 (default 0, $TCP{'ACK'}) << 4 |
		 (default 0, $TCP{'PSH'}) << 3 |
		 (default 0, $TCP{'RST'}) << 2 |
		 (default 0, $TCP{'SYN'}) << 1 |
		 (default 0, $TCP{'FIN'}));
    push @data, break2(default 0xFFFF, $TCP{'window'});

    push @data, break2(default 0, $TCP{'TCP checksum'});
    push @data, break2(default 0, $TCP{'urgent pointer'});

    defined $TCP{'TCP data'} || ($TCP{'TCP data'} = "");
    pack("C20 a*", @data, $TCP{'TCP data'});
}

#                    +--------+--------+--------+--------+
#                    |           source address          |
#                    +--------+--------+--------+--------+
#                    |         destination address       |
#                    +--------+--------+--------+--------+
#                    |  zero  |protocol|    TCP length   |
#                    +--------+--------+--------+--------+

sub tcp_pseudo_header {
    my %pTCP = @_;
    $pTCP{'source address'} . $pTCP{'destination address'} .
	pack("C4", (0, (default 6, $pTCP{'protocol'}),
		    break2(default 0, $pTCP{'TCP length'})));
}

sub make_packet {
    my ($s_host, $s_port, $d_host, $d_port, $data, @flags) = @_;
    my ($ip, $tcp, $_tcp);

    my @fields = ('source address'	=> $s_host,
		  'source port' 	=> $s_port,
		  'destination address'	=> $d_host,
		  'destination port'	=> $d_port,
		  'TCP data'		=> $data,
		  # This allows us to pass in more options from arg list.
		  @flags);
    $ip =   ip_header(@fields);
    $tcp =  tcp_body(@fields);

    push @fields, ('total length'	=> length($ip) + length($tcp),
		   'TCP length' 	=> length($tcp));
    $ip =   ip_header(@fields);
    $_tcp = tcp_pseudo_header(@fields);
    $tcp =  tcp_body(@fields);

    push @fields, ('IP checksum'	=> xsum($ip),
		   'TCP checksum'	=> xsum($_tcp . $tcp));

    ip_header(@fields) . tcp_body(@fields);
}

#### raw sockets and other fun things

my $IP_HDRINCL = eval "IP_HDRINCL()";
if ($@) { # eval failed
  my @includes = ('sys/socket.h', 'netinet/in.h');
  @includes = map((m@^/@ ? $_ : "/usr/include/$_"), @includes);
  my $GCC = $ENV{'GCC'} || (-e '/mit/gnu/bin/gcc' ? '/mit/gnu/bin/gcc':'gcc');
  my $DEFS = new FileHandle "$GCC -E -dM @includes |";
  $DEFS || die "Can't open a pipe for 'gcc -E -dM': $!";
  undef $IP_HDRINCL;
  while (<$DEFS>) {
    /^\s*#\s*define\s+IP_HDRINCL\s+(\d+)/ && ($IP_HDRINCL = $1);
  }
  defined $IP_HDRINCL || die "Can't find IP_HDRINCL in headers...";
}

my $AF_INET =     AF_INET();
my $SOCK_RAW =    SOCK_RAW();
my $IPPROTO_RAW = getprotobyname('raw');

sub raw_ip {
    my $s = new FileHandle;

    if (!socket($s,  $AF_INET, $SOCK_RAW, $IPPROTO_RAW)) {
	print STDERR "Can't open a raw socket " .
	    "(presumably because you aren't the superuser):\n   $!.\n";
	exit(2);
    }

    $s;
}

#### argument list parsing and other mostly irrelevant details

## usage message

$0 =~ s@.*/@@g;

sub usage {
    print STDERR @_, <<"EndOfUsage";
usage: $0 dest-addr src-addr
  dest-addr and src-addr specify host and port in the forms
  "infocalypse.mit.edu:21" or "18.177.1.18:ftp".
EndOfUsage
    exit(1);
}

## helpers for arg parsing

sub parse_addr {
    my ($host, $port) = split(/:/, $_[0], 2);

    if ($port =~ /\D/) {  # if port contains non-digits, we look it up.
	$port = (getservbyname($port, 'tcp')
		 || usage("Unknown port: '$port'\n"));
    }
    my $addr = inet_aton($host);
    defined($addr) || usage("Unknown host: '$host'\n");
    ($port, $addr);
}

## parse args

my ($dest, $src);

ARG:
while (@ARGV) {
    my $arg = shift(@ARGV);

    ($arg =~ /^-/) && usage("Unknown flag: '$arg'\n");

    defined($dest) || ($dest = $arg, next ARG);
    defined($src)  || ($src = $arg,  next ARG);

    usage("Invalid extra argument: '$arg'\n");
}

defined($dest) || usage("Destination address not specified.\n");
defined($src)  || usage("Source address not specified.\n");

my ($d_port, $d_host) = parse_addr($dest);
my ($s_port, $s_host) = parse_addr($src);

my $netdest = sockaddr_in(0, inet_aton("18.177.0.1"));

my $SOCK = raw_ip();
send($SOCK, make_packet($s_host, $s_port, $d_host, $d_port, "",
			'FIN' => 1, 'ACK' => 1),
     0, $netdest) || die "send: $!";

printf STDERR "FIN ACK from %s:%d to %s:%d: forged.\n",
    inet_ntoa($s_host), $s_port, inet_ntoa($d_host), $d_port;
close $SOCK;