1package Net::CSTA;
2
3use strict;
4use warnings;
5
6require Exporter;
7use AutoLoader qw(AUTOLOAD);
8
9our @ISA = qw(Exporter);
10
11# Items to export into callers namespace by default. Note: do not export
12# names by default without a very good reason. Use EXPORT_OK instead.
13# Do not simply export all your public functions/methods/constants.
14
15# This allows declaration	use Net::CSTA ':all';
16# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
17# will save memory.
18our %EXPORT_TAGS = ( 'all' => [ qw(
19
20) ] );
21
22our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
23
24our @EXPORT = qw(
25
26);
27
28our $VERSION = '0.04';
29use IO::Socket::INET;
30use Net::CSTA::ASN qw(CSTAapdu);
31use Convert::ASN1 qw(:io);
32
33sub new {
34   my $self = shift;
35   my $class = ref $self || $self;
36   my %me = @_;
37   my $this = bless \%me,$class;
38   $this->init();
39}
40
41package Net::CSTA::PDU;
42use Net::CSTA::ASN qw(CSTAapdu);
43use MIME::Base64;
44
45sub decode {
46   my $self = shift;
47   my $class = ref $self || $self;
48   my $pdu = shift;
49   my $this = bless $CSTAapdu->decode($pdu),$class;
50   $this->init();
51}
52
53sub _hexenc {
54  join(":",map { sprintf("%2.2x",$_); } unpack("C*",$_[0]))
55}
56
57sub isError {
58	my $self = shift;
59	defined $self->{typeOfError};
60}
61
62sub _b64 {
63	my $x = encode_base64($_[0]);
64
65	chomp($x);
66	$x;
67}
68
69sub _safe_copy {
70	my $self = shift;
71
72	my $copy;
73	SWITCH: {
74		UNIVERSAL::isa($self,'ARRAY') and do {
75			$copy = [];
76			foreach (@{$self})
77			{
78				push(@{$copy},_safe_copy($_));
79			}
80		},last SWITCH;
81
82		UNIVERSAL::isa($self,'HASH') || UNIVERSAL::isa($self,'Net::CSTA::PDU') and do {
83			$copy = {};
84			foreach (keys %{$self})
85			{
86				$copy->{$_} = _safe_copy($self->{$_});
87			}
88		},last SWITCH;
89
90		do {
91			$copy = $self =~ /^[[:print:]^>^<^^=]*$/ ? $self : _hexenc($self);
92		},last SWITCH;
93	};
94
95	$copy;
96}
97
98sub toXML {
99	my $pdu = _safe_copy($_[0]);
100	use XML::Simple;
101
102	XMLout($pdu,RootName=>'csta');
103}
104
105sub init {
106	$_[0];
107}
108
109package Net::CSTA;
110
111sub init {
112   my $self = shift;
113   $self->{_csock} = IO::Socket::INET->new(Proto=>'tcp',PeerHost=>$self->{Host},PeerPort=>$self->{Port})
114     or die "Unable to connect to CSTA server at $self->{Host}:$self->{Port}: $!\n";
115   $self->{_ssock} = IO::Socket::INET->new(Proto=>'udp',LocalHost=>'localhost',LocalPort=>$self->{LocalPort} || 3333)
116     or die "Unable to create local UDP port: $!\n";
117   $self->{_req} = $$;
118   $self->{Debug} = 0 unless defined $self->{Debug};
119   $self;
120}
121
122sub next_request {
123   $_[0]->{_req}++;
124}
125
126sub this_request {
127   $_[0]->{_req};
128}
129
130sub debug
131{
132	$_[0]->{Debug};
133}
134
135sub close
136{
137   my $self = shift;
138   my $sock = shift || $self->{_csock};
139   shutdown($sock,2);
140   close($sock);
141}
142
143sub write_pdu {
144   my $self = shift;
145   my $pdu = shift;
146   my $len = length($pdu);
147   my $sock = shift || $self->{_csock};
148
149   if ($self->debug > 1)
150   {
151   	warn "C ---> S\n";
152   	Convert::ASN1::asn_dump(*STDERR, $pdu);
153   	Convert::ASN1::asn_hexdump(*STDERR, $pdu) if $self->debug > 2;
154   }
155
156   $sock->write(pack "n",$len);
157   $sock->write($pdu);
158}
159
160sub read_pdu {
161   my $self = shift;
162   my $timeout = shift || undef;
163   my $sock = shift || $self->{_csock};
164
165   my $buf = "";
166
167   my ($rin,$win,$ein) = ("","","");
168   my ($rout,$wout,$eout) = ("","","");
169
170   vec($rin,$sock->fileno,1) = 1;
171   $ein = $rin | $win;
172
173   my $n = select($rout=$rin,$wout=$win,$eout=$ein,$timeout);
174   return undef unless $n > 0;
175
176   eval {
177      local $SIG{ALRM} = sub { die "alarm\n" };
178      alarm ($timeout || 30);
179      my $nread = $sock->sysread($buf,2);
180      my $len = unpack "n",$buf;
181      $sock->sysread($buf,$len);
182      alarm 0;
183   }; if ($@) {
184      die unless $@ eq "alarm\n";
185      warn "Caught timeout\n";
186      return undef;
187   }
188
189   if ($self->debug > 1)
190   {
191  	warn "C <--- S\n";
192   	Convert::ASN1::asn_dump(*STDERR, $buf);
193   	Convert::ASN1::asn_hexdump(*STDERR, $buf) if $self->debug > 2;
194   }
195   $buf;
196}
197
198sub send_and_receive {
199   my $self = shift;
200
201   $self->send(@_);
202   $self->receive();
203}
204
205sub request {
206   my $self = shift;
207   my %op = @_;
208
209   $op{invokeID} = $self->next_request;
210   $self->send_and_receive(svcRequest=>\%op);
211}
212
213sub send {
214   my $self = shift;
215   my $pdu = $CSTAapdu->encode(@_);
216
217   $self->write_pdu($pdu);
218}
219
220sub receive {
221   my $self = shift;
222   my $pdu = $self->read_pdu(@_);
223   return undef unless $pdu;
224
225   Net::CSTA::PDU->decode($pdu);
226}
227
228sub recv_pdu {
229  my $self = shift;
230  my $sock = shift || $self->{_ssock};
231
232  my $buf = "";
233  my $nread = $sock->recv($buf,2);
234  my $len = unpack "n",$buf;
235  $sock->recv_pdu($buf,$len);
236
237  if ($self->debug > 1)
238  {
239  	warn "C <--- S\n";
240  	Convert::ASN1::asn_dump(*STDERR, $buf);
241  	Convert::ASN1::asn_hexdump(*STDERR, $buf) if $self->debug > 2;
242  }
243
244  $buf;
245}
246
247# Preloaded methods go here.
248
249# Autoload methods go after =cut, and are processed by the autosplit program.
250
2511;
252__END__
253# Below is stub documentation for your module. You'd better edit it!
254
255=head1 NAME
256
257Net::CSTA - Perl extension for ECMA CSTA
258
259=head1 SYNOPSIS
260
261  use Net::CSTA;
262
263  # Connect to the CSTA server
264  my $csta = Net::CSTA->new(Host=>'csta-server',Port=>'csta-server-port');
265  # Create a monitor for '555'
266  my $number = 555;
267  $csta->request(serviceID=>71,
268  			     serviceArgs=>{monitorObject=>{device=>{dialingNumber=>$number}}})
269
270  for (;;)
271  {
272  	 my $pdu = $csta->receive();
273  	 print $pdu->toXML();
274  }
275
276=head1 DESCRIPTION
277
278ECMA CSTA is an ASN.1 based protocol for Computer Integrated Telephony (CTI) using
279CSTA it is possible to write code that communicates with a PBX. Typical applications
280include receiving notifications for incoming calls, placing calls, redirecting calls
281or placing conference calls.
282
283=head1 BUGS
284
285This module currently implements CSTA phase I - mostly because my PBX (MD110 with
286Application Link 4.0) only supports phase I. Supporting multiple versions will
287require some thought since the versions are largly incompatible.
288
289The CSTA client opens a UDP port on 3333 to receive incoming usolicited notifications.
290This is not implemented yet.
291
292=head1 SECURITY CONSIDERATIONS
293
294CSTA is a protocol devoid of any form of security. Take care to firewall your CSTA
295server and throw away the key.
296
297=head1 SEE ALSO
298
299Convert::ASN1
300
301http://www.ecma-international.org/activities/Communications/TG11/cstaIII.htm
302
303
304=head1 AUTHOR
305
306Leif Johansson, E<lt>leifj@it.su.seE<gt>
307
308=head1 COPYRIGHT AND LICENSE
309
310Copyright (C) 2006 by Leif Johansson
311
312This library is free software; you can redistribute it and/or modify
313it under the same terms as Perl itself, either Perl version 5.8.6 or,
314at your option, any later version of Perl 5 you may have available.
315
316=cut
317