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-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
ARG_ENABL_SET([coverage], [enable lcov coverage report generation.])
ARG_ENABL_SET([leak-detective], [enable malloc hooks to find memory leaks.])
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_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)
# ========================
src/libcharon/plugins/stroke/Makefile
src/libcharon/plugins/vici/Makefile
src/libcharon/plugins/vici/ruby/Makefile
+ src/libcharon/plugins/vici/perl/Makefile
src/libcharon/plugins/vici/python/Makefile
src/libcharon/plugins/updown/Makefile
src/libcharon/plugins/dhcp/Makefile
if USE_PYTHON_EGGS
SUBDIRS += python
endif
+
+if USE_PERL_CPAN
+SUBDIRS += perl
+endif
--- /dev/null
+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.
--- /dev/null
+include LICENSE
--- /dev/null
+EXTRA_DIST = LICENSE \
+ Vici/Message.pm \
+ Vici/Packet.pm \
+ Vici/Session.pm \
+ Vici/Transport.pm
+
--- /dev/null
+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;
+
+
--- /dev/null
+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;
+
+
--- /dev/null
+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;
--- /dev/null
+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;
+
+
projects / people / ms / strongswan.git / commitdiff
