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