#!/usr/bin/perl # # faceClient # CGI speech cue interface to local voiceServer # # 0.05 9/20/2002 # Quick update for mod_perl support # # 0.04 6/19/2002 # Added explicit host-based security # # 0.03 5/21/2002 # Added back-end support for emotion # # 0.02 5/9/2002 # Added speech cue character sanitizing. # # 0.01 # First working version # Requires # URI::Escape # IPC::Shareable # CGI::Request #use strict; use IPC::Shareable; use CGI::Request; use Apache::Constants ':common'; # Debugging stuff $IPC::Shareable::Debug = 1; # Simple interface: (combines SendHeaders, new and import_names) #my $req = GetRequest($pkg); # Full Interface: # We only need to output info, so this isn't required. my $req = new CGI::Request; # fetch and parse request my $cueglue = 'cuedata'; my %options = ( 'key' => 'cue', 'create' => 0, 'exclusive' => 0, 'mode' => 0644, 'destroy' => 0, ); $knot = tie(%cueinfo, IPC::Shareable, $cueglue, { %options }) or die "$$: tie failed $!\n"; # List of IPs we accept speech cue requests from my @allowedips = ('10.1.5.71', '10.1.5.72', '10.1.5.73', '10.1.5.74', '64.81.244.139', '192.168.69.3', '10.1.0.49', # Mike's laptop '127.0.0.1' ); my $clientip = $req->cgi->var("REMOTE_ADDR"); my $verified = 0; for $i (0 .. $#allowedips) { if ($allowedips[$i] eq $clientip) { $verified = 1; } } if (!$verified) { print "

Sorry, $clientip is not allowed to send speech requests.

\n"; exit; } if ($req->param('speechtext') eq "") { if($req->param('speechmacro') eq "") { if ($req->param('emotion') ne "") { # Send emotion only setcue(0, $req->param('emotion')); } } else { # Send macro setcue($req->param('speechmacro'), $req->param('emotion')); } } else { # Send speechtext setcue($req->param('speechtext'), $req->param('emotion')); } print ""; print "

"; print ""; print "

"; print ""; #print ""; print ""; print "

Macros:

"; print ""; print "

"; exit; sub setcue { ($cuestring, $emotion) = @_; #$OK_CHARS='-a-zA-Z0-9_.,\?\.\!\' '; $OK_CHARS='-a-zA-Z0-9_.,\?\.\!\' \"\<\>\/\%=\~:\[\]'; $cuestring =~ s/[^$OK_CHARS]/ /go; if ($emotion =~ m/happy/) { $emotion = "happy"; } if ($emotion =~ m/sad/) { $emotion = "sad"; } if ($emotion =~ m/neutral/) { $emotion = "neutral"; } if ($emotion =~ m/angry/) { $emotion = "angry"; } if ($emotion eq "") { $emotion= "neutral"; } if (($cuestring ne "") && ($cuestring ne " ")) { $knot->shlock; $cueinfo{cuestring} = $cuestring; $cueinfo{timestamp} = time(); $cueinfo{emotion} = $emotion; $knot->shunlock; print "Saying: $cuestring\n"; } }