Implement vici Perl binding
authorAndreas Steffen <andreas.steffen@strongswan.org>
Mon, 16 Nov 2015 19:08:30 +0000 (20:08 +0100)
committerAndreas Steffen <andreas.steffen@strongswan.org>
Tue, 1 Dec 2015 13:52:43 +0000 (14:52 +0100)
configure.ac
src/libcharon/plugins/vici/Makefile.am
src/libcharon/plugins/vici/perl/LICENSE [new file with mode: 0644]
src/libcharon/plugins/vici/perl/MANIFEST.in [new file with mode: 0644]
src/libcharon/plugins/vici/perl/Makefile.am [new file with mode: 0644]
src/libcharon/plugins/vici/perl/Vici/Message.pm [new file with mode: 0644]
src/libcharon/plugins/vici/perl/Vici/Packet.pm [new file with mode: 0644]
src/libcharon/plugins/vici/perl/Vici/Session.pm [new file with mode: 0644]
src/libcharon/plugins/vici/perl/Vici/Transport.pm [new file with mode: 0644]

index ea6bddb..c06a8cb 100644 (file)
@@ -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
index c99d23e..48e2f0c 100644 (file)
@@ -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 (file)
index 0000000..2e25c83
--- /dev/null
@@ -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 (file)
index 0000000..1aba38f
--- /dev/null
@@ -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 (file)
index 0000000..a160d9c
--- /dev/null
@@ -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 (file)
index 0000000..81cbbaa
--- /dev/null
@@ -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 (file)
index 0000000..4f731ec
--- /dev/null
@@ -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 (file)
index 0000000..c05a1a8
--- /dev/null
@@ -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 (file)
index 0000000..4444467
--- /dev/null
@@ -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;
+
+