[ 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 2007年11月16日 01:02 | Updated on 2008年03月30日 22:43 |

TrackBack

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

Post a comment

Search


About

This page contains a single entry from the blog posted on 2007年11月16日 01:02.

The previous post in this blog was Recording and sending linear voice using Perl.

The next post in this blog is Simple mail proxy by Perl.

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 3.36