Implement vici Perl binding
This commit is contained in:
parent
cbc43f1b43
commit
a101bce862
|
@ -299,6 +299,8 @@ ARG_ENABL_SET([ruby-gems], [enable build of provided ruby gems.])
|
||||||
ARG_ENABL_SET([ruby-gems-install],[enable installation of provided ruby gems.])
|
ARG_ENABL_SET([ruby-gems-install],[enable installation of provided ruby gems.])
|
||||||
ARG_ENABL_SET([python-eggs], [enable build of provided python eggs.])
|
ARG_ENABL_SET([python-eggs], [enable build of provided python eggs.])
|
||||||
ARG_ENABL_SET([python-eggs-install],[enable installation of provided python eggs.])
|
ARG_ENABL_SET([python-eggs-install],[enable installation of provided python eggs.])
|
||||||
|
ARG_ENABL_SET([perl-cpan], [enable build of provided perl CPAN module.])
|
||||||
|
ARG_ENABL_SET([perl-cpan-install],[enable installation of provided CPAN module.])
|
||||||
# compile options
|
# compile options
|
||||||
ARG_ENABL_SET([coverage], [enable lcov coverage report generation.])
|
ARG_ENABL_SET([coverage], [enable lcov coverage report generation.])
|
||||||
ARG_ENABL_SET([leak-detective], [enable malloc hooks to find memory leaks.])
|
ARG_ENABL_SET([leak-detective], [enable malloc hooks to find memory leaks.])
|
||||||
|
@ -1622,6 +1624,7 @@ AM_CONDITIONAL(USE_SYSTEMD, test x$systemd = xtrue)
|
||||||
AM_CONDITIONAL(USE_LEGACY_SYSTEMD, test -n "$systemdsystemunitdir" -a "x$systemdsystemunitdir" != xno)
|
AM_CONDITIONAL(USE_LEGACY_SYSTEMD, test -n "$systemdsystemunitdir" -a "x$systemdsystemunitdir" != xno)
|
||||||
AM_CONDITIONAL(USE_RUBY_GEMS, test x$ruby_gems = xtrue)
|
AM_CONDITIONAL(USE_RUBY_GEMS, test x$ruby_gems = xtrue)
|
||||||
AM_CONDITIONAL(USE_PYTHON_EGGS, test x$python_eggs = xtrue)
|
AM_CONDITIONAL(USE_PYTHON_EGGS, test x$python_eggs = xtrue)
|
||||||
|
AM_CONDITIONAL(USE_PERL_CPAN, test x$perl_cpan = xtrue)
|
||||||
AM_CONDITIONAL(USE_PY_TEST, test "x$PY_TEST" != x)
|
AM_CONDITIONAL(USE_PY_TEST, test "x$PY_TEST" != x)
|
||||||
|
|
||||||
# ========================
|
# ========================
|
||||||
|
@ -1835,6 +1838,7 @@ AC_CONFIG_FILES([
|
||||||
src/libcharon/plugins/stroke/Makefile
|
src/libcharon/plugins/stroke/Makefile
|
||||||
src/libcharon/plugins/vici/Makefile
|
src/libcharon/plugins/vici/Makefile
|
||||||
src/libcharon/plugins/vici/ruby/Makefile
|
src/libcharon/plugins/vici/ruby/Makefile
|
||||||
|
src/libcharon/plugins/vici/perl/Makefile
|
||||||
src/libcharon/plugins/vici/python/Makefile
|
src/libcharon/plugins/vici/python/Makefile
|
||||||
src/libcharon/plugins/updown/Makefile
|
src/libcharon/plugins/updown/Makefile
|
||||||
src/libcharon/plugins/dhcp/Makefile
|
src/libcharon/plugins/dhcp/Makefile
|
||||||
|
|
|
@ -79,3 +79,7 @@ endif
|
||||||
if USE_PYTHON_EGGS
|
if USE_PYTHON_EGGS
|
||||||
SUBDIRS += python
|
SUBDIRS += python
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
if USE_PERL_CPAN
|
||||||
|
SUBDIRS += perl
|
||||||
|
endif
|
||||||
|
|
|
@ -0,0 +1,19 @@
|
||||||
|
Copyright (c) 2015 Andreas Steffen
|
||||||
|
|
||||||
|
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
of this software and associated documentation files (the "Software"), to deal
|
||||||
|
in the Software without restriction, including without limitation the rights
|
||||||
|
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||||
|
copies of the Software, and to permit persons to whom the Software is
|
||||||
|
furnished to do so, subject to the following conditions:
|
||||||
|
|
||||||
|
The above copyright notice and this permission notice shall be included in
|
||||||
|
all copies or substantial portions of the Software.
|
||||||
|
|
||||||
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||||
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||||
|
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||||
|
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
|
||||||
|
THE SOFTWARE.
|
|
@ -0,0 +1 @@
|
||||||
|
include LICENSE
|
|
@ -0,0 +1,6 @@
|
||||||
|
EXTRA_DIST = LICENSE \
|
||||||
|
Vici/Message.pm \
|
||||||
|
Vici/Packet.pm \
|
||||||
|
Vici/Session.pm \
|
||||||
|
Vici/Transport.pm
|
||||||
|
|
|
@ -0,0 +1,214 @@
|
||||||
|
package Vici::Message;
|
||||||
|
|
||||||
|
require Exporter;
|
||||||
|
|
||||||
|
our @ISA = qw(Exporter);
|
||||||
|
our @EXPORT = qw(new, from_data, hash, encode, raw);
|
||||||
|
our @VERSION = 0.9;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use Switch;
|
||||||
|
use Vici::Transport;
|
||||||
|
|
||||||
|
use constant {
|
||||||
|
SECTION_START => 1, # Begin a new section having a name
|
||||||
|
SECTION_END => 2, # End a previously started section
|
||||||
|
KEY_VALUE => 3, # Define a value for a named key in the section
|
||||||
|
LIST_START => 4, # Begin a named list for list items
|
||||||
|
LIST_ITEM => 5, # Define an unnamed item value in the current list
|
||||||
|
LIST_END => 6, # End a previously started list
|
||||||
|
};
|
||||||
|
|
||||||
|
sub new {
|
||||||
|
my $class = shift;
|
||||||
|
my $hash = shift;
|
||||||
|
my $self = {
|
||||||
|
Hash => $hash
|
||||||
|
};
|
||||||
|
bless($self, $class);
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub from_data {
|
||||||
|
my $class = shift;
|
||||||
|
my $data = shift;
|
||||||
|
my %hash = ();
|
||||||
|
|
||||||
|
parse($data, \%hash);
|
||||||
|
|
||||||
|
my $self = {
|
||||||
|
Hash => \%hash
|
||||||
|
};
|
||||||
|
bless($self, $class);
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub hash {
|
||||||
|
my $self = shift;
|
||||||
|
return $self->{Hash};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub encode {
|
||||||
|
my $self = shift;
|
||||||
|
return encode_hash($self->{'Hash'});
|
||||||
|
}
|
||||||
|
|
||||||
|
sub raw {
|
||||||
|
my $self = shift;
|
||||||
|
return '{' . raw_hash($self->{'Hash'}) . '}';
|
||||||
|
}
|
||||||
|
|
||||||
|
# private functions
|
||||||
|
|
||||||
|
sub parse {
|
||||||
|
my $data = shift;
|
||||||
|
my $hash = shift;
|
||||||
|
|
||||||
|
while (length($data) > 0)
|
||||||
|
{
|
||||||
|
(my $type, $data) = unpack('Ca*', $data);
|
||||||
|
|
||||||
|
if ($type == SECTION_END)
|
||||||
|
{
|
||||||
|
return $data;
|
||||||
|
}
|
||||||
|
|
||||||
|
(my $key, $data) = unpack('C/a*a*', $data);
|
||||||
|
|
||||||
|
switch ($type)
|
||||||
|
{
|
||||||
|
case KEY_VALUE
|
||||||
|
{
|
||||||
|
(my $value, $data) = unpack('n/a*a*', $data);
|
||||||
|
$hash->{$key} = $value;
|
||||||
|
}
|
||||||
|
case SECTION_START
|
||||||
|
{
|
||||||
|
my %section = ();
|
||||||
|
$data = parse($data, \%section);
|
||||||
|
$hash->{$key} = \%section;
|
||||||
|
}
|
||||||
|
case LIST_START
|
||||||
|
{
|
||||||
|
my @list = ();
|
||||||
|
my $more = 1;
|
||||||
|
|
||||||
|
while (length($data) > 0 and $more)
|
||||||
|
{
|
||||||
|
(my $type, $data) = unpack('Ca*', $data);
|
||||||
|
switch ($type)
|
||||||
|
{
|
||||||
|
case LIST_ITEM
|
||||||
|
{
|
||||||
|
(my $value, $data) = unpack('n/a*a*', $data);
|
||||||
|
push(@list, $value);
|
||||||
|
}
|
||||||
|
case LIST_END
|
||||||
|
{
|
||||||
|
$more = 0;
|
||||||
|
$hash->{$key} = \@list;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
die "message parsing error: ", $type, "\n"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
die "message parsing error: ", $type, "\n"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $data;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub encode_hash {
|
||||||
|
my $hash = shift;
|
||||||
|
my $enc = '';
|
||||||
|
|
||||||
|
while ( (my $key, my $value) = each %$hash )
|
||||||
|
{
|
||||||
|
switch (ref($value))
|
||||||
|
{
|
||||||
|
case 'HASH'
|
||||||
|
{
|
||||||
|
$enc .= pack('CC/a*', SECTION_START, $key);
|
||||||
|
$enc .= encode_hash($value);
|
||||||
|
$enc .= pack('C', SECTION_END);
|
||||||
|
}
|
||||||
|
case 'ARRAY'
|
||||||
|
{
|
||||||
|
$enc .= pack('CC/a*', LIST_START, $key);
|
||||||
|
|
||||||
|
foreach my $item (@$value)
|
||||||
|
{
|
||||||
|
$enc .= pack('Cn/a*', LIST_ITEM, $item);
|
||||||
|
}
|
||||||
|
$enc .= pack('C', LIST_END);
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
$enc .= pack('CC/a*n/a*', KEY_VALUE, $key, $value);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $enc;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub raw_hash {
|
||||||
|
my $hash = shift;
|
||||||
|
my $raw = '';
|
||||||
|
my $first = 1;
|
||||||
|
|
||||||
|
while ( (my $key, my $value) = each %$hash )
|
||||||
|
{
|
||||||
|
if ($first)
|
||||||
|
{
|
||||||
|
$first = 0;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
$raw .= ' ';
|
||||||
|
}
|
||||||
|
$raw .= $key;
|
||||||
|
|
||||||
|
switch (ref($value))
|
||||||
|
{
|
||||||
|
case 'HASH'
|
||||||
|
{
|
||||||
|
$raw .= '{' . raw_hash($value) . '}';
|
||||||
|
}
|
||||||
|
case 'ARRAY'
|
||||||
|
{
|
||||||
|
my $first_item = 1;
|
||||||
|
$raw .= '[';
|
||||||
|
|
||||||
|
foreach my $item (@$value)
|
||||||
|
{
|
||||||
|
if ($first_item)
|
||||||
|
{
|
||||||
|
$first_item = 0;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
$raw .= ' ';
|
||||||
|
}
|
||||||
|
$raw .= $item;
|
||||||
|
}
|
||||||
|
$raw .= ']';
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
$raw .= '=' . $value;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $raw;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,150 @@
|
||||||
|
package Vici::Packet;
|
||||||
|
|
||||||
|
require Exporter;
|
||||||
|
|
||||||
|
our @ISA = qw(Exporter);
|
||||||
|
our @EXPORT = qw(new, request, register, unregister, streamed_request);
|
||||||
|
our @VERSION = 0.9;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use Switch;
|
||||||
|
use Vici::Transport;
|
||||||
|
|
||||||
|
use constant {
|
||||||
|
CMD_REQUEST => 0, # Named request message
|
||||||
|
CMD_RESPONSE => 1, # Unnamed response message for a request
|
||||||
|
CMD_UNKNOWN => 2, # Unnamed response if requested command is unknown
|
||||||
|
EVENT_REGISTER => 3, # Named event registration request
|
||||||
|
EVENT_UNREGISTER => 4, # Named event de-registration request
|
||||||
|
EVENT_CONFIRM => 5, # Unnamed confirmation for event (de-)registration
|
||||||
|
EVENT_UNKNOWN => 6, # Unnamed response if event (de-)registration failed
|
||||||
|
EVENT => 7, # Named event message
|
||||||
|
};
|
||||||
|
|
||||||
|
sub new {
|
||||||
|
my $class = shift;
|
||||||
|
my $socket = shift;
|
||||||
|
my $self = {
|
||||||
|
Transport => Vici::Transport->new($socket),
|
||||||
|
};
|
||||||
|
bless($self, $class);
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub request {
|
||||||
|
my ($self, $command, $data) = @_;
|
||||||
|
my $request = pack('CC/a*a*', CMD_REQUEST, $command, $data);
|
||||||
|
$self->{'Transport'}->send($request);
|
||||||
|
|
||||||
|
my $response = $self->{'Transport'}->receive();
|
||||||
|
my ($type, $msg) = unpack('Ca*', $response);
|
||||||
|
|
||||||
|
switch ($type)
|
||||||
|
{
|
||||||
|
case CMD_RESPONSE
|
||||||
|
{
|
||||||
|
return $msg
|
||||||
|
}
|
||||||
|
case CMD_UNKNOWN
|
||||||
|
{
|
||||||
|
die "unknown command '", $command, "'\n"
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
die "invalid response type\n"
|
||||||
|
}
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub register {
|
||||||
|
my ($self, $event) = @_;
|
||||||
|
my $request = pack('CC/a*a*', EVENT_REGISTER, $event);
|
||||||
|
$self->{'Transport'}->send($request);
|
||||||
|
|
||||||
|
my $response = $self->{'Transport'}->receive();
|
||||||
|
my ($type, $data) = unpack('Ca*', $response);
|
||||||
|
|
||||||
|
switch ($type)
|
||||||
|
{
|
||||||
|
case EVENT_CONFIRM
|
||||||
|
{
|
||||||
|
return
|
||||||
|
}
|
||||||
|
case EVENT_UNKNOWN
|
||||||
|
{
|
||||||
|
die "unknown event '", $event, "'\n"
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
die "invalid response type\n"
|
||||||
|
}
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub unregister {
|
||||||
|
my ($self, $event) = @_;
|
||||||
|
my $request = pack('CC/a*a*', EVENT_UNREGISTER, $event);
|
||||||
|
$self->{'Transport'}->send($request);
|
||||||
|
|
||||||
|
my $response = $self->{'Transport'}->receive();
|
||||||
|
my ($type, $data) = unpack('Ca*', $response);
|
||||||
|
|
||||||
|
switch ($type)
|
||||||
|
{
|
||||||
|
case EVENT_CONFIRM
|
||||||
|
{
|
||||||
|
return
|
||||||
|
}
|
||||||
|
case EVENT_UNKNOWN
|
||||||
|
{
|
||||||
|
die "unknown event '", $event, "'\n"
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
die "invalid response type\n"
|
||||||
|
}
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub streamed_request {
|
||||||
|
my ($self, $command, $event, $data) = @_;
|
||||||
|
$self->register($event);
|
||||||
|
|
||||||
|
my $request = pack('CC/a*a*', CMD_REQUEST, $command, $data);
|
||||||
|
$self->{'Transport'}->send($request);
|
||||||
|
my $more = 1;
|
||||||
|
my $msg = "";
|
||||||
|
|
||||||
|
while ($more)
|
||||||
|
{
|
||||||
|
my $response = $self->{'Transport'}->receive();
|
||||||
|
my ($type, $data) = unpack('Ca*', $response);
|
||||||
|
|
||||||
|
switch ($type)
|
||||||
|
{
|
||||||
|
case EVENT
|
||||||
|
{
|
||||||
|
(my $event_name, $data) = unpack('C/a*a*', $data);
|
||||||
|
if ($event_name == $event)
|
||||||
|
{
|
||||||
|
$msg .= $data;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
case CMD_RESPONSE
|
||||||
|
{
|
||||||
|
$self->unregister($event);
|
||||||
|
$more = 0;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
$self->unregister($event);
|
||||||
|
die "invalid response type\n";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $msg;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,126 @@
|
||||||
|
package Vici::Session;
|
||||||
|
|
||||||
|
require Exporter;
|
||||||
|
|
||||||
|
our @ISA = qw(Exporter);
|
||||||
|
our @EXPORT = qw(new, version, stats, reload_settings, initiate, list_sas,
|
||||||
|
list_policies, list_conns, get_conns, list_certs,
|
||||||
|
list_authorities, get_authorities, get_pools);
|
||||||
|
our @VERSION = 0.9;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use Vici::Packet;
|
||||||
|
use Vici::Message;
|
||||||
|
|
||||||
|
sub new {
|
||||||
|
my $class = shift;
|
||||||
|
my $socket = shift;
|
||||||
|
my $self = {
|
||||||
|
Packet => Vici::Packet->new($socket),
|
||||||
|
};
|
||||||
|
bless($self, $class);
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub version {
|
||||||
|
my $self = shift;
|
||||||
|
my $data = $self->{'Packet'}->request('version');
|
||||||
|
return Vici::Message->from_data($data);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub stats {
|
||||||
|
my $self = shift;
|
||||||
|
my $data = $self->{'Packet'}->request('stats');
|
||||||
|
return Vici::Message->from_data($data);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub reload_settings {
|
||||||
|
my $self = shift;
|
||||||
|
my $data = $self->{'Packet'}->request('reload-settings');
|
||||||
|
my $msg = Vici::Message->from_data($data);
|
||||||
|
my $res = $msg->hash();
|
||||||
|
return $res->{'success'} == 'yes';
|
||||||
|
}
|
||||||
|
|
||||||
|
sub initiate {
|
||||||
|
my ($self, $msg) = @_;
|
||||||
|
my $vars = '';
|
||||||
|
if (defined $msg)
|
||||||
|
{
|
||||||
|
$vars = $msg->encode();
|
||||||
|
}
|
||||||
|
my $data = $self->{'Packet'}->request('initiate', $vars);
|
||||||
|
my $msg = Vici::Message->from_data($data);
|
||||||
|
my $res = $msg->hash();
|
||||||
|
return $res->{'success'} == 'yes';
|
||||||
|
}
|
||||||
|
|
||||||
|
sub list_sas {
|
||||||
|
my ($self, $msg) = @_;
|
||||||
|
my $vars = '';
|
||||||
|
if (defined $msg)
|
||||||
|
{
|
||||||
|
$vars = $msg->encode();
|
||||||
|
}
|
||||||
|
my $data = $self->{'Packet'}->streamed_request('list-sas',
|
||||||
|
'list-sa', $vars);
|
||||||
|
return Vici::Message->from_data($data);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub list_policies {
|
||||||
|
my $self = shift;
|
||||||
|
my $data = $self->{'Packet'}->streamed_request('list-policies',
|
||||||
|
'list-policy');
|
||||||
|
return Vici::Message->from_data($data);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub list_conns {
|
||||||
|
my ($self, $msg) = @_;
|
||||||
|
my $vars = '';
|
||||||
|
if (defined $msg)
|
||||||
|
{
|
||||||
|
$vars = $msg->encode();
|
||||||
|
}
|
||||||
|
my $data = $self->{'Packet'}->streamed_request('list-conns',
|
||||||
|
'list-conn', $vars);
|
||||||
|
return Vici::Message->from_data($data);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_conns {
|
||||||
|
my $self = shift;
|
||||||
|
my $data = $self->{'Packet'}->request('get-conns');
|
||||||
|
return Vici::Message->from_data($data);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub list_certs {
|
||||||
|
my ($self, $msg) = @_;
|
||||||
|
my $vars = '';
|
||||||
|
if (defined $msg)
|
||||||
|
{
|
||||||
|
$vars = $msg->encode();
|
||||||
|
}
|
||||||
|
my $data = $self->{'Packet'}->streamed_request('list-authorities',
|
||||||
|
'list-authority', $vars);
|
||||||
|
return Vici::Message->from_data($data);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub list_authorities {
|
||||||
|
my $self = shift;
|
||||||
|
my $data = $self->{'Packet'}->streamed_request('list-authorities',
|
||||||
|
'list-authority');
|
||||||
|
return Vici::Message->from_data($data);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_authorities {
|
||||||
|
my $self = shift;
|
||||||
|
my $data = $self->{'Packet'}->request('get-authorities');
|
||||||
|
return Vici::Message->from_data($data);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_pools {
|
||||||
|
my $self = shift;
|
||||||
|
my $data = $self->{'Packet'}->request('get-pools');
|
||||||
|
return Vici::Message->from_data($data);
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
|
@ -0,0 +1,39 @@
|
||||||
|
package Vici::Transport;
|
||||||
|
|
||||||
|
require Exporter;
|
||||||
|
|
||||||
|
our @ISA = qw(Exporter);
|
||||||
|
our @EXPORT = qw(new, send, receive);
|
||||||
|
our @VERSION = 0.9;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
|
||||||
|
sub new {
|
||||||
|
my $class = shift;
|
||||||
|
my $self = {
|
||||||
|
Socket => shift,
|
||||||
|
};
|
||||||
|
bless($self, $class);
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub send {
|
||||||
|
my ($self, $data) = @_;
|
||||||
|
my $packet = pack('N/a*', $data);
|
||||||
|
$self->{'Socket'}->send($packet);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub receive {
|
||||||
|
my $self = shift;
|
||||||
|
my $packet_header;
|
||||||
|
my $data;
|
||||||
|
|
||||||
|
$self->{'Socket'}->recv($packet_header, 4);
|
||||||
|
my $packet_len = unpack('N', $packet_header);
|
||||||
|
$self->{'Socket'}->recv($data, $packet_len);
|
||||||
|
return $data;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue