#!/usr/bin/perl 
#
# chkconfig: 2345 91 3
# description: Daemon for performing Tcp-MD5 checksuming (RFC 2385)
#
# Packets sent by iptables to jump target QUEUE will checksumed by this daemon.
#
# 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 _REPLACE WITH AT_ pilosoft.com>
#
# Adapted from Alex Pilosov's version by Barry Levinson <bel _REPLACE WITH AT_ certifie.net> to /etc/init.d/ style daemon.
#
#
#
#
#
# Reads configuration from tcp-md5.conf, and automatically sets up IPTables rules to process configured IPs for tcp-md5 (RFC 2385).
#
# config file should be in the following format :
# [10.1.2.3] #(peer IP)
# password=foobar
# enforce=yes 
### if enforce is not set, md5 will be sent but not enforced on receipt
#
#
# Modify Global config if your files are in different places.
#
# Tested to work on Centos 4.
#
# Note that you will need to have several perl modules installed:
#    

use IPTables::IPv4;
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 POSIX qw(setsid);
use Config ;  # signal names
use Getopt::Long ;
# use diagnostics;
use strict;

# ################################################################
# Setup Signal Name hash:
# ################################################################
my %SIGNAME ;
{
  defined $Config{sig_name} or die "No sigs?";
  my $i=0 ;
  foreach my $sig_name (split(' ', $Config{sig_name})) {
    $SIGNAME{$sig_name} = $i++;
  }
}

# ################################################################
# Global config :
# ################################################################

my $CONFIG_FILE = '/etc/tcp-md5.conf' ;
my $LOGGER = '/usr/bin/logger' ;
my $SYSCTL = '/sbin/sysctl' ;
my $NAME = 'tcp-md5' ;
my $TCP_MD5_CHAIN = 'TCP-MD5' ;

my $LOGFILE ; # = "/var/log/tcp-md5.log" ; #define to enable logging - undef to disable
my $debug = 0 ;

my $NO_DAEMONIZE ;
my $DONT_FIX_OFFLOAD ;
my $DONT_FIX_MSS ;
my $NIC_PREFIX = "eth" ;
my $MAX_MTU = 1500 ;

# ################################################################
# Constants :
# ################################################################
use constant {
  ACCEPT_MODIFIED => 1,
  ACCEPT_UNMODIFIED => 2,
  DROP => 3
};


# ################################################################
# Command locations :
# ################################################################
my $MODPROBE_CMD = '/sbin/modprobe' ;
my $ETHTOOL_CMD = '/sbin/ethtool' ;
my $IPTABLES_CMD = '/sbin/iptables' ;
my $IFCONFIG_CMD = '/sbin/ifconfig' ;
my $TOUCH_CMD = '/bin/touch' ;


# ################################################################
# Hack to get IPTables::IPv4 working
# link in the library dir to where its expected if its not there
# already.
# ################################################################
my $IPT_LIBDIR = "/usr/lib/IPTables-IPv4" ;
if( ! -d $IPT_LIBDIR ) {
  system("ln -s /usr/share/doc/perl-IPTables-IPv4-0.98/modules $IPT_LIBDIR" ) ;
}

# ################################################################
# LOG() - logs to $LOGFILE
# ################################################################
sub LOG(@) {
   return if !defined($LOGFILE) ;
   my @pargs = @_ ;

   my $now = localtime() ;
   my $logfile ;
   open( $logfile, ">>$LOGFILE" ) ;

   print $logfile "$now : ", @pargs, "\n" ;
   print @pargs,"\n" if defined $NO_DAEMONIZE ;

   close($logfile) ;
}

# ################################################################
# daemonize()
#
# Closes STDIN, STDOUT, and STDERR, and setsid's, and puts us
# in the background.
#
# ################################################################

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

   LOG("Daemonized") ;
}

# ################################################################
# usage()
# ################################################################
sub usage() {

  error("usage : $0 {start|stop|restart|reload|status}\n".
        "           [--foreground] [--debug debuglevel] [--logfile file] [--config file]\n".
        "           [--NoOffloadFix] [--NoMSSFix] [--NICPrefix prefix (e.g. eth)]\n") ;
  exit(1) ;
}


# ################################################################
# syslog()
#
# log a message to syslog
# ################################################################
sub syslog($) {
  my ($msg) = @_ ;

  `$LOGGER "$NAME : $msg"` ;
}

# ################################################################
# error()
#
#  Logs an error and dies.
# ################################################################
sub error($) {
  my ($err) = @_ ;
  LOG($err) ;
  print STDERR "$err\n" ;
  syslog( "ERROR - exiting : $err" ) ;
  exit 1;
}



# ################################################################
# warning()
#
# Issue a warning to syslog, log, and stdout.
#
# return normally - does not halt execution.
# ################################################################
sub warning($) {
  my ($wrn) = @_ ;
  LOG("WARNING : $wrn") ;
  syslog( "WARNING : $wrn" ) ;
}


# ################################################################
# enforceRootOnly()
#
# Make sure that this script is being run by root
# ################################################################
sub enforceRootOnly() {
  my $REAL_UID = $< ;
  my $EFFECTIVE_UID = $> ;

  if( $REAL_UID != 0 ) {
    error( "Must be root to run this script.  Real UID : $REAL_UID\n" ) ;
  }

  if( $EFFECTIVE_UID != 0 ) {
    error( "Must be root to run this script.  Effective UID : $REAL_UID\n" ) ;
  }
}


# ################################################################
# iptError()
#
# report an error with IPTables::IPv4
# ################################################################
sub iptError() {
  my ($package, $filename, $line) = caller() ;
  LOG("ip table error (line #$line) : ". IPTables::IPv4::IPQueue->errstr ) ;
}


# ################################################################
# getpid()
#
# Gets the pid of the tcp-md5 daemon (if any) 
# ################################################################
sub getpid($) {
  my ($name) = @_ ;

  my $pid ;
  if( -f "/var/run/$name.pid" ) {
    $pid =`cat /var/run/$name.pid` ;
    chomp $pid ;
    if( (-z "$pid") || !(-d "/proc/$pid") ) {
      $pid=undef ;
      unlink("/var/run/$name.pid") ;
      unlink("/var/lock/subsys/$name") ;
    }
  }
  return( $pid ) ;
}

# ################################################################
# setpid()
#
# records pid of daemon
# ################################################################
sub setpid($$) {
my ($name,$pid) = @_ ;

  LOG("Setting PID of $name to $pid" ) ;

  `echo $pid > /var/run/$name.pid` ;
  `touch /var/lock/subsys/$name` ;
}


# ################################################################
# status()
#
# print if its running or not.
# ################################################################
sub status() {
  my $pid = getpid($NAME) ;

  if( defined $pid ) {
    print "$NAME is running : $pid\n" ;
  } else {
    print "$NAME is not running\n" ;
  }
}


# ################################################################
# stop()
#
# stop the daemon.
# ################################################################
sub stop() {
  my $pid = getpid($NAME) or error("$NAME not running.") ;

  print "Stopping $NAME" ;

  # cleanup IPTables :
  takedownIPTables() ;

  #Loop until the process is effectively stopped
  while( -d "/proc/$pid" ) {
                print "." ;
                kill($SIGNAME{TERM}, $pid) ;
                sleep 1 ;
  }
  print "\n" ;

  unlink( "/var/run/$NAME.pid" ) ;
  unlink( "/var/lock/subsys/$NAME" ) ;

  # remove ip_queue module
  system("$MODPROBE_CMD -r ip_queue") ;
}


# ################################################################
# reload()
#
# reload the configuration without stopping the daemon.
# ################################################################
sub reload() {
  my $pid =  getpid($NAME) or error("$NAME not running.") ;

  print "Reloading Configuration\n" ;

  my $cfg = Config::Tiny->read($CONFIG_FILE) or
    error("Unable to read $CONFIG_FILE : ".Config::Tiny->errstr()) ;

  # first set IPTables with new rules
  reloadIPTables($cfg) ;

  # now ask the daemon to reload its config
  kill($SIGNAME{HUP}, $pid) ;
}


# ################################################################
# ruleExists()
#
#  return 1 if a rule for ip exists in rules.
# ################################################################
sub ruleExists($$@) {
  my ($ip, $type, @rules ) = @_ ;

  foreach my $rule (@rules) {
    next if( !exists $$rule{$type} ) ;
    return 1 if( $$rule{$type} eq $ip ) ;
  }
  return 0 ;
}

# ################################################################
# reloadIPTables()
#
# sync IPTables TCP_MD5 chain with new configuration.
# ################################################################
sub reloadIPTables($) {
  my ($cfgHash) = @_ ;

  LOG("Reloading IPTables") ;

  my $iptable = IPTables::IPv4::init('filter') or iptError() ;

  # First make sure we have our ip filter chain setup, and our
  # jump rules set correctly :
  if( !$iptable->is_chain($TCP_MD5_CHAIN) ) {
    warning( "$TCP_MD5_CHAIN not found - recreating it" ) ;
    # create our chain:
    $iptable->create_chain($TCP_MD5_CHAIN) or iptError() ;
  }

  # make sure OUTPUT table jump exists
  my @rules = $iptable->list_rules('OUTPUT') ;
  if( !defined findJump($TCP_MD5_CHAIN, @rules) ) {
    # make last rule in OUTPUT jump to our chain
    warning("no $TCP_MD5_CHAIN rule in OUTPUT.  Adding it.") ;
    my %rule = ("jump" => $TCP_MD5_CHAIN ) ;
    $iptable->append_entry('OUTPUT', \%rule) or iptError() ;
  }

  # make sure INPUT table jump exists
  @rules = $iptable->list_rules('INPUT') ;
  if( !defined findJump($TCP_MD5_CHAIN, @rules) ) {
    # make last rule in INPUT jump to our chain
    warning("no $TCP_MD5_CHAIN rule in INPUT.  Adding it.") ;
    my %rule = ("jump" => $TCP_MD5_CHAIN ) ;
    $iptable->append_entry('INPUT', \%rule) or iptError() ;
  }

  @rules = $iptable->list_rules($TCP_MD5_CHAIN) or iptError() ;

  # first go through and remove any rules that no longer exist
  foreach my $rule (@rules) {
    my $ip = $$rule{"destination"} ;
    if( defined($ip) && !exists $$cfgHash{$ip} ) {
      LOG("removing rule for $ip") ;
      $iptable->delete_entry($TCP_MD5_CHAIN, $rule) or iptError() ;
    } else { # check for incomming "enforce" rules
      $ip = $$rule{"source"} ;
      if( defined($ip) && (!exists $$cfgHash{$ip} || !$cfgHash->{$ip}->{enforce}) ) {
        LOG("removing rule for $ip") ;
        $iptable->delete_entry($TCP_MD5_CHAIN, $rule) or iptError() ;
      }
    }
  }

  # go through each section and add config if necessary
  foreach my $ip (keys %$cfgHash) {
    if( !ruleExists($ip, 'destination', @rules) ) {
      LOG("adding signing rule for $ip") ;

      # add rule for outgoing packets to dest ip
      my %rule = ("jump" => "QUEUE",
                  "destination" => $ip,
                  "protocol" => "tcp") ;

      $iptable->append_entry($TCP_MD5_CHAIN, \%rule) or iptError() ;
    }

    # add rule for incoming packets from ip if enforced
    if( $cfgHash->{$ip}->{enforce} && !ruleExists($ip, 'source', @rules) ) {
      my %rule = ("jump" => "QUEUE",
                         "source" => $ip,
                         "protocol" => "tcp") ;

      $iptable->append_entry($TCP_MD5_CHAIN, \%rule) or iptError() ;
    }
  }
 
  # don't forget to commit it!
  $iptable->commit() or iptError() ;
}


# ################################################################
# findJump()
#
# return a rule with a jump matching target, or undef.
# ################################################################
sub findJump($@) {
  my( $target, @rules ) = @_ ;

  foreach my $rule (@rules) {
    return $rule if( $$rule{'jump'} eq $target) ;
  }
  return undef ;
}


# ################################################################
# takedownIPTables()
#
# Flush all rules, remove chain 
# ################################################################
sub takedownIPTables() {

  LOG("removing IPTables rules for TCP-MD5") ;

  # flush chains
  my $iptable = IPTables::IPv4::init('filter') or iptError() ;
  $iptable->flush_entries($TCP_MD5_CHAIN) or iptError() ;

  # Remove the OUTPUT jump to TCP-MD5
  my @rules = $iptable->list_rules('OUTPUT') or iptError() ;
  my $jumpRule = findJump($TCP_MD5_CHAIN, @rules) ;
  $iptable->delete_entry('OUTPUT',$jumpRule) if defined $jumpRule ;

  # Remove the INPUT jump to TCP-MD5
  @rules = $iptable->list_rules('INPUT') or iptError() ;
  $jumpRule = findJump($TCP_MD5_CHAIN, @rules) ;
  $iptable->delete_entry('INPUT',$jumpRule) if defined $jumpRule ;

  # remove our chain:
  $iptable->delete_chain($TCP_MD5_CHAIN) or iptError() ;

  # don't forget to commit it!
  $iptable->commit() or iptError() ;
}


# ################################################################
# setupIPTables()
#
# sets IPTables rules to deliver packets to us.
# ################################################################
sub setupIPTables($) {
  my ($cfgHash) = @_ ;

  LOG("Setting up IPTables rules for TCP-MD5") ;

  my $iptable = IPTables::IPv4::init('filter') or error("couldn't init filter ip chain : ". IPTables::IPv4::IPQueue->errstr ) ;

  # flush chain if wasn't clean before:
  if( $iptable->is_chain($TCP_MD5_CHAIN) ) {
    $iptable->flush_entries($TCP_MD5_CHAIN) or iptError() ;
  } else {
    # create our chain:
    $iptable->create_chain($TCP_MD5_CHAIN) or iptError() ;
  }

  # check if OUTPUT table jump exists
  my @rules = $iptable->list_rules('OUTPUT') ;
  if( !defined findJump($TCP_MD5_CHAIN, @rules) ) {
    # make last rule in OUTPUT jump to our chain
    LOG("adding jump $TCP_MD5_CHAIN rule to OUTPUT") ;
    my %rule = ("jump" => $TCP_MD5_CHAIN ) ;
    $iptable->append_entry('OUTPUT', \%rule) or iptError() ;
  }

  # check if INPUT table jump exists
  @rules = $iptable->list_rules('INPUT') ;
  if( !defined findJump($TCP_MD5_CHAIN, @rules) ) {
    # make last rule in OUTPUT jump to our chain
    LOG("adding jump $TCP_MD5_CHAIN rule in INPUT") ;
    my %rule = ("jump" => $TCP_MD5_CHAIN ) ;
    $iptable->append_entry('INPUT', \%rule) or iptError() ;
  }


  foreach my $ip (keys %$cfgHash) {
    LOG("Adding rule to $TCP_MD5_CHAIN for $ip") ;

    # add rule for outgoing packets to dest ip
    my %rule = ("jump" => "QUEUE",
                          "destination" => $ip,
                          "protocol" => "tcp") ;

    $iptable->append_entry($TCP_MD5_CHAIN, \%rule) or iptError() ;

    # add rule for incoming packets from source ip if enforced
    if( $cfgHash->{$ip}->{enforce} ) {
      %rule = ("jump" => "QUEUE",
                         "source" => $ip,
                         "protocol" => "tcp") ;

      $iptable->append_entry($TCP_MD5_CHAIN, \%rule) or iptError() ;
    }
  }

  # don't forget to commit it!
  $iptable->commit() or iptError() ;
}


# ################################################################
# getNICs()
#
# Returns an array of NICs on this system
# ################################################################
sub getNICs() {
  my @NICS = () ;

  open(my $netdevfh,'/proc/net/dev' ) ;
  while( <$netdevfh> ) {
    if( /^\s+($NIC_PREFIX\d+):/ ) {
      push @NICS, $1 ;
    }
  }
  close( $netdevfh ) ;
  return( @NICS ) ;
}


# ################################################################
# fixOffloading()
#
# There seems to be an error in how the driver computes the TCP checksum
# for md5'd packets when offloading is enabled.  Make sure offloading is
# disabled.
#
# Additionally, TSO needs to be disabled, as we are signing each
# packet, and therefore the NIC can *not* split up segments for us.
#
# ################################################################
sub fixOffloading(@) {
my(@NICS) = (@_) ;
  while(@NICS) {
    my $nic = pop(@NICS) ;
    LOG(`$ETHTOOL_CMD -K $nic tx off`) ;
    LOG(`$ETHTOOL_CMD -K $nic rx off`) ;
    LOG(`$ETHTOOL_CMD -K $nic tso off`) ;
  }
}

# ################################################################
# disableSack()
#
# Disables SACK
#
# SACK will take up to 34 bytes out of the 40 byte TCP option
# header.  As TCP-MD5 needs 18 bytes, SACK can not be allowed on
# TCP-MD5 connections.
#
# Note: another possible implimentation would be to modify the
# SYN packets as we do for MSS to remove the SACK option.  This
# would allow SACK on non TCP-MD5 connections.
#
# ################################################################
sub disableSack() {
  LOG(`$SYSCTL -w net.ipv4.tcp_sack=0`) ;
}


# ################################################################
# make these globals so we don't have the overhead of passing them
# to functions.
my $please_reload ;
my $out_payload ;
my $ip;
my $tcp;
my @opts;
my $key;
my $msg;
my $cfg;
my %maxMSS ;


# ################################################################
# calcMSS()
#
# For each NIC, set the MSS to be MTU - 60bytes to allow for the
# TCP-MD5 header.  Note that the TCP-MD5 header is up to 20bytes
# larger than the normal TCP-MD5 header (18bytes for MD5 + pad).
# ################################################################
sub calcMSS(@) {
my(@NICS) = (@_) ;
  while(@NICS) {
    my $nic = pop(@NICS) ;
    open( my $ifcmd, "$IFCONFIG_CMD $nic|" ) ;
    my $mtu ;
    while( <$ifcmd> ) {
      if(/MTU:(\d+)\s/) {
        $mtu = $1 ;
        last ;
      }
    }
    close( $ifcmd ) ;

    if( !defined $mtu ) {
      warning( "Unable to find MTU for $nic - assuming 1500" ) ;
      $mtu = $MAX_MTU ;
    } else {
      LOG( "Got MTU for $nic : $mtu" ) ;
    }

    my $mss = $mtu - 60 ;
    $maxMSS{$nic} = $mss ;
  }
}


# ################################################################
# start()
#
# Start the daemon.
# ################################################################
sub start() {
  LOG("") ;
  LOG("Starting $0") ;
  print "Starting $NAME" ;

  if( defined getpid($NAME) ) {
    error( "$0 already running.  PID : ".getpid($NAME) ) ;
  }

  system("$MODPROBE_CMD ip_queue") ;

  # run the iptables command to make sure ip_tables module is loaded
  # we could just modprobe it, but runing iptables will make sure any
  # dependencies are brought in.  Running -L is non-destructive.
  LOG(`$IPTABLES_CMD -L`) ;

  my @NICs = getNICs() ;
  LOG( "Found the following NICs :\n".Dumper(@NICs) ) ;

  # make sure checksum offloading is disabled for all eth interfaces:
  fixOffloading(@NICs) unless defined $DONT_FIX_OFFLOAD ;

  # disable SACK as there's not enough room for SACK options and TCP-MD5 together
  disableSack() ;

  # calculate max MSS
  calcMSS(@NICs) unless defined $DONT_FIX_MSS;

  LOG("Calculated max MSS :\n".Dumper(%maxMSS)) unless defined $DONT_FIX_MSS;

  print "\n" ;

  daemonize() unless defined $NO_DAEMONIZE ;

  setpid($NAME,$$) ;

  # Divert the packets

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

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

  `$TOUCH_CMD $CONFIG_FILE` unless (-f $CONFIG_FILE) ; # make sure its there, otherwise we'll bomb out

  $cfg = Config::Tiny->read($CONFIG_FILE) or
           error("Unable to read $CONFIG_FILE : ".Config::Tiny->errstr()) ;
  

  setupIPTables($cfg) ;

  # setup a signal handler for HUP so that we can reload our configuration
  local $SIG{HUP} = sub { $please_reload = 1 } ;

  while(1) {
    $msg = $queue->get_message() ;

    # See if we need to reread our configuration:
    if(defined $please_reload) {
      $please_reload = undef ;

      # reread config - check JIC because we don't want to die here.
      my $new_cfg = Config::Tiny->read($CONFIG_FILE) ;
      if( $new_cfg ) {
        $cfg = $new_cfg ;
        LOG("Accepted new configuration") ;
      } else {
        warning("Unable to read $CONFIG_FILE : ".
                 Config::Tiny->errstr()."  Keeping original configuration") ;
      }
      next unless $msg ; # could be a message if one came in just as we where HUP'd
    }

    if( !$msg ) {
      warning("Unable to get_message : ".IPTables::IPv4::IPQueue->errstr) ;
      next ;
    }

    my $payload = $msg->payload();
    if( !$payload ) {
      warning( "Failed to get payload :".IPTables::IPv4::IPQueue->errstr ) ;
      next ;
    }

    if($debug>=2) {
      LOG "\n" ;
      LOG "Got msg - len ".$msg->data_len ;
    }

    # we fail OPEN - if we cannot handle something, we let it through.
    $ip = NetPacket::IP->decode($payload);
    if( !$ip ) {
      warning( "Received non-IP packet" ) ;
      $queue->set_verdict($msg->packet_id(), NF_DROP )
        or warning("unable to set verdict to DROP :".IPTables::IPv4::IPQueue->errstr) ;
      next ;
    }

    $tcp = NetPacket::TCP->decode($ip->{data});
    if( !$tcp ) {
      warning( "Received non-TCP packet" ) ;
      $queue->set_verdict($msg->packet_id(), NF_DROP )
        or warning("unable to set verdict to DROP :".IPTables::IPv4::IPQueue->errstr) ;
      next ;
    }

    # Process it! :
    my $ret = process_packet() ;
    if( ($ret eq ACCEPT_MODIFIED) && ($msg->data_len > $MAX_MTU) ) {
      warning("packet too large : ".$msg->data_len) ;
      $queue->set_verdict($msg->packet_id(), NF_DROP )
        or warning("unable to set verdict to DROP :".IPTables::IPv4::IPQueue->errstr) ;
      next ;
    }

    # now we've got our retcode - either drop it, accept it, or modify it:
    if( $ret eq ACCEPT_MODIFIED ) {
      LOG "setting verdict : ACCEPT with modification" if ($debug>=2) ;
      $queue->set_verdict($msg->packet_id(), NF_ACCEPT, length($out_payload), $out_payload )
        or warning("unable to set verdict to NF_ACCEPT (mod) : ".IPTables::IPv4::IPQueue->errstr) ;
    } elsif ( $ret eq ACCEPT_UNMODIFIED ) {
      LOG "setting verdict : ACCEPT with NO modification" if ($debug>=2) ;
      $queue->set_verdict($msg->packet_id(), NF_ACCEPT )
        or warning("unable to set verdict to ACCEPT (no mod) : ".IPTables::IPv4::IPQueue->errstr) ;
    } else {
      LOG "setting verdict : DROP" if ($debug>=2) ;
      $queue->set_verdict($msg->packet_id(), NF_DROP )
        or warning("unable to set verdict to DROP :".IPTables::IPv4::IPQueue->errstr) ;
    } 
  }
}


# ################################################################
# process_packet()
#
# do the work of processing the packet.
#
# Takes global parameters of $ip and $tcp
# ################################################################
sub process_packet 
{
  if( $ip->{len} != $msg->data_len ) {
    warning("ip len (".$ip->{len}.") != msg data len (".$msg->data_len.")") ;
    LOG( "ip data (".length($ip->{data}).") :\n".unpack("H*",$ip->{data}) ) if( $debug >=5 ) ;
    return DROP ;
  }

  LOG( "TCP packet found" ) if ($debug>=2) ;
  # set the global variables 
  @opts=();
  parseopts();  # parse current options

 
  if ($msg->hook == 3) { # NF_IP_LOCAL_OUT, add sig
    # OUTGOING packets (from us)
    LOG( "Outgoing packet" ) if ($debug>=2) ;

    my $kip = $ip->{dest_ip};

    $key = $cfg->{$kip}->{password};
    if( !$key ) {
      warning( "No configuration found for '$kip'" ) ;
      return DROP ;
    }

    # check if SYN packet - if so, correct MSS if > max
    if( $tcp->{flags} & SYN ) {
      my $nic = $msg->outdev_name ;
      if( defined( $nic ) ) {
        LOG("Found SYN on '$nic'") if ($debug>=2) ;
        adjustMSS($maxMSS{$nic}) unless defined $DONT_FIX_MSS;
      } else {
        warning("unknown NIC checking MSS on outgoing packet") ;
      }
    }

    my $optlen = calc_optlen() ;

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

    # make sure we don't go over the 40 byte max option length
    if( ($optlen + ($increase*4)) > 40 ) {
      warning( "not enough room for MD5 signature. optlen : $optlen , increase: $increase" ) ;
      return DROP ;
    }

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

    my $digest = gensig(); # compute MD5 sig

    LOG "Computed Digest for packet : '".unpack("H*",$digest)."'" if ($debug>=2) ;

    $out_payload = addsig($digest);

    LOG "Processed len ".length($out_payload) if ($debug>=2);
    return ACCEPT_MODIFIED ;
  } elsif ($msg->hook == 1) { # NF_IP_LOCAL_IN, check sig
    # INCOMING packets (to us)
    LOG( "Incomming packet" ) if ($debug>=2) ;

    my $kip = $ip->{src_ip};
    $key = $cfg->{$kip}->{password};
    if( !$key ) {
      warning( "No configuration for '$kip'" ) ;
      return DROP ;
    }

    # We should only get packets when enforce is set
    if( !$cfg->{$kip}->{enforce} ) {
      warning("enforce no set for $kip") ;
      return DROP ;
    }
    
    my $digest = gensig(); # compute MD5 sig
    LOG("Computed MD5 for incoming packet should be : ".unpack("H*",$digest)) if ($debug>=2) ;

    if( checksig($digest) ) {
      LOG "Packet status good from $kip" if ($debug>=2) ;
      return( ACCEPT_UNMODIFIED ) ;
    } else {
      warning("Received packet from $kip with incorrect MD5 signature - ignoring") ;
      return( DROP ) ;
    }
  }
}


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

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

  # tcp segment lenght = (tcp header length in words * 4 bytes/word) + data length
  my $tcpSegLen = ($tcp->{hlen}*4) + length($tcp->{data}) ;

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

  if( $debug >=3) {
    LOG( "Pseudo-header being signed : ".unpack("H*",$tosign) ) ;
    LOG( "src ip  : ".$ip->{src_ip}) ;
    LOG( "dst ip  : ".$ip->{dest_ip}) ; 
    LOG( "ip len  : ".$ip->{len} ) ;
    LOG( "tcp len : $tcpSegLen" ) ;
    LOG( "tcp hlen: ".$tcp->{hlen} ) ;
    LOG( "tcp data len:".length($tcp->{data})) ;

    LOG( "ip data (".length($ip->{data}).") :\n".unpack("H*",$ip->{data}) ) ;
  }

  $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});

  LOG( "Header being signed :\n".unpack("H*",$tosign) ) if($debug>=3) ;
  $ctx->add($tosign);

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

  LOG( "data (".length($tcp->{data})."):\n".unpack("H*",$tcp->{data}) ) if($debug>=6) ;
  LOG( "key:\n".unpack("H*",$key) ) if($debug>=3) ;

  return $ctx->digest;
}


# ################################################################
# checksig()
#
# Validate the signature on a packet.
#
# Only called if enforce is set in the configuration.
# ################################################################
sub checksig($) {
my ($digest) = @_ ;
  LOG "checking sig" if ($debug>=2);
  foreach my $opt (@opts) {
    if (substr($opt,0,2) eq "\x13\x12") {
      my $d=substr($opt,2);
      LOG "Found digest : ".unpack("H*",$d) if ($debug>=2);
      return ($d eq $digest);
    }
  }
  return 0;
}


# ################################################################
# addsig()
#
# Add a signature to the packet.
# ################################################################
sub addsig($) {
  my ($digest) = @_ ;
  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;
}


# ################################################################
# adjustMSS()
#
# change the MSS if its less than max
# ################################################################
sub adjustMSS($) {
  my($maxMSS) = (@_) ;

  return if !defined $maxMSS ;

  # go through opts to find the current MSS setting :
  for( my $i=0 ; $i < $#opts ; $i++ ) {
    my $opt = $opts[$i] ;
    if (substr($opt,0,2) eq "\x02\x04") { # found it
      my $mss = unpack( "n",substr($opt,2) ) ; 
      LOG "MSS on wire : $mss" if ($debug>=2);

      if( $mss > $maxMSS ) {
        LOG "MSS too large - adjusting to : $maxMSS" if ($debug>=2) ;
        my $newopt = "\x02\x04".pack('n',$maxMSS) ;
        $opts[$i] = $newopt ;
        LOG("Set MSS to : ".unpack("H*",$newopt)) if ($debug>=2) ;
      }
    }
  }
}



# ################################################################
# parseopts()
#
# 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;
    }
  }
}


# ################################################################
# genopts()
#
# 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;
}


# ################################################################
# calc_optlen()
#
# Add up all the options and return the length.
# ################################################################
sub calc_optlen() {
  my $s="";
  foreach my $opt (@opts) {
    $s.=$opt;
  }
  return length($s) ;
}


# ################################################################
# opt_spaceleft()
#
# 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($len) = @_ ;
  
  my $npad = 4-($len % 4);
  $npad = 0 if ($npad == 4);
  LOG "len $len npad $npad" if ($debug>=2);
  return $npad;
}



# ################################################################
# MAIN
# ################################################################
enforceRootOnly() ;  # make sure only root runs this script.

GetOptions ( "foreground|f" => \$NO_DAEMONIZE,
             "debug|d=i" => \$debug,
             "logfile|l=s" => \$LOGFILE,
             "NoOffloadFix" => \$DONT_FIX_OFFLOAD,
             "NoMSSFix" => \$DONT_FIX_MSS,
             "NICPrefix=s" => \$NIC_PREFIX,
             "config|c=s" => \$CONFIG_FILE )
           or usage ;

my $func = $ARGV[0] or usage() ;
if( $func eq "start" ) {
  start() ;
} elsif( $func eq "stop" ) {
  stop() ;
} elsif( $func eq "restart" ) {
  stop() ;
  start() ;
} elsif( $func eq "status" ) {
  status() ;
} elsif( $func eq "reload" ) {
  reload() ;
} else {
  usage() ;
} 

exit(0) ;