#!/usr/bin/perl -w
#
#  sip-redirect 0.1.2
#
#  (c) 2005-2008 by Robert Scheck <sip-redirect@robert-scheck.de>
#
#  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.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc.,
#  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#

use strict;
use POSIX qw(setsid);
use IO::Select;
use Socket;

my %config;
my @forward;


# Read configuration file
open(RAW, "/etc/sip-redirect.conf") or die("Error: Configuration file /etc/sip-redirect.conf doesn't exist");
my @conf=<RAW>;
close(RAW);

foreach(@conf)
{
  next if (/^(\s*)?#|^\s*$/);  # Skip blanks and comments

  if(/=/) { my ($variable, $value) = split /=/; $variable =~ s/\s*//g; $value =~ s/(\s*|\n)//g; $config{$variable} = $value }
  elsif(/\|\|/)
  {
    my ($from, $to) = split /\|\|/; $to =~ s/\n//;
    $from =~ s/([[:alnum:]])(\.|\@|\+|\-)([[:alnum:]])/$1\\$2$3/g;
    push(@forward, [$from, $to]);
  }
  else { $_ =~ s/\n//; die("Error: Can't handle '$_' in /etc/sip-redirect.conf") }
}

undef @conf;


# Detect IPv6 capatibility and set defaults
if(eval { require Socket6 }) { $config{'ipv6'} = 1; import Socket6; }

if(!$config{'listen'}) { $config{'listen'} = "0.0.0.0" }
if(!$config{'listen6'} && $config{'ipv6'}) { $config{'listen6'} = "::" }
  elsif($config{'listen6'} && !$config{'ipv6'}) { die("Error: Perl's Socket6 needed to use IPv6 support") }
if(!$config{'port'}) { $config{'port'} = "5060" }
if(!$config{'banner'}) { $config{'banner'} = "sip-redirect/0.1.1" }
if(!$config{'debug'}) { $config{'debug'} = "/dev/null" }


# Create the sockets
socket(SOCKET, PF_INET, SOCK_DGRAM, getprotobyname("udp")) or die "Error: $! (IPv4)";
setsockopt(SOCKET, SOL_SOCKET, SO_REUSEADDR, 1) or die "Error: $! (IPv4)";
bind(SOCKET, pack_sockaddr_in($config{'port'}, inet_aton($config{'listen'}))) or die "Error: $! (IPv4)";
my $select = new IO::Select(\*SOCKET);

if($config{'ipv6'})
{
  socket(SOCKET6, AF_INET6, SOCK_DGRAM, getprotobyname("udp")) or die "Error: $! (IPv6)";
  setsockopt(SOCKET6, SOL_SOCKET, SO_REUSEADDR, 1) or die "Error: $! (IPv6)";
  bind(SOCKET6, pack_sockaddr_in6($config{'port'}, inet_pton(AF_INET6, $config{'listen6'}))) or die "Error: $! (IPv6)";
  $select->add(\*SOCKET6);
}


# Daemonize the program
chdir "/" or die "Error: Can't chdir to /: $!";
open STDIN, "/dev/null" or die "Error: Can't read /dev/null: $!";
open STDOUT, ">>" . $config{'debug'} or die "Error: Can't write to " . $config{'debug'} . ": $!";
open STDERR, ">>" . $config{'debug'} or die "Error: Can't write to " . $config{'debug'} . ": $!";
defined(my $pid = fork) or die "Error: Can't fork: $!";
exit if $pid;
setsid or die "Error: Can't start a new session: $!";
umask 0;


# Main loop
while(my @ready = $select->can_read)
{
  foreach my $fh (@ready)
  {
    my ($port, $ip, $status);
    my $found = "";
    my $sock = recv(\*$fh, my $msg, 65535, 0);

    # Is the incoming socket IPv4 or IPv6?
    if(\*$fh == \*SOCKET) { ($port, $ip) = unpack_sockaddr_in($sock); $ip = inet_ntoa($ip) }
    else { ($port, $ip) = unpack_sockaddr_in6($sock); $ip = inet_ntop($ip) }

    # Ignore everything except INVITE and SIP commands without CANCEL and ACK
    if($msg =~ /^INVITE/i || ($msg !~ /^CANCEL/i && $msg !~ /^ACK/i && $msg !~ /^SIP/i))
    {
      my $from = getvalue($msg, "From", "f");
      my $to = getvalue($msg, "To", "t");
      my $reply = "SIP/2.0 ";

      # Is there a forwarding for the requested recipent?
      for(my $i = 0; $i < $#forward+1; $i++) { if($to =~ /<sip:($forward[$i][0])>/) { $found = $forward[$i][1]; last; } }

      # Build header information containing status
      if(!$found) { $reply .= "404 Not Found\r\n"; $status = "404" }
      elsif($msg =~ /^INVITE/i) { $reply .= "302 Moved Temporarily\r\n"; $status = 302 }
      else { $reply .= "501 Not Implemented\r\n"; $status = 501 }

      # Get full via list from SIP request
      foreach(split("^", $msg))
      {
        if(/^Via\s*:/i || /^v\s*:/i)
        {
          $_ =~ s/^v(ia)?\s*:\s*/Via: /;
          $reply .= $_;
        }
      }

      # From whom to whom, call ID and sequence
      $reply .= "From: " . $from . "\r\n".
                "To: " . $to . "\r\n".
                "Call-ID: " . getvalue($msg, "Call-ID", "i") . "\r\n".
                "CSeq: " . getvalue($msg, "CSeq", "CSeq") . "\r\n";

      # Contact only at forwardings having a recipent
      if($found) { $reply .= "Contact: <sip:" . $found . ">\r\n"; }

      # User-agent and content-length finally
      $reply .= "Server: " . $config{'banner'} . "\r\nContent-Length: 0\r\n\r\n";

      # Print incoming SIP message and the reply, too
      if($config{'debug'} ne "/dev/null") { print $msg . "\n" . $reply }

      # Log everything when logging is enabled
      if($config{'log'})
      {
        open(LOG, ">>" . $config{'log'});
        print LOG localtime() . " [" . $ip . ":" . $port . "] - " . $status. ": " . stripsip($from) . " -> " . stripsip($to);
        if($found) { print LOG " -> " . $found; }
        print LOG"\n";
        close(LOG);
      }

      send(\*$fh, $reply, 0, $sock);
    }
  }
}


# Return selected values from SIP request
sub getvalue
{
  foreach(split("^", $_[0]))
  {
    if(/^($_[1])\s*:/i || /^($_[2])\s*:/i)
    {
      my (undef, $value) = split(":", $_, 2);
      $value =~ s/(^\s*|[\r\n]*$)//g;

      return $value;
    }
  }
}


# Strip everything to get the pure SIP address
sub stripsip
{
  $_[0] =~ s/(.*<sip:|>.*)//g;
  return $_[0];
}
