From a101bce8624dd6315af0a12d4ff04d19c4b7f291 Mon Sep 17 00:00:00 2001 From: Andreas Steffen Date: Mon, 16 Nov 2015 20:08:30 +0100 Subject: [PATCH] Implement vici Perl binding --- configure.ac | 4 + src/libcharon/plugins/vici/Makefile.am | 4 + src/libcharon/plugins/vici/perl/LICENSE | 19 ++ src/libcharon/plugins/vici/perl/MANIFEST.in | 1 + src/libcharon/plugins/vici/perl/Makefile.am | 6 + .../plugins/vici/perl/Vici/Message.pm | 214 ++++++++++++++++++ .../plugins/vici/perl/Vici/Packet.pm | 150 ++++++++++++ .../plugins/vici/perl/Vici/Session.pm | 126 +++++++++++ .../plugins/vici/perl/Vici/Transport.pm | 39 ++++ 9 files changed, 563 insertions(+) create mode 100644 src/libcharon/plugins/vici/perl/LICENSE create mode 100644 src/libcharon/plugins/vici/perl/MANIFEST.in create mode 100644 src/libcharon/plugins/vici/perl/Makefile.am create mode 100644 src/libcharon/plugins/vici/perl/Vici/Message.pm create mode 100644 src/libcharon/plugins/vici/perl/Vici/Packet.pm create mode 100644 src/libcharon/plugins/vici/perl/Vici/Session.pm create mode 100644 src/libcharon/plugins/vici/perl/Vici/Transport.pm diff --git a/configure.ac b/configure.ac index ea6bddb7d..c06a8cb35 100644 --- a/configure.ac +++ b/configure.ac @@ -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([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.]) @@ -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_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) # ======================== @@ -1835,6 +1838,7 @@ AC_CONFIG_FILES([ 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 diff --git a/src/libcharon/plugins/vici/Makefile.am b/src/libcharon/plugins/vici/Makefile.am index c99d23e4e..48e2f0cea 100644 --- a/src/libcharon/plugins/vici/Makefile.am +++ b/src/libcharon/plugins/vici/Makefile.am @@ -79,3 +79,7 @@ endif if USE_PYTHON_EGGS SUBDIRS += python endif + +if USE_PERL_CPAN +SUBDIRS += perl +endif diff --git a/src/libcharon/plugins/vici/perl/LICENSE b/src/libcharon/plugins/vici/perl/LICENSE new file mode 100644 index 000000000..2e25c83ce --- /dev/null +++ b/src/libcharon/plugins/vici/perl/LICENSE @@ -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. diff --git a/src/libcharon/plugins/vici/perl/MANIFEST.in b/src/libcharon/plugins/vici/perl/MANIFEST.in new file mode 100644 index 000000000..1aba38f67 --- /dev/null +++ b/src/libcharon/plugins/vici/perl/MANIFEST.in @@ -0,0 +1 @@ +include LICENSE diff --git a/src/libcharon/plugins/vici/perl/Makefile.am b/src/libcharon/plugins/vici/perl/Makefile.am new file mode 100644 index 000000000..a160d9c9e --- /dev/null +++ b/src/libcharon/plugins/vici/perl/Makefile.am @@ -0,0 +1,6 @@ +EXTRA_DIST = LICENSE \ + Vici/Message.pm \ + Vici/Packet.pm \ + Vici/Session.pm \ + Vici/Transport.pm + diff --git a/src/libcharon/plugins/vici/perl/Vici/Message.pm b/src/libcharon/plugins/vici/perl/Vici/Message.pm new file mode 100644 index 000000000..81cbbaa17 --- /dev/null +++ b/src/libcharon/plugins/vici/perl/Vici/Message.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; + + diff --git a/src/libcharon/plugins/vici/perl/Vici/Packet.pm b/src/libcharon/plugins/vici/perl/Vici/Packet.pm new file mode 100644 index 000000000..4f731ecd9 --- /dev/null +++ b/src/libcharon/plugins/vici/perl/Vici/Packet.pm @@ -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; + + diff --git a/src/libcharon/plugins/vici/perl/Vici/Session.pm b/src/libcharon/plugins/vici/perl/Vici/Session.pm new file mode 100644 index 000000000..c05a1a819 --- /dev/null +++ b/src/libcharon/plugins/vici/perl/Vici/Session.pm @@ -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; diff --git a/src/libcharon/plugins/vici/perl/Vici/Transport.pm b/src/libcharon/plugins/vici/perl/Vici/Transport.pm new file mode 100644 index 000000000..444446790 --- /dev/null +++ b/src/libcharon/plugins/vici/perl/Vici/Transport.pm @@ -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; + +