mstts-tiny.agi

#!/usr/bin/env perl

#
# AGI script that uses MS Translator API for speech synthesis.
#
# Copyright (C) 2012 - 2014, Lefteris Zafiris <zaf.000@gmail.com>
#
# This program is free software, distributed under the terms of
# the GNU General Public License Version 2. See the COPYING file
# at the top of the source tree.
#
# -----
# Usage
# -----
# agi(mstts.agi,"text",[language],[intkey],[speed]): This will invoke the Microsoft TTS
# engine, render the text string to speech and play it back to the user.
# If 'intkey' is set the script will wait for user input. Any given interrupt keys will
# cause the playback to immediately terminate and the dialplan to proceed to the
# matching extension (this is mainly for use in IVR, see README for examples).
# If 'speed' is set the speech rate is altered by that factor.
#
# The script contacts Microsoft Translate TTS service in order to get the voice data
# which then stores in a local cache (by default /tmp/) for future use.
#
# In order to use this script you have to subscribe to the Microsoft
# Translator API on Azure Marketplace and register your application:
# https://datamarket.azure.com/developer/applications/
#
# Parameters like default language, sample rate, caching and cache dir
# can be set up by altering the following variables:
# Default langeuage: $lang
# Sample rate:       $samplerate
# Speed factor:      $speed
# Chace:             $usecache
# Chache directory:  $cachedir
# SoX Version:       $sox_ver
#
# Tiny version drops the use of mpg123 and requires MP3 format support in sox.
# It also makes the assumption that sox is in /usr/bin/ in order
# to skip detection and speed things up.
#

use warnings;
use strict;
use Encode qw(decode encode);
use File::Temp qw(tempfile);
use File::Copy qw(move);
use File::Path qw(mkpath);
use Digest::MD5 qw(md5_hex);
use URI::Escape;
use HTTP::Tiny;
$| = 1;

# ----------------------------------- #
#   User defined parameters:          #
# ----------------------------------- #
# Your Azure Marketplace credentials. #
my $clientid = "";
my $clientsecret = "";

# Default language                    #
my $lang = "en";

# Output speed factor                 #
my $speed = 1;

# Use of cache mechanism              #
my $usecache = 1;

# Cache directory path                #
my $cachedir = "/tmp";

# Output audio sample rate            #
# Leave blank to auto-detect          #
my $samplerate = "8000";

# SoX Version                         #
# Leave blank to auto-detect          #
my $sox_ver = "14";

# Verbose debugging messages          #
my $debug = 0;

# ----------------------------------- #

my %AGI;
my @text;
my $fh;
my $tmpname;
my $filename;
my $fexten;
my @result;
my $atoken;
my $http;
my $sox       = "/usr/bin/sox";
my $format    = "audio/mp3";
my $quality   = "MaxQuality";
my $intkey    = "";
my $tmpdir    = "/tmp";
my $maxlen    = 4096;
my $timeout   = 10;
my $url       = "https://api.microsofttranslator.com/V2/Http.svc";

# Store AGI input #
($AGI{arg_1}, $AGI{arg_2}, $AGI{arg_3}, $AGI{arg_4}) = @ARGV;
while (<STDIN>) {
	chomp;
	last if (!length);
	$AGI{$1} = $2 if (/^agi_(\w+)\:\s+(.*)$/);
}

my $name = " -- $AGI{request}:";

# Sanitising input #
$AGI{arg_1} = decode('utf8', $AGI{arg_1});
for ($AGI{arg_1}) {
	s/[\\|*~<>^\(\)\[\]\{\}[:cntrl:]]/ /g;
	s/\s+/ /g;
	s/^\s|\s$//g;
	fatal_log("No text passed for synthesis.") if (!length);
	$_ .= "." unless (/^.+[.,?!:;]$/);
	@text = /.{1,1000}[.,?!:;]|.{1,1000}\s/g;
}

# Setting language, interrupt keys and speed rate #
if (length($AGI{arg_2})) {
	if ($AGI{arg_2} =~ /[a-z]{2}(-[a-z]{2,3})?/) {
		$lang = $AGI{arg_2};
	} else {
		fatal_log("Invalid language setting.");
	}
}
if (length($AGI{arg_3})) {
	$intkey = "0123456789#*" if ($AGI{arg_3} eq "any");
	$intkey = $AGI{arg_3} if ($AGI{arg_3} =~ /^[0-9*#]+$/);
}
if (length($AGI{arg_4})) {
	$speed = $AGI{arg_4} if ($AGI{arg_4} =~ /^\d+(\.\d+)?$/);
}

# Check cache path size: dir length + md5 + file extension #
if ($usecache) {
	if ((length($cachedir) + 32 + 6) < $maxlen) {
		mkpath("$cachedir") unless (-d "$cachedir");
	} else {
		console_log("Cache path size exceeds limit. Disabling cache.");
		$usecache = 0;
	}
}

# Answer channel if not already answered #
print "CHANNEL STATUS\n";
@result = checkresponse();
if ($result[0] == 4) {
	print "ANSWER\n";
	@result = checkresponse();
	if ($result[0] != 0) {
		fatal_log("Failed to answer channel.");
	}
}

# Setting filename extension according to sample rate. #
if    (!$samplerate)         { ($fexten, $samplerate) = detect_format(); }
elsif ($samplerate == 12000) { $fexten = "sln12"; }
elsif ($samplerate == 16000) { $fexten = "sln16"; }
elsif ($samplerate == 32000) { $fexten = "sln32"; }
elsif ($samplerate == 44100) { $fexten = "sln44"; }
elsif ($samplerate == 48000) { $fexten = "sln48"; }
else                         { ($fexten, $samplerate) =  ("sln", 8000); }

# Synthesize speech using MS Translator API #
foreach my $line (@text) {
	$line = encode('utf8', $line);
	$line =~ s/^\s+|\s+$//g;
	next if (length($line) == 0);
	if ($debug) {
		console_log(
			"Text passed for synthesis: $line, Language: $lang",
			"Interrupt keys: $intkey, Sample rate: $samplerate, Speed: $speed",
			"Caching: $usecache, Cache dir: $cachedir"
		);
	}
	if ($usecache) {
		$filename = md5_hex("$line.$lang.$speed");
		# Stream file from cache if it exists #
		if (-r "$cachedir/$filename.$fexten") {
			console_log("File already in cache.") if ($debug);
			my $res = playback("$cachedir/$filename", $intkey);
			last if ($res > 0);
			die if ($res < 0);
			next;
		}
	}
	# Initialise User angent #
	if (!$http) {
		$http = HTTP::Tiny->new(
			agent      => 'Asterisk MS TTS module',
			timeout    => $timeout,
			verify_SSL => 1,
		);
	}
	# Get access token #
	$atoken = get_access_token() if (!$atoken);
	fatal_log("No API key found. Aborting.") if (!$atoken);

	$line = uri_escape($line);

	# Hnadle interrupts #
	$SIG{'INT'} = \&int_handler;
	$SIG{'HUP'} = \&int_handler;

	($fh, $tmpname) = tempfile("mstts_XXXXXXXX", DIR => $tmpdir, UNLINK => 1);

	my $response = $http->mirror(
		"$url/Speak?text=$line&language=$lang&format=$format&options=$quality&appid=$atoken",
		$tmpname,
	);
	fatal_log("Failed to fetch file.") unless ($response->{success});

	my @soxargs = get_sox_args($tmpname, "$tmpname.$fexten");
	system(@soxargs) == 0 or fatal_log("$sox failed: $?");

	# Playback and save file in cache #
	my $res = playback($tmpname, $intkey);
	die if ($res < 0);
	if ($usecache) {
		console_log("Saving file $filename to cache") if ($debug);
		move("$tmpname.$fexten", "$cachedir/$filename.$fexten");
	} else {
		unlink "$tmpname.$fexten";
	}
	last if ($res > 0);
}
exit;

sub get_access_token {
# Obtaining an Access Token #
	my $token;
	my $expire;
	my $fh;
	my $tfile;
	my $spool = $ENV{'AST_SPOOL_DIR'};

	if ($spool) {
	 $tfile = $spool . "/tmp/mstts.token";
	}
	if ($tfile) {
		if (!-f $tfile) {
			open($fh, ">", $tfile);
		} elsif (open($fh, "+<", $tfile)) {
			console_log("Reading access token from file.") if ($debug);
			while (<$fh>) {
				/^expire:(\d+)$/ and $expire = $1;
				/^token:(.+)$/ and $token = $1;
			}
		}
	}
	if (!$token or time > $expire - 5) {
		$token = '';
		console_log("Getting a new access token.") if ($debug);
		my $form_data = [
				client_id     => $clientid,
				client_secret => $clientsecret,
				scope         => 'http://api.microsofttranslator.com',
				grant_type    => 'client_credentials',
		];
		my $response = $http->post_form(
			"https://datamarket.accesscontrol.windows.net/v2/OAuth2-13/",
			$form_data,
		);

		if ($response->{success} and $response->{content} =~ /^\{"token_type":".+?","access_token":"(.+?)","expires_in":"(\d+?)","scope":".+?"\}$/) {
			$token = uri_escape("Bearer $1");
			$expire = time + $2;
			if ($fh) {
				seek($fh, 0,0);
				print $fh "expire:$expire\n";
				print $fh "token:$token\n";
				truncate($fh, tell($fh));
			}
		} else {
			console_log("Failed to get Access Token.") if ($debug);
		}
	}
	close $fh if($fh);
	return $token;
}

sub checkresponse {
	my $input = <STDIN>;
	my @values;

	chomp $input;
	if ($input =~ /^200 result=(-?\d+)\s?(.*)$/) {
		@values = ("$1", "$2");
	} else {
		$input .= <STDIN> if ($input =~ /^520-Invalid/);
		warn "$name Unexpected result: $input\n";
		@values = (-1, -1);
	}
	return @values;
}

sub playback {
	my ($file, $keys) = @_;
	my @response;

	print "STREAM FILE $file \"$keys\"\n";
	@response = checkresponse();
	if ($response[0] >= 32 && chr($response[0]) =~ /[\w*#]/) {
		console_log("Got digit ", chr($response[0])) if ($debug);
		print "SET EXTENSION ", chr($response[0]), "\n";
		checkresponse();
		print "SET PRIORITY 1\n";
		checkresponse();
	} elsif ($response[0] == -1) {
		console_log("Failed to play $file");
	}
	return $response[0];
}

sub detect_format {
# Detect the sound format used #
	my @format;
	print "GET FULL VARIABLE \${CHANNEL(audionativeformat)}\n";
	my @reply = checkresponse();
	for ($reply[1]) {
		if    (/(silk|sln)12/)                    { @format = ("sln12", 12000); }
		elsif (/(speex|slin|silk)16|g722|siren7/) { @format = ("sln16", 16000); }
		elsif (/(speex|slin|celt)32|siren14/)     { @format = ("sln32", 32000); }
		elsif (/(celt|slin)44/)                   { @format = ("sln44", 44100); }
		elsif (/(celt|slin)48/)                   { @format = ("sln48", 48000); }
		else                                      { @format = ("sln",    8000); }
	}
	return @format;
}

sub get_sox_args {
	my ($source_file, $dest_file) = @_;
	# Detect sox version #
	if (!$sox_ver) {
		$sox_ver = (system("$sox --version > /dev/null 2>&1") == 0) ? 14 : 12;
		console_log("Found sox version $sox_ver in: $sox") if ($debug);
	}
	# Set the appropiate sox cli arguments #
	my @soxargs = ($sox, "-t", "mp3", $source_file, "-q", "-r", $samplerate, "-t", "raw", $dest_file);
	if ($speed != 1) {
		if ($sox_ver >= 14) {
			push(@soxargs, ("tempo", "-s", $speed));
		} else {
			push(@soxargs, ("stretch", 1/$speed, "80"));
		}
	}
	return @soxargs;
}

sub console_log {
	foreach my $message (@_) {
		warn "$name $message\n";
		print "NOOP \"$name $message\"\n";
		checkresponse();
	}
}

sub fatal_log {
	console_log(@_);
	die;
}

sub int_handler {
	die "$name Interrupt signal received, terminating...\n";
}

END {
	if ($tmpname) {
		warn "$name Cleaning temp files.\n" if ($debug);
		unlink glob "$tmpname*";
	}
}