#!/usr/bin/perl

# TCP MD5 Signature implementation using FreeBSD divert sockets
# Greets to atrak for Net::Divert
# $Id: tcp-md5.tip,v 1.10 2003/10/17 09:13:40 davy Exp $
#
# Adapted to Linux and IPQueue by Alex Pilosov <alex@pilosoft.com>
#
#
# iptables -I OUTPUT -j QUEUE -d 10.1.2.3 -p tcp --dport 179 
#
# config file:
# [10.1.2.3] #(peer IP)
# password=foobar
# enforce=yes 
### if enforce is not set, md5 will be sent but not enforced on receipt

use IPTables::IPv4::IPQueue qw(:constants);
use NetPacket::IP qw(:protos);
use NetPacket::TCP;
use Digest::MD5 qw(md5);
use Config::Tiny;
use Carp;
use Data::Dumper;
use strict;


my $debug=2;
# Divert the packets


my ($queue, $msg);

$queue = new IPTables::IPv4::IPQueue()
  or die IPTables::IPv4::IPQueue->errstr;

$queue->set_mode(IPQ_COPY_PACKET, 2048)
  or die IPTables::IPv4::IPQueue->errstr;

my $cfg = Config::Tiny->read("bgpmd5.conf");


my $payload;
my $ip;
my $tcp;
my @opts;
my $digest;
my $key;
while(1) {
  $msg = $queue->get_message()
    or warn IPTables::IPv4::IPQueue->errstr;
  next if (!$msg);

  $payload = $msg->payload();
  print "Got msg $msg len ".$msg->data_len."\n" if ($debug>=2);
  
  my $ret = process_packet ();

  $queue->set_verdict($msg->packet_id(), $ret, length($payload), $payload )
 	or warn IPTables::IPv4::IPQueue->errstr;
}

sub process_packet 
{
  # we fail OPEN - if we cannot handle something, we let it through. 
  $ip = NetPacket::IP->decode($payload);
  return NF_ACCEPT if (!$ip);

  $tcp = NetPacket::TCP->decode($ip->{data});
  return NF_ACCEPT if (!$tcp);

  # set the global variables 
  @opts=();
  parseopts();  # parse current options

 
  if ($msg->hook == 3) { # NF_IP_LOCAL_OUT, add sig
    my $kip = $ip->{dest_ip};

    $key = $cfg->{$kip}->{password};
    return NF_ACCEPT if (!$key);

    # Add option length to header length (5 words)
    # do it _before_ recomputing TCP header
    my $spaceleft=opt_spaceleft();
    my $increase = $spaceleft>=2?4:5;
    print "Increasing by $increase words\n" if ($debug>=2);

    $tcp->{hlen} += $increase;

    $digest = gensig(); # compute MD5 sig

    $payload = addsig();

print "Processed len ".length($payload)."\n" if ($debug>=2);
    return NF_ACCEPT;
  } elsif ($msg->hook == 1) { # NF_IP_LOCAL_IN, check sig
    my $kip = $ip->{src_ip};
    my $enf =  $cfg->{$kip}->{enforce};
print "Packet passed, not enforcing from $kip\n" if (!$enf && $debug>=2);
    return NF_ACCEPT if (!$enf);
    
    $key = $cfg->{$kip}->{password};

    $digest = gensig(); # compute MD5 sig

    my $ok = checksig();
print "Packet status $ok, from $kip\n" if ($debug>=2);
    return $ok?NF_ACCEPT:NF_DROP;
  }
}

# input: password, $tcp and $ip globals
# output: 16-byte md5 signature
sub gensig {

  my $tosign = "";
  my $ctx = Digest::MD5->new;

  # compute pseudo-header
  $tosign = pack('a4 a4 C C n',
                 (gethostbyname($ip->{src_ip}))[4], (gethostbyname($ip->{dest_ip}))[4],
                 0, IP_PROTO_TCP, $ip->{len}); 

  $ctx->add($tosign);

  # add the TCP header with a null checksum
  # code from NetPacket/TCP.pm
  my $tmp = $tcp->{hlen} << 12;
  $tmp = $tmp | (0x0fc0 & ($tcp->{reserved} << 6));
  $tmp = $tmp | (0x003f & $tcp->{flags});

  $tosign = pack('n n N N n n n n',
                  $tcp->{src_port}, $tcp->{dest_port},
                  $tcp->{seqnum}, $tcp->{acknum}, $tmp,
                  $tcp->{winsize}, 0, $tcp->{urg});

  $ctx->add($tosign);

  # add the data and the key
  $ctx->add($tcp->{data});
  $ctx->add($key);
  return $ctx->digest;
}

sub checksig {
print "checking sig\n" if ($debug>=2);
  foreach my $opt (@opts) {
    if (substr($opt,0,2) eq "\x13\x12") {
      my $d=substr($opt,2);
print "Found digest match ".($d eq $digest)."\n" if ($debug>=2);
      return ($d eq $digest);
    }
  }
  return 0;
}

sub addsig {
  my $option = "\x13\x12" . $digest;

  # add the TCP option
  push @opts,$option;

  $tcp->{options} = genopts();

  # encode & reinject
  $ip->{data} = $tcp->encode($ip);
  my $packet = $ip->encode;
  return $packet;
}

# input: $tcp->{options}
# output:  [ $option1, $option2, $option3 ]
#
sub parseopts
{
  my $s=$tcp->{options};
  for (my $p=0;$p<length($s);) {
    my $optid=ord(substr($s,$p++,1));
    return if ($optid==0); # End of options
    if ($optid == 1) {
      push @opts,"\001";
    } else {
      my $optlen=ord(substr($s,$p++,1));
      next if ($optlen<2);
      my $opt=substr($s,$p-2,$optlen);
      $p+=$optlen-2;
      push @opts,$opt;
    }
  }
}

# generate option string from current @opt, padding if necessary
sub genopts
{ 
  my $s="";
  foreach my $opt (@opts) {
    $s.=$opt;
  }
  my $len = length($s);
  my $npad = 4-($len % 4);
  $npad = 0 if ($npad == 4);
  $s .= "\0"x$npad;
  return $s;
}

# this is tricky: 
# in our digest, we need to know the new TCP options header length. 
# Our option is 18-bytes long, but it is possible that in the header, 
# we just have 2 empty bytes, resulting in only 4-word increase
# bytes, and the increase of header will be 4 
sub opt_spaceleft {
  my $s="";
  foreach my $opt (@opts) {
    $s.=$opt;
  }
  my $len = length($s);
  my $npad = 4-($len % 4);
  $npad = 0 if ($npad == 4);
print "len $len npad $npad\n" if ($debug>=2);
  return $npad;
}