[ Top page ]

« Recording and sending linear voice using Perl | Main | Simple mail proxy by Perl »

Network and communication

Receiving and playing linear voice (VoIP) using Perl

A program that receives a two-channel (i.e., stereo) voice by RTP (Real-time Transport Protocol) and that plays by audio. The sound is 16-bit linear by default, but u-Law (G.711) or other codecs can be used. The port number used for receiving the voice is specified in the program (i.e., $IN_PORT_RTP)． A detailed description will be given in future, but it will be explained when it becomes necessary. 

#!/usr/bin/perl
##############################################################################
#
#	2-channel RTP Stream Player
#
##############################################################################

use strict;
use Socket;
use Time::HiRes qw(time);
require 'sys/ioctl.ph';
require 'sys/soundcard.ph';

my $PACKET_SIZE = 1500;	# Assumed max UDP packet size

my $IN_PORT_RTP = 8000;
my $IN_PORT_RTCP = 8001;	# local ports for input

my ($source_ip, $source_port_rtp, $source_port_rtcp);
my ($fd_in_rtp, $fd_in_rtcp);

my %buf_rtp;

my $buf_displ = -1;
my %repeat_count;

my $curr_time = 0;
my $delta_time;

my $debug_switch = 0;
my $inspection_switch = 0;


#=============================================================================
# Utility function
#=============================================================================

my $power32 = 4294967296;
my $power16 = 65536;

### current_time()
#   return current time in the timestamp format.
#
sub current_time() {
    return int(time * 8000);

    # return int(((time + 2208988800) * $power16) % $power32);
}


#=============================================================================
# Network Input functions
#=============================================================================

### open_socket($proto)
#   open a UDP port of the local host (both for input and output),
#   and return the file descriptor.
#
sub open_socket($) {
    my ($port) = @_;
    my $fd;
    socket($fd, AF_INET, SOCK_DGRAM, getprotobyname('udp')) ||
        die "socket($fd)$!\n";
    setsockopt($fd, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) ||
        die "setsockopt()$!\n";
    bind($fd, sockaddr_in($port, INADDR_ANY)) ||
        die "bind($fd)$!\n";
    return $fd;
}

my %delay_estimate;

### receive_rtp_packet($curr_time)
#   receive an RTP packet and put it into the ring buffer.
#
sub receive_rtp_packet($) {
    my ($curr_time) = @_;
    my $buf;
    my $source_addr = recv($fd_in_rtp, $buf, $PACKET_SIZE, 0);
    defined($source_addr) || die "recv()$!";
    my ($port, $ip) = sockaddr_in($source_addr);
    if ($source_ip ne '' && $ip ne $source_ip) {
        printf stderr "Packets from two IPs received: $source_ip and $ip\n";
    };
    $source_ip = $ip;
    if ($source_port_rtp ne '' && $port ne $source_port_rtp) {
        printf stderr
        "RTP Packets from two ports received: $source_port_rtp and $port\n";
    };
    $source_port_rtp = $port;
    my ($first_byte, $second_byte, $seq_no, $timestamp, $ssrc) =
        unpack('CCnNN', $buf);
    if ($inspection_switch) {
        my ($d1, $d2, $d3, $a1, $a2, $a3, $a4) = unpack('LNNCCCC', $buf);
        print inet_ntoa($ip),
        " in:  $a1 $a2 $a3 $a4 seq=$seq_no ssrc=$ssrc\n";
    };
    my $payload_type = $second_byte & 7;
    test_rtp_packet($first_byte, $second_byte, $payload_type, $ip, $buf);
    my $delta = length($buf) - 12;
    if ($delta_time == 0) {
        $delta_time = $delta;
    } elsif ($delta != $delta_time) {
        print stderr "Sample size not equal!\n";
    };
    my $time_diff = $curr_time - $timestamp;
    if ($delay_estimate{$ssrc} == 0) {
        $delay_estimate{$ssrc} = $time_diff;
    } else {
        $delay_estimate{$ssrc} =
            (31 * $delay_estimate{$ssrc} + $time_diff) / 32;
    };
    if ($buf_displ < 0) {  # $buf_displ not yet defined
        $buf_displ = $seq_no;
    };
    if ($seq_no >= $buf_displ) {
        ${$buf_rtp{$ssrc}}[$seq_no - $buf_displ] = $buf;
    } elsif ($seq_no == $buf_displ) {
        ${$buf_rtp{$ssrc}}[0] = $buf;
        $repeat_count{$ssrc} = 0;
    } else {
        # Discard the data if it is too old (i.e., nothing to do).
    };
    if ($debug_switch) {
	print "Received: \$buf_rtp{$ssrc}[", $seq_no - $buf_displ, "] ",
	"Seq#=$seq_no Repeat_count=$repeat_count{$ssrc} Timestamp=$timestamp\n";
        # print "RTP payload_type=$payload_type ssrc=$ssrc seq_no=$seq_no ",
        # "timestamp=$timestamp received_time=$curr_time ",
        # "delay_estimate=$delay_estimate{$ssrc}\n";
        # print "Media data received from ", inet_ntoa($ip),
        # ":$port, length=", length($buf), "\n";
    };
}

### test_rtp_packet ($first_byte, $second_byte, $payload_type)
#   test validity of RTP contents.
#
sub test_rtp_packet ($$$) {
    my ($first_byte, $second_byte, $payload_type) = @_;
    my $version = $first_byte >> 6;		# must be 2
    my $extension = ($first_byte >> 4) & 1;	# must be 0
    my $n_csrc = $first_byte & 15;
    my $marker = $second_byte >> 7;
    ($version == 2 && $extension == 0 && $n_csrc == 0 && $marker == 0) ||
        die "Invalid RTP packet header: version=$version " .
        "extension=$extension #CSRC(CC)=$n_csrc marker=$marker\n";
    $payload_type == 0 ||
        die "Payload type ($payload_type) must be 0 (G.711 ulaw)\n";
};

### receive_rtcp_packet()
#   receive an RTCP packet.and put it into the ring buffer.
#
sub receive_rtcp_packet() {
    my $buf;
    my $source_addr = recv($fd_in_rtcp, $buf, $PACKET_SIZE, 0);
    defined($source_addr) || die "recv()$!";
    my ($port, $ip) = sockaddr_in($source_addr);
    if ($source_ip ne '' && $ip ne $source_ip) {
        printf stderr "Packets from two IPs received: $source_ip and $ip\n";
    };
    $source_ip = $ip;
    if ($source_port_rtcp ne '' && $port ne $source_port_rtcp) {
        printf stderr
        "RTCP Packets from two ports received: $source_port_rtcp and $port\n";
    };
    $source_port_rtcp = $port;
    my ($first_byte, $packet_type, $length, $ssrc, $timestamp1, $timestamp2) =
        unpack('CCnN', $buf);
    my $version = $first_byte >> 6;		# must be 2
    ($version == 2) || die "Invalid RTCP packet header: version=$version\n";
    if ($debug_switch) {
        my $report_count = $first_byte & 31;
        print "RTP packet_type=$packet_type rerport_count=$report_count ",
        "timestamp=($timestamp1 $timestamp2) ssrc=$ssrc\n";
        print "Control data received from ", inet_ntoa($ip),
        ":$port, length=", length($buf), "\n";
    };
}


#=============================================================================
# ulaw -> linear conversion table generator
#=============================================================================

my $QUANT_MASK = 0xf;
my $BIAS = 0x84;
my $SEG_MASK = 0x70;
my $SEG_SHIFT = 4;
my $SIGN_BIT = 0x80;

my @u2l;

sub u2l($) {
    my ($uval) = @_;
    $uval = ~$uval;
    my $t = (($uval & $QUANT_MASK) << 3) + $BIAS;
    $t <<= ($uval & $SEG_MASK) >> $SEG_SHIFT;
    return ($uval & $SIGN_BIT) ? ($BIAS - $t) : ($t - $BIAS);
}

### gen_u2l()
#   generate ulaw-to-linear conversion table (@u2l)
#
sub gen_u2l() {
    for (my $i = 0; $i < 256; $i++) {
        $u2l[$i] = u2l($i);
    };
}


#=============================================================================
# Open sound output
#=============================================================================

my $BUF_SIZE = 2000;

sub open_sound_output() {
    my $status;
    my $parameter;

    open(SOUND_OUT, ">/dev/audio") || die "Sound output open failed!\n";

    # 16 bit sampling for output
    my $bits = pack("L", 16);
    $status = ioctl(SOUND_OUT, SOUND_PCM_WRITE_BITS(), $bits);
    if ($status < 0) {
        print stderr "8 bit sampling setting failed!\n";
    };

    # 2-channel (binaural)
    # $parameter = pack("L", 1);
    # $status = ioctl(SOUND_OUT, SNDCTL_DSP_STEREO(), $parameter);
    # if ($status < 0) {
    #     print stderr "Stereo setting failed!\n";
    # };

    # Number of channels = 2
    $parameter = pack("L", 2);
    $status = ioctl(SOUND_OUT, SNDCTL_DSP_CHANNELS(), $parameter);
    # $status = ioctl(SOUND_OUT, SOUND_PCM_WRITE_CHANNELS(), $parameter);
    if ($status < 0) {
	print stderr "#Channels setting failed!\n";
    };

    # 8000 Hz sampling rate for output
    my $sampling = pack("L", 8000);
    $status = ioctl(SOUND_OUT, SNDCTL_DSP_SPEED(), $sampling);
    # $status = ioctl(SOUND_OUT, SOUND_PCM_WRITE_RATE(), $sampling);
    if ($status < 0) {
        print stderr "8000 Hz sampling rate setting failed!\n";
    };

    # Buffer underrun may be cause by network
    $parameter = APF_NETWORK();
    $status = ioctl(SOUND_OUT, SNDCTL_DSP_PROFILE(), $parameter);
    if ($status < 0) {
        print stderr "ioctl(SNDCTL_DSP_PROFILE) failed!\n";
    };

    # Block size
    $parameter = pack("L", $BUF_SIZE);
    $status = ioctl(SOUND_OUT, SNDCTL_DSP_GETBLKSIZE(), $parameter);
    if ($status < 0) {
        print stderr "ioctl(SNDCTL_DSP_GETBLKSIZE) failed!\n";
    };
}


#=============================================================================
# Playout (deciding timing for mixing)
#=============================================================================

my ($left_ssrc, $right_ssrc);

my %repeat_count;

### playout()
#   make the first element of each buffer the playout data.
#
sub playout() {
    if ($left_ssrc eq '') {
        my @ssrcs = keys %buf_rtp;
        if (@ssrcs >= 2) {  # already received two streams (SSRCs)
            if ($ssrcs[0] > $ssrcs[1]) {
                $left_ssrc = $ssrcs[1];
                $right_ssrc = $ssrcs[0];
            } else {
                $left_ssrc = $ssrcs[0];
                $right_ssrc = $ssrcs[1];
            };
        }
    } else {
        my $left_buf = ${$buf_rtp{$left_ssrc}}[0];
        my $right_buf = ${$buf_rtp{$right_ssrc}}[0];
        if ($repeat_count{$left_ssrc} == 0 && $repeat_count{$right_ssrc} == 0 ||
            @{$buf_rtp{$left_ssrc}} > 2 && @{$buf_rtp{$right_ssrc}} > 2) {
	    if ($debug_switch) {
		print "SSRCs: $left_ssrc $right_ssrc, Packets: ",
		$#{$buf_rtp{$left_ssrc}} + 1, " ",
		$#{$buf_rtp{$right_ssrc}} + 1, ", Length: ",
		length($left_buf), ' ', length($right_buf), "\n";
	    };
            if ($inspection_switch) {
                my ($left_seq, $right_seq, $left_ts, $right_ts);
                ($_, $left_seq, $left_ts) = unpack('nnNN', $left_buf);
                ($_, $right_seq, $right_ts) = unpack('nnNN', $right_buf);
		if ($debug_switch) {
		    print "Seq# $left_seq $right_seq, ",
		    "Timestamp $left_ts $right_ts\n";
		};
                if ($left_seq != $right_seq) {
		    print stderr "Seq num mismatched! $left_seq $right_seq\n";
		};
                if ($left_ts != $right_ts) {
                    print stderr "Timestamp mismatch! $left_ts $right_ts\n";
                };
            };
            shift @{$buf_rtp{$left_ssrc}};	# discard an old packet
            shift @{$buf_rtp{$right_ssrc}};	# discard an old packet
            if (${$buf_rtp{$left_ssrc}}[0] eq '') {
					# no data in the L-ch buffer head
                ${$buf_rtp{$left_ssrc}}[0] = $left_buf;   # repeat the data
                $repeat_count{$left_ssrc}++;
		if ($debug_switch) {
		    print "L-ch repeated! ";
		};
            } else {
                $repeat_count{$left_ssrc} = 0;
            };
            if (${$buf_rtp{$right_ssrc}}[0] eq '') {
					# no data in the R-ch buffer head
                ${$buf_rtp{$right_ssrc}}[0] = $right_buf; # repeat the data
                $repeat_count{$right_ssrc}++;
		if ($debug_switch) {
		    print "R-ch repeated! ";
		};
            } else {
                $repeat_count{$right_ssrc} = 0;
            };
            $buf_displ++;

            my (@left_data, @right_data);
            ($_, $_, $_, @left_data) = unpack('LLLC*', $left_buf);
            ($_, $_, $_, @right_data) = unpack('LLLC*', $right_buf);
            if ($#left_data != $#right_data) {
                print stderr "Numbers of left/right data different!\n";
            };

            # decode @left_data and @right_data
	    my $outbuf;
            for (my $i = 0; $i <= $#left_data; $i++) {
                $outbuf .=
		    pack("SS", $u2l[$left_data[$i]], $u2l[$right_data[$i]]);
            };
	    if ($debug_switch) {
		print "Output length = ", length($outbuf), "\n";
	    };

	    syswrite(SOUND_OUT, $outbuf);
        };
    };
}


#=============================================================================
# main
#=============================================================================

open_sound_output();

$fd_in_rtp =  open_socket($IN_PORT_RTP);
$fd_in_rtcp = open_socket($IN_PORT_RTCP);

gen_u2l();

for (;;) {
    ## Test non-blocking I/O possibilities ##
    # $rin = file descriptor set [$fd_in_rtp, $fd_in_rtcp]
    my $rin = '';
    vec($rin, fileno($fd_in_rtcp), 1) = 1;
    vec($rin, fileno($fd_in_rtp), 1) = 1;

    my $rout;
    my $nfound = select($rout = $rin, undef, undef, 0);

    if ($nfound > 0) {			# Non-blocking I/O possible
        ## Accept packets ##
        if (vec($rout, fileno($fd_in_rtcp), 1)) {	# RTCP data readable
        					# (Control data prioritized)
            receive_rtcp_packet();
        };
        if (vec($rout, fileno($fd_in_rtp), 1)) {	# RTP data readable
            receive_rtp_packet($curr_time);
        };
    };

    playout();
}
Keywords:

Created on November 16, 2007 1:02 AM | Updated on March 30, 2008 10:43 PM |

TrackBack

TrackBack URL for this entry:
https://www.kanadas.com/mt/mt-tb.cgi/1655

Post a comment

Search


About

This page contains a single entry from the blog posted on November 16, 2007 1:02 AM.

Many more can be found on the main index page or by looking through the archives.

Subscribe to this blog's feed
[What is this?]
Creative Commons License
This weblog is licensed under a Creative Commons License.
Powered by Movable Type