#!/usr/bin/perl -w

use strict;
use warnings;
use Socket qw(:all);

our $DEBUG = 1;

sub check_passive_ftp
{
  my ($data, $rule) = @_;
  my $port;

  if ($rule->{src_port} != 21) {
    $rule->{action} = "unknown";
    return;
  } elsif (($data =~ /^22(7|8) /) && ($data =~ /,(\d+),(\d+)\)\.?\r\n$/)) {
    # pasv + lpsv
    $port = 256 * $1 + $2;
  } elsif (($data =~ /^229 /) && ($data =~ / \(\|\|\|(\d+)\|\)\.?\r\n$/)) {
    # epsv
    $port = $1;
  } else {
    $rule->{action} = "pass";
    return;
  }

  print " passive_ftp_port=$port" if $DEBUG;

  $rule->{new_src_port_low} = $port;
  $rule->{new_src_port_high} = $port;
  $rule->{new_dst_port_low} = "1024";
  $rule->{new_dst_port_high} = "65535";
  $rule->{action} = "open";
}

sub check_active_ftp
{
  my ($data, $rule) = @_;
  my $port;

  if ($rule->{dst_port} != 21) {
    $rule->{action} = "unknown";
    return;
  } elsif (!$rule->{is_ipv6}) {
    $rule->{action} = "pass";
    return;
  } elsif (($data =~ /^port /i) && ($data =~ /,(\d+),(\d+)\r\n$/)) {
    $port = 256 * $1 + $2;
  } elsif (($data =~ /^lprt /i) && ($data =~ /,(\d+),(\d+)\)\r\n$/)) {
    $port = 256 * $1 + $2;
  } elsif (($data =~ /^eprt /i) && ($data =~ /\|(\d+)\|\r\n$/)) {
    $port = $1;
  } else {
    $rule->{action} = "pass";
    return;
  }

  print " active_ftp_port=$port" if $DEBUG;

  $rule->{new_src_port_low} = $port;
  $rule->{new_src_port_high} = $port;
  $rule->{new_dst_port_low} = "20";
  $rule->{new_dst_port_high} = "20";
  $rule->{action} = "open";
}

sub parse
{
  my ($pkt) = @_;
  my %rule;

  my $len = length($pkt);
  print "len=$len" if $DEBUG;
  return if ($len < 20);

  my $ver_ihl = unpack("C", $pkt);
  my $ver = ($ver_ihl >> 4);
  print " ver=$ver" if $DEBUG;

  my ($ihl, $proto);

  if ($ver == 4) {
    $rule{is_ipv6} = 0;

    $ihl = 4 * ($ver_ihl & 15);
    print " ihl=$ihl" if $DEBUG;
    return if (($ihl < 20) || ($len < $ihl));

    $proto = unpack("C", substr($pkt, 9, 1));

    my $src_addr = substr($pkt, 12, 4);
    my $dst_addr = substr($pkt, 16, 4);
    $rule{src_addr} = inet_ntop(AF_INET, $src_addr);
    $rule{dst_addr} = inet_ntop(AF_INET, $dst_addr);
  } elsif ($ver == 6) {
    $rule{is_ipv6} = 1;

    $ihl = 40;
    print " ihl=$ihl" if $DEBUG;
    return if ($len < $ihl);

    $proto = unpack("C", substr($pkt, 6, 1));

    my $src_addr = substr($pkt, 8, 16);
    my $dst_addr = substr($pkt, 24, 16);
    $rule{src_addr} = inet_ntop(AF_INET6, $src_addr);
    $rule{dst_addr} = inet_ntop(AF_INET6, $dst_addr);
  } else {
    return;
  }

  if ($DEBUG) {
    print " src_addr=$rule{src_addr} dst_addr=$rule{dst_addr} proto=$proto";
  }

  if ($proto == 6) {
    $rule{proto} = "tcp";
    return if ($len < $ihl + 20);

    $rule{src_port} = unpack("n", substr($pkt, $ihl, 2));
    $rule{dst_port} = unpack("n", substr($pkt, $ihl + 2, 2));

    my $doff = unpack("C", substr($pkt, $ihl + 12));
    $doff = 4 *($doff >> 4);

    if ($DEBUG) {
      print " src_port=$rule{src_port} dst_port=$rule{dst_port} doff=$doff";
    }

    return if ($len < $ihl + $doff);

    my $data = substr($pkt, $ihl + $doff);
    print " data='$data'" if $DEBUG;

    check_passive_ftp($data, \%rule);
    check_active_ftp($data, \%rule) if ($rule{action} eq "unknown");
  } else {
    return;
  }

  return \%rule;
}

our $RULE_BASE = 9800;
our $RULE_COUNT = 100;
our $DIVERT_PORT = 10004;
our $TIMEOUT = 2;
our $IPPROTO_DIVERT = 258;

# PF
our $PF_ANCHOR = "felix";
# PF

# IPFW
#our $IP_FW_DEL = 51;
#socket(my $ipfw_sock, AF_INET, SOCK_RAW, IPPROTO_RAW) or die $!;
# IPFW

socket(my $sock, AF_INET, SOCK_RAW, $IPPROTO_DIVERT) or die $!;
my $sockaddr = pack_sockaddr_in($DIVERT_PORT, INADDR_LOOPBACK);
bind($sock, $sockaddr) or die $!;

my @rules;
for (;;) {
  my $free_slot;
  for (my $i = 0; $i <= $#rules; $i++) {
    if (!defined $rules[$i]) {
      $free_slot = $i;
    } elsif (time() > $rules[$i] + $TIMEOUT) {
# IPFW
#      my $rule_num = $RULE_BASE + $i;
#      if (!setsockopt($ipfw_sock, IPPROTO_IP, $IP_FW_DEL, $rule_num)) {
#        warn "cannot delete ipfw rule $rule_num: $!";
#      } elsif ($DEBUG) {
#        print "deleted ipfw rule $rule_num\n";
#      }
# IPFW

# PF
      system("/sbin/pfctl", "-a", "$PF_ANCHOR/$i", "-F", "all");
# PF
      $rules[$i] = undef;
      $free_slot = $i;
    }
  }

  my $rin = "";
  vec($rin, fileno($sock), 1) = 1;
  my ($nfound, $timeleft) = select(my $rout=$rin, undef, undef, 1);
  next if !$nfound;

  my $client = recv($sock, my $pkt, 16384, 0);
  my $rule = parse($pkt);
  print " ", $rule->{action},"\n" if $DEBUG;

  if ($rule->{action} eq "open") {
    if (defined $free_slot) { # no-op
    } elsif ($#rules + 1 < $RULE_COUNT) {
      $free_slot = $#rules + 1;
    } else {
      warn "no free slots";
      $free_slot = $#rules;
    }
# IPFW
#    my @cmd = ("/sbin/ipfw");
#    push @cmd, "-q" if !$DEBUG;
#    push @cmd, "add", $RULE_BASE + $free_slot, "allow", "tcp",
#               "from", $rule->{dst_addr}, "to", $rule->{src_addr},
#               "src-port", $rule->{new_dst_port_low} . "-" . $rule->{new_dst_port_high},
#               "dst-port", $rule->{new_src_port_low} . "-" . $rule->{new_src_port_high},
#               "keep-state";
#    system(@cmd);
# IPFW

# PF
    if (open(my $ph, "|/sbin/pfctl -a felix/'$free_slot' -f -")) {
      my $cmd = "pass quick inet6 proto $rule->{proto} " .
                "from $rule->{dst_addr} port $rule->{new_dst_port_low}:$rule->{new_dst_port_high} ".
                "to $rule->{src_addr} port $rule->{new_src_port_low}:$rule->{new_src_port_high}\n";
      print $ph $cmd;
      close($ph);
      print $cmd if $DEBUG;
    }
# PF
    $rules[$free_slot] = time();
  }

  send($sock, $pkt, 0, $client);
}

close($sock);