#!/usr/bin/perl -w
#
#  sip-redirect 0.2.0
#
#  (c) 2005-2014 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.,
#  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
#

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

my %config;
my @forward;


# Read configuration file
sysopen(RAW, "/etc/sip-redirect.conf", O_RDONLY) || 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(/\|\s*\|/)
  {
    my ($from, $to) = split(/\|\s*\|/); $from =~ s/(\s|\n)//g; $to =~ s/(\s|\n)//g;
    $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 capability and set defaults
$config{'ipv6'} = eval { require Socket; Socket->VERSION(1.95); Socket->import(qw(inet_pton inet_ntop)); PF_INET6(); } ||
  eval { require Socket6; Socket6->import(qw(inet_pton inet_ntop pack_sockaddr_in6 unpack_sockaddr_in6)); PF_INET6(); };

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


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

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


# Daemonize the program
chdir("/") || die("Error: Can't change directory to /: $!");
sysopen(STDIN, "/dev/null", O_RDONLY) || die("Error: Can't read /dev/null: $!");
sysopen(STDOUT, $config{'debug'}, O_WRONLY|O_APPEND|O_CREAT) || die("Error: Can't write to " . $config{'debug'} . ": $!");
sysopen(STDERR, $config{'debug'}, O_WRONLY|O_APPEND|O_CREAT) || die("Error: Can't write to " . $config{'debug'} . ": $!");
defined(my $pid = fork) || die("Error: Can't fork: $!");
exit if($pid);
setsid() || 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 $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(PF_INET6, $ip); }

    # Ignore all non-SIP commands and SIP commands ACK, BYE, CANCEL and SIP
    if($msg =~ /^[A-Z]+ /i && $msg !~ /^((ACK|BYE|CANCEL) |SIP\/)/i)
    {
      my $from = getvalue($msg, "From", "f");
      my $to = getvalue($msg, "To", "t");
      my $callid = getvalue($msg, "Call-ID", "i");
      my $cseq = getvalue($msg, "CSeq", "CSeq");

      # Ignore command if mandatory fields are not filled
      if($from && $to && $callid && $cseq)
      {
        my $reply = "SIP/2.0 ";
        my $found = "";
        my ($cmd, undef) = split(/ /, $msg, 2);

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

        # Build header information containing status
        if($msg =~ /^INVITE /i && !$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(/^V(ia)? *:/i) { $_ =~ s/^V(ia)? *: */Via: /i; $reply .= $_; } }

        # From whom to whom, call ID and sequence
        $reply .= "From: " . $from . "\r\n" .
                  "To: " . $to . "\r\n" .
                  "Call-ID: " . $callid . "\r\n" .
                  "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'} && sysopen(LOG, $config{'log'}, O_WRONLY|O_APPEND|O_CREAT))
        {
          print LOG localtime() . " [" . $ip . ":" . $port . "] - " . uc($cmd) . " -> " . $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]) *:/i || /^($_[2]) *:/i)
    {
      my (undef, $value) = split(/:/, $_, 2);
      $value =~ s/(^ *|[\r\n]*$)//g;

      return $value;
    }
  }
}


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