337 lines
8.2 KiB
Perl
Executable File
337 lines
8.2 KiB
Perl
Executable File
=head1 NAME
|
|
|
|
POE::Filter::FSSocket - a POE filter that parses FreeSWITCH events into hashes
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
#!/usr/bin/perl
|
|
|
|
use warnings;
|
|
use strict;
|
|
|
|
use POE qw(Component::Client::TCP Filter::FSSocket);
|
|
use Data::Dumper;
|
|
|
|
POE::Component::Client::TCP->new(
|
|
'RemoteAddress' => '127.0.0.1',
|
|
'RemotePort' => '8021',
|
|
'ServerInput' => \&handle_server_input,
|
|
'Filter' => 'POE::Filter::FSSocket',
|
|
);
|
|
|
|
POE::Kernel->run();
|
|
exit;
|
|
|
|
my $auth_sent = 0;
|
|
my $password = "ClueCon";
|
|
|
|
sub handle_server_input {
|
|
my ($heap,$input) = @_[HEAP,ARG0];
|
|
|
|
print Dumper $input;
|
|
|
|
|
|
if($input->{'Content-Type'} eq "auth/request") {
|
|
$auth_sent = 1;
|
|
$heap->{'server'}->put("auth $password");
|
|
} elsif ($input->{'Content-Type'} eq "command/reply") {
|
|
if($auth_sent == 1) {
|
|
$auth_sent = -1;
|
|
|
|
#do post auth stuff
|
|
$heap->{'server'}->put("events plain all");
|
|
}
|
|
}
|
|
}
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
POE::Filter::FSSocket parses output from FreeSWITCH into hashes. FreeSWITCH
|
|
events have a very wide range of keys, the only consistant one being
|
|
Content-Type. The keys are dependant on the type of events. You must use the
|
|
plain event type as that is what the filter knows how to parse. You can ask for
|
|
as many event types as you like or all for everything. You specify a list of
|
|
event types by putting spaces between them ex: "events plain api log talk"
|
|
|
|
Currently known event types (Event-Name):
|
|
|
|
CUSTOM
|
|
CHANNEL_CREATE
|
|
CHANNEL_DESTROY
|
|
CHANNEL_STATE
|
|
CHANNEL_ANSWER
|
|
CHANNEL_HANGUP
|
|
CHANNEL_EXECUTE
|
|
CHANNEL_BRIDGE
|
|
CHANNEL_UNBRIDGE
|
|
CHANNEL_PROGRESS
|
|
CHANNEL_OUTGOING
|
|
CHANNEL_PARK
|
|
CHANNEL_UNPARK
|
|
API
|
|
LOG
|
|
INBOUND_CHAN
|
|
OUTBOUND_CHAN
|
|
STARTUP
|
|
SHUTDOWN
|
|
PUBLISH
|
|
UNPUBLISH
|
|
TALK
|
|
NOTALK
|
|
SESSION_CRASH
|
|
MODULE_LOAD
|
|
DTMF
|
|
MESSAGE
|
|
CODEC
|
|
BACKGROUND_JOB
|
|
ALL
|
|
|
|
Currently handled FreeSWITCH messages (Content-Type):
|
|
|
|
auth/request
|
|
command/response
|
|
text/event-plain
|
|
api/response (data in __DATA__ variable)
|
|
log/data (data in __DATA__ variable)
|
|
|
|
=cut
|
|
|
|
|
|
package POE::Filter::FSSocket;
|
|
|
|
use warnings;
|
|
use strict;
|
|
|
|
use Carp qw(carp croak);
|
|
use vars qw($VERSION);
|
|
use base qw(POE::Filter);
|
|
|
|
$VERSION = '0.06';
|
|
|
|
use Data::Dumper;
|
|
|
|
#self array
|
|
sub FRAMING_BUFFER() {0}
|
|
sub PARSER_STATE() {1}
|
|
sub PARSER_STATENEXT() {2}
|
|
sub PARSED_RECORD() {3}
|
|
sub CURRENT_LENGTH() {4}
|
|
sub STRICT_PARSE() {5}
|
|
sub DEBUG_LEVEL() {6}
|
|
|
|
#states of the parser
|
|
sub STATE_WAITING() {1} #looking for new input
|
|
sub STATE_CLEANUP() {2} #wipe out record separators
|
|
sub STATE_GETDATA() {3} #have header, get data
|
|
sub STATE_FLUSH() {4} #puts us back in wait state and tells us to kill the parsed_record
|
|
sub STATE_TEXTRESPONSE() {5} #used for api output
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my %args = @_;
|
|
|
|
my $strict = 0;
|
|
my $debug = 0;
|
|
|
|
if(defined($args{'debug'})) {
|
|
$debug = $args{'debug'};
|
|
}
|
|
|
|
if(defined($args{'strict'}) && $args{'strict'} == 1) {
|
|
$strict = $args{'strict'};
|
|
}
|
|
|
|
my $self = bless [
|
|
"", #framing buffer
|
|
STATE_WAITING, #PARSER_STATE
|
|
undef, #PARSER_STATE
|
|
{}, #PARSED_RECORD
|
|
0, #length tracking (for Content-Length when needed)
|
|
$strict, #whether we should bail on a bad parse or try and save the session
|
|
$debug, #debug level
|
|
], $class;
|
|
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub get_one_start {
|
|
my ($self, $stream) = @_;
|
|
|
|
#take all the chunks and put them in the buffer
|
|
$self->[FRAMING_BUFFER] .= join('', @{$stream});
|
|
}
|
|
|
|
sub get_one {
|
|
my $self = shift;
|
|
|
|
my $line;
|
|
|
|
while(1) {
|
|
$line = "";
|
|
|
|
#see if we are in line based or length based mode
|
|
if($self->[PARSER_STATE] == STATE_TEXTRESPONSE) {
|
|
my $length = $self->[PARSED_RECORD]{'Content-Length'};
|
|
|
|
if($self->[FRAMING_BUFFER] =~ s/^(.{$length})//s) {
|
|
$self->[PARSER_STATE] = STATE_FLUSH;
|
|
$self->[PARSED_RECORD]->{'__DATA__'} = $1;
|
|
return [ $self->[PARSED_RECORD] ];
|
|
} else {
|
|
#not engough in the buffer yet, come back later
|
|
return;
|
|
}
|
|
} else { #we are in normal line based mode
|
|
if($self->[FRAMING_BUFFER] =~ s/^(.*?)(\x0D\x0A?|\x0A\x0D?)//) {
|
|
$line = $1;
|
|
} else {
|
|
#not enough off of the socket yet, come back later
|
|
return [];
|
|
}
|
|
}
|
|
|
|
if(($self->[PARSER_STATE] == STATE_WAITING) || ($self->[PARSER_STATE] == STATE_FLUSH)) {
|
|
#see if we need to wipe out the parsed_record info
|
|
if($self->[PARSER_STATE] == STATE_FLUSH) {
|
|
delete $self->[PARSED_RECORD];
|
|
$self->[CURRENT_LENGTH] = 0;
|
|
|
|
$self->[PARSER_STATE] = STATE_WAITING;
|
|
}
|
|
|
|
if($line =~ /Content-Length:\ (\d+)$/) {
|
|
#store the length
|
|
$self->[PARSED_RECORD]{'Content-Length'} = $1;
|
|
|
|
#see if we had a place to go from here (we should)
|
|
if(defined($self->[PARSER_STATENEXT])) {
|
|
$self->[PARSER_STATE] = $self->[PARSER_STATENEXT];
|
|
$self->[PARSER_STATENEXT] = undef;
|
|
}
|
|
} elsif($line =~ /Content-Type:\ (.*)$/) {
|
|
#store the type of request
|
|
$self->[PARSED_RECORD]{'Content-Type'} = $1;
|
|
|
|
if($1 eq "auth/request") {
|
|
$self->[PARSER_STATE] = STATE_CLEANUP;
|
|
$self->[PARSER_STATENEXT] = STATE_FLUSH;
|
|
return [ $self->[PARSED_RECORD] ];
|
|
} elsif ($1 eq "command/reply") { #do something with this later
|
|
$self->[PARSER_STATE] = STATE_GETDATA;
|
|
} elsif ($1 eq "text/event-plain") {
|
|
$self->[PARSER_STATE] = STATE_CLEANUP;
|
|
$self->[PARSER_STATENEXT] = STATE_GETDATA;
|
|
} elsif ($1 eq "api/response") {
|
|
$self->[PARSER_STATENEXT] = STATE_TEXTRESPONSE;
|
|
} elsif ($1 eq "log/data") {
|
|
$self->[PARSER_STATENEXT] = STATE_TEXTRESPONSE;
|
|
} else { #unexpected input
|
|
croak ref($self) . " unknown input [" . $self->[PARSER_STATE] . "] (" . $line . ")";
|
|
}
|
|
} else {
|
|
#already in wait state, if we are not in strict, keep going
|
|
if($self->[STRICT_PARSE]) {
|
|
croak ref($self) . " unknown input [STATE_WAITING] (" . $line . ")";
|
|
}
|
|
}
|
|
} elsif ($self->[PARSER_STATE] == STATE_CLEANUP) {
|
|
if($line eq "") {
|
|
if(defined($self->[PARSER_STATENEXT])) {
|
|
$self->[PARSER_STATE] = $self->[PARSER_STATENEXT];
|
|
$self->[PARSER_STATENEXT] = undef;
|
|
} else {
|
|
$self->[PARSER_STATE] = STATE_WAITING;
|
|
}
|
|
} else {
|
|
#see if we should bail
|
|
if($self->[STRICT_PARSE]) {
|
|
croak ref($self) . " unknown input [STATE_CLEANUP] (" . $line . ")";
|
|
} else {
|
|
#we are not supposed to bail so try and save our session...
|
|
#since we are think we should be cleaning up, flush it all away
|
|
$self->[PARSER_STATE] = STATE_FLUSH;
|
|
|
|
#parser fail should be considered critical, if any debug at all, print dump
|
|
if($self->[DEBUG_LEVEL]) {
|
|
print STDERR "Parse failed on ($line) in STATE_CLEANUP:\n";
|
|
print STDERR Dumper $self->[PARSED_RECORD];
|
|
}
|
|
}
|
|
}
|
|
} elsif ($self->[PARSER_STATE] == STATE_GETDATA) {
|
|
if($line =~ /^([^:]+):\ (.*)$/) {
|
|
$self->[PARSED_RECORD]{$1} = $2;
|
|
} elsif ($line eq "") { #end of event
|
|
$self->[PARSER_STATE] = STATE_FLUSH;
|
|
|
|
return [ $self->[PARSED_RECORD] ];
|
|
} else {
|
|
if($self->[STRICT_PARSE]) {
|
|
croak ref($self) . " unknown input [STATE_GETDATA] (" . $line . ")";
|
|
} else {
|
|
#flush and run
|
|
$self->[PARSER_STATE] = STATE_FLUSH;
|
|
|
|
#parser fail should be considered critical, if any debug at all, print dump
|
|
if($self->[DEBUG_LEVEL]) {
|
|
print STDERR "Parse failed on ($line) in STATE_GETDATA:\n";
|
|
print STDERR Dumper $self->[PARSED_RECORD];
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub put {
|
|
my ($self, $lines) = @_;
|
|
|
|
my @row;
|
|
foreach my $line (@$lines) {
|
|
push @row, $line . "\n\n";
|
|
}
|
|
|
|
return \@row;
|
|
|
|
}
|
|
|
|
sub get_pending {
|
|
my $self = shift;
|
|
return $self->[FRAMING_BUFFER];
|
|
}
|
|
|
|
sub get {
|
|
my ($self, $stream) = @_;
|
|
my @return;
|
|
|
|
$self->get_one_start($stream);
|
|
while(1) {
|
|
my $next = $self->get_one();
|
|
last unless @$next;
|
|
push @return, @$next;
|
|
}
|
|
|
|
return \@return;
|
|
}
|
|
|
|
1;
|
|
|
|
=head1 SEE ALSO
|
|
|
|
FreeSWITCH - http://www.freeswitch.org/
|
|
|
|
=head1 AUTHORS
|
|
|
|
POE::Filter::FSSocket is written by Paul Tinsley. You can reach him by e-mail
|
|
at pdt@jackhammer.org.
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright 2006, Paul Tinsley. All rights are reserved.
|
|
|
|
POE::Filter::FSSocket is free software; it is currently licensed under the MPL
|
|
license version 1.1.
|
|
|
|
=cut
|