1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
use strict;
use warnings;
############################################################################
#
# Net::SIP::NATHelper::Client
# proxy for Net::SIP::NAT::Helper to communicate over sockets
# with Net::SIP::NATHelper::Server
# used in connection with bin/nathelper.pl
#
############################################################################
package Net::SIP::NATHelper::Client;
use Net::SIP::Debug;
use Net::SIP::Util qw(invoke_callback INETSOCK);
use IO::Socket;
use Storable qw(nfreeze thaw);
sub new {
my ($class,$socket) = @_;
my $create_socket = $socket =~m{/}
? [ \&__create_unix_socket, $socket ]
: [ \&__create_tcp_socket, $socket ]
;
my $self = bless { create_socket => $create_socket },$class;
return $self;
}
sub allocate_sockets {
my Net::SIP::NATHelper::Client $self = shift;
return $self->rpc( 'allocate',@_ );
}
sub activate_session {
my Net::SIP::NATHelper::Client $self = shift;
return $self->rpc( 'activate',@_ );
}
sub close_session {
my Net::SIP::NATHelper::Client $self = shift;
return $self->rpc( 'close',@_ );
}
sub rpc {
my Net::SIP::NATHelper::Client $self = shift;
my ($method,@arg) = @_;
my $sock = invoke_callback( $self->{create_socket} ) || die $!;
$sock->autoflush;
my $packet = pack( "N/a*", nfreeze([$method,@arg]));
print $sock $packet;
read( $sock, my $len,4 ) || die $!;
$len = unpack( "N",$len );
die if $len>32768;
die $! unless $len == read( $sock, $packet, $len );
my $ref = eval { thaw($packet) } || die $@;
return $$ref;
}
sub __create_unix_socket {
my $socket = shift;
return IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Peer => $socket
);
}
sub __create_tcp_socket {
my $socket = shift;
return INETSOCK( $socket );
}
1;
|
