Small and Large Stones of Programming

#!/usr/bin/perl
##############################################################################
#
#	Wave File Streamer
#
##############################################################################

use strict;
use Socket;
use Audio::Wav;

Audio::Wav is a package that handles wave files.

use Time::HiRes qw(time sleep);	# for exact time measurements and sleep

Here, package Time::HiRes is to measure the time accurately.

my $CODEC = 'linear16';		# 'ulaw', 'ulaw16', 'linear16' or 'linear32'

my $CHANNELS = $CODEC eq 'ulaw16' || $CODEC eq 'linear32' ? 2 : 1;

This program handles 1- or 2-channel (i.e., stereo) signal. If the value of $CODEC is 'ulaw' or 'linear16', the voice is 1-channel, and it is 'ulaw16' or 'linear32', the voice is 2-channel.

my $SAMPLING_RATE = 8000;

The sampling rate is 8000 Hz. This program must run when replacing the sampling rate by a different value.

my $volume = 0.45;

The sound volume can be changed by this value.

my $wav_file = "WaveFile.wav";

The file name is given here.

my $FRAME_LENGTH = $SAMPLING_RATE / 50;	# number of samples in a packet

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

my $REMOTE_PORT_RTP = 10000;
my $REMOTE_PORT_RTCP = 10001;

my $LOCAL_PORT_RTP = 8000;
my $LOCAL_PORT_RTCP = 8001;	# local ports for output (UDP)
        # input and output local ports must be different.
        # (implementation restriction)

my $ip = '192.168.1.33';

IP address and port number IP アドレス s とポート番号 d はここできめている．

my $rtp_addr = pack_sockaddr_in($REMOTE_PORT_RTP, inet_aton($ip));
my $rtcp_addr = pack_sockaddr_in($REMOTE_PORT_RTCP, inet_aton($ip));

my ($fd_out_rtp, $fd_out_rtcp, $fd_in_rtcp);

my (@out_ip_rtp, @out_buf_rtp);
my (@out_ip_rtcp, @out_buf_rtcp);

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

$inspection_switch |= $debug_switch;


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

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

### current_npt_time()
#   return exact current time
#
sub current_npt_time() {
    my $time = time;
    my $lower = ($time - int($time)) * 4294967296.0;
    my $upper = int($time) + 2208988800;
    return ($upper, $lower);
}

### decode_sockaddr($sockaddr)
#   decode sockaddr_in structure to "$IP:$port" format.
#
sub decode_sockaddr($) {
    my ($sockaddr) = @_;
    if (length($sockaddr) != 16) {
        return '';
    };
    my ($port, $ip) = unpack_sockaddr_in($sockaddr);
    return inet_ntoa($ip) . ":$port";
}

### check_codec($codec)
#   check whether the specified CODEC is appropriate
#
sub check_codec($) {
    my ($codec) = @_;
    if ($codec ne 'ulaw' && $codec ne 'ulaw16' &&
        $codec ne 'linear16' && $codec ne 'linear32') {
	print STDERR "Unknown CODEC: $codec\n";
    };
}

### check_wav($details)
#   check whether the wave file format is appropriate
#
sub check_wav($) {
    my ($details) = @_;
    my $error = 0;
    # my $channels = $$details{channels};
    my $bits_sample = $$details{bits_sample};
    if ($bits_sample != 16) {
	$error = 1;
	print STDERR "#bits in sample ($bits_sample) must be 16\n";
    };
    # my $sample_rate = $$details{sample_rate};
    # if ($sample_rate != 8000) {
    #	$error = 1;
    #	print STDERR "Sample rate ($sample_rate) must be 8000\n";
    # };
    if ($error) {
	exit 1;
    };
}


#=============================================================================
# Network Output 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, pack_sockaddr_in($port, INADDR_ANY)) ||
        die "bind($fd)$!\n";
    return $fd;
}

my %packet_count;
my %octet_count;

### send_rtp($destination_addr, $buf)
#   send an RTP packet which is stored in the ring buffer.
#
sub send_rtp($$) {
    my ($destination_addr, $buf) = @_;
    send($fd_out_rtp, $buf, 0, $destination_addr) || die "send()$!";
    $packet_count{$destination_addr}++;
    $octet_count{$destination_addr} += length($buf);
    if ($inspection_switch) {
        my ($d1, $d2, $seq_no, $timestamp, $ssrc, $a1, $a2, $a3, $a4) =
            unpack('CCnNNCCCC', $buf);
        print decode_sockaddr($destination_addr),
	" out: $a1 $a2 $a3 $a4 seq=$seq_no ssrc=$ssrc\n";
	if ($debug_switch) {
	    print "RTP timestamp=$timestamp length=", length($buf), "\n";
	};
    };
}

### send_rtcp($destination_addr, $buf)
#   send an RTCP packet.
#
sub send_rtcp($$) {
    my ($destination_addr, $buf) = @_;
    send($fd_out_rtcp, $buf, 0, $destination_addr) || die "send()$!";
    if ($inspection_switch) {
	my ($d1, $d2, $seq_no, $timestamp, $ssrc, $a1, $a2, $a3, $a4) =
	    unpack('CCnNNCCCC', $buf);
        print decode_sockaddr($destination_addr),
	" out: $a1 $a2 $a3 $a4 seq=$seq_no ssrc=$ssrc\n";
	if ($debug_switch) {
	    print "RTCP timestamp=$timestamp length=", length($buf), "\n";
	};
    };
}

### receive_rtcp()
#   receive an RTCP packet and reply to the sender.
#
sub receive_rtcp() {
    my $buf;
    my $source_addr = recv($fd_in_rtcp, $buf, $PACKET_SIZE, 0);
    defined($source_addr) || die "recv()$!";
    my ($dummy, $ip) = unpack_sockaddr_in($source_addr);
    my ($first_byte, $payload_type, $length, $ssrc) = unpack('CCnN', $buf);
    my $version = $first_byte >> 6;		# must be 2
    unless ($version == 2) {
        print STDERR "Invalid RTCP packet header: version=$version\n";
    };

    # if ($inspection_switch) {
        my $report_count = $first_byte & 31;
        print "RTCP payload_type=$payload_type rerport_count=$report_count\n";
        print "Control data received from ", inet_ntoa($ip),
        ", length=", length($buf), "\n";
    # };

    ### to analyze the packet here ###

    if ($payload_type == 201) {	# if Receiver Report
        analyze_receiver_report($buf);
    };
}

### analyze_receiver_report()
#
sub analyze_receiver_report($) {
    my ($message) = @_;
    my $jitter = 0;
    my ($time_upper, $time_lower) = current_npt_time();
    my $curr_time = ($time_upper << 16) + ($time_lower >> 16);
    my $delay_since_last_SR = 0;
    my ($ssrc, $frac_lost, $highest_seq_no, $jitter);
    my ($last_SR, $delay_since_last_SR);
    ($_, $_, $ssrc, $frac_lost, $highest_seq_no, $jitter,
     $last_SR, $delay_since_last_SR) =
        unpack('NNNNNNNN', $message);	# 2B rtp header + 6B report block 1
    my $fraction_lost = $frac_lost >> 24;
    my $cumulative_packets_lost = $frac_lost & 0xFFFFFF;
    printf "Round trip time: %5.6f S\n", ($curr_time - $last_SR) / 65536.0;
}

ここから RTCP メッセージを生成するための部分である．

#=============================================================================
# RTCP Message Generator
#=============================================================================

my $CNAME = 1;

my $RTCP_INTERVAL = 5; # sec

my %rtcp_next_time;

### generate_outgoing_rtcp($out_addr, $ssrc, $cname, $timestamp)
#   generate Source Description and Sender Report messages of RTCP
#
sub generate_outgoing_rtcp($$$$) {
    my ($out_addr, $ssrc, $cname, $timestamp) = @_;
    my $current_time = time;
    if ($current_time >= $rtcp_next_time{$out_addr}) {
	if ($rtcp_next_time{$out_addr} == 0) {	# first time
	    $rtcp_next_time{$out_addr} = rand ($RTCP_INTERVAL / 2);
	    # Compute initial sending time
        # } elsif ($rtcp_next_time{$out_addr} == 0) {
	# 			# first time (SDES only)
        #     send_rtcp($out_addr, source_description($ssrc, $cname));
        #         # send a Source Description message of RTCP
        } else {		# not first time (SR and SDES)
            send_rtcp($out_addr,
                      sender_report($out_addr, $ssrc, $timestamp) .
                      source_description($ssrc, $cname));
                # send SR and SDES messages of RTCP
            print "Sending SR and SDES to ", decode_sockaddr($out_addr), "\n";

	    $rtcp_next_time{$out_addr} = $current_time +
		$RTCP_INTERVAL / 2 + rand ($RTCP_INTERVAL);
	};
    };
}

### source_description($ssrc, $my_cname)
#   Return a Source Description of RTCP
#
sub source_description($$) {
    my ($ssrc, $my_cname) = @_;
    my $cname_length = length($my_cname);
    return pack("nnNCCC*",
                0x81ca,	# V=2, PT=202 (SDES), SourceCount=1 (single chunk)
                1 + ($cname_length + 2 + 3) / 4, # length in words
		$ssrc, $CNAME, $cname_length) .
          $my_cname;
}

### sender_report($ssrc, $timestamp)
#   return a Sender Report of RTCP
#
sub sender_report($$$) {
    my ($out_addr, $ssrc, $timestamp) = @_;
    my ($curr_time_upper, $curr_time_lower) = current_npt_time();
    my $packet_count = $packet_count{$out_addr};
    my $octet_count = $octet_count{$out_addr};
    $packet_count{$out_addr} = 0;
    $octet_count{$out_addr} = 0;
    my $sender_info = pack("NNNNN", $curr_time_upper, $curr_time_lower,
                           $timestamp, $packet_count, $octet_count);
    my $header = pack("nnN", 
                      0x81c8, # V=2, PT=200(SR), ReportCount=1 (single chunk)
                      1 + length($sender_info) / 4,	# length in words
                      $ssrc);
    return $header . $sender_info;
}

ここから G.711 のデコーダである． G.711 のあつかいについては 「Perl による G.711 の処理」 において，よりくわしくあつかっている．

#=============================================================================
# Linear to ulaw conversion table generator
#=============================================================================

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

my (@u2l, @l2u);

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);
    };
}

### gen_l2u()
#   generate linear-to-ulaw conversion table (@l2u)
#   (This method might not generate an optimum converter.)
#
sub gen_l2u() {
    for (my $i = 0; $i < 256; $i++) {
        my $j = $u2l[$i];
        if ($j < 0) {
            $j += 65536;
        };
        $l2u[$j] = $i;
    };
    for (my $i = 1; $i < 65536; $i++) {
        if ($l2u[$i] == 0) {
            $l2u[$i] = $l2u[$i-1];
        };
    };
}

### gen_ul_conv()
#   generate ulaw <-> linear conversion tables
#
sub gen_ul_conv() {
    gen_u2l();
    gen_l2u();
}

ここから主要部分である．

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

if ($ARGV[0] ne '') {
    $wav_file = "$SAMPLING_RATE/$ARGV[0]";
    print "Playing file $wav_file\n";
};
if ($ARGV[1] ne '') {
    $volume = $ARGV[1];
    print "Volume=$volume\n";
};
my $loop = 1;
if ($ARGV[2] eq 'noloop') {
    $loop = 0;
}

$fd_out_rtp =  open_socket($LOCAL_PORT_RTP);
$fd_out_rtcp = open_socket($LOCAL_PORT_RTCP);
$fd_in_rtcp = $fd_out_rtcp;

gen_ul_conv();

check_codec($CODEC);

my $wav = new Audio::Wav;
my $wav_reader = $wav->read($wav_file);

check_wav($wav_reader->details());

my $ssrc = $ARGV[3] | int(rand 0x80000000);
my $seq_no = 0;

my $time_interval = 1000 * $FRAME_LENGTH / $SAMPLING_RATE;
my $timestamp = 0;
my $real_time = time;
my $playout_time = 1000 * $real_time;

for (;;) {
    my @buf;
    for (my $i = 0; $i < $FRAME_LENGTH; $i++) {
        my @data = $wav_reader->read();
        if (!defined($data[0])) {
            if (!$loop) {
                exit 0;
            };
            $wav_reader = $wav->read($wav_file);	# read the file again
            @data = $wav_reader->read();
            print "Repeating...\n";
        };
        $data[0] = $volume * $data[0];
        if ($CODEC eq 'ulaw') {
            $buf[$i] = $l2u[$data[0]];	# only the first channel data is used
        } elsif ($CODEC eq 'linear16') {
            $buf[$i] = $data[0];	# only the first channel data is used
        } elsif ($CODEC eq 'linear32') {
            if (@data >= 2) {		# use two-channel data
                $buf[2*$i] = $data[0];
                $data[1] = $volume * $data[1];
                $buf[2*$i+1] = $data[1];
            } else {			# duplicate single-channel data
                $buf[2*$i] = $data[0];
                $buf[2*$i+1] = $data[0];
            };
        } elsif ($CODEC eq 'ulaw16') {
            if (@data >= 2) {		# use two-channel data
                $buf[2*$i] = $l2u[$data[0]];
                $data[1] = $volume * $data[1];
                $buf[2*$i+1] = $l2u[$data[1]];
            } else {			# duplicate single-channel data
        	my $data = $l2u[$data[0]];
                $buf[2*$i] = $data;
                $buf[2*$i+1] = $data;
            };
        };
    };
    my $buf;
    if ($CODEC eq 'ulaw') {
        $buf = pack('NNNC*', 0x80000000 + $seq_no, $timestamp, $ssrc, @buf);
    } elsif ($CODEC eq 'ulaw16') {
        $buf = pack('NNNC*', 0x80600000 + $seq_no, $timestamp, $ssrc, @buf);
    } else { # linear16 or linear32
        $buf = pack('NNNn*',
        	    ($CODEC eq 'linear16' ? 0x80610000 : 0x80620000) + $seq_no,
        	    $timestamp, $ssrc, @buf);
    };

    send_rtp($rtp_addr, $buf);
    my $cname = getlogin() . ":$LOCAL_PORT_RTP";
    generate_outgoing_rtcp($rtcp_addr, $ssrc, $cname, $timestamp);

    my $rin = '';
    vec($rin, fileno($fd_in_rtcp), 1) = 1;
    my $rout;
    my $nfound = select($rout = $rin, undef, undef, 0);
    if ($nfound > 0) {			# Non-blocking I/O possible
        if (vec($rout, fileno($fd_in_rtcp), 1)) {	# RTCP data readable
            receive_rtcp();
        };
    };

    if ($debug_switch) {
        print "$real_time $playout_time ", decode_sockaddr($rtp_addr), "\n";
    };

    $seq_no++;
    if ($seq_no >= 65536) {
        $seq_no = 0;
    };
    $timestamp += @buf / $CHANNELS;
    $real_time = time;
    $playout_time += $time_interval;
    my $sleep_time = $playout_time / 1000 - $real_time;
    if ($sleep_time > 0) {
        sleep($sleep_time);
    };
    # printf "%f %f\n", $real_time, $sleep_time;
}