vici: Improve message parsing performance in Perl bindings

During a test with ~12000 established SAs it was noted that vici
related operations hung.
The operations took over 16 minutes to finish. The time was spent in
the vici message parser, which was assigning the message over and over
again, to get rid of the already parsed portions.

First fixed by cutting the consumed parts off without copying the message.
Runtime for ~12000 SAs is now around 20 seconds.

Further optimization brought the runtime down to roughly 1-2 seconds
by using an fd to read through the message variable.

Closes strongswan/strongswan#103.

diff --git a/src/libcharon/plugins/vici/perl/Vici-Session/lib/Vici/Message.pm b/src/libcharon/plugins/vici/perl/Vici-Session/lib/Vici/Message.pm
index b0a942c04f8a23282cb23f3e1ca7d71879ae97b8..b777e2517004b100814db26639dff0650c7ef3b0 100644 (file)
--- a/src/libcharon/plugins/vici/perl/Vici-Session/lib/Vici/Message.pm
+++ b/src/libcharon/plugins/vici/perl/Vici-Session/lib/Vici/Message.pm
@@ -29,7 +29,9 @@ sub from_data {
     my $data = shift;
     my %hash = ();
 
-    parse($data, \%hash);
+    open my $data_fd, '<', \$data;
+    parse($data_fd, \%hash);
+    close $data_fd;
 
     my $self = {
         Hash => \%hash
@@ -62,29 +64,35 @@ sub result {
 # private functions
 
 sub parse {
-    my $data = shift;
+    my $fd = shift;
     my $hash = shift;
+    my $data;
 
-    while (length($data) > 0)
+    until ( eof $fd )
     {
-        (my $type, $data) = unpack('Ca*', $data);
+        read $fd, $data, 1;
+        my $type = unpack('C', $data);
 
-               if ($type == SECTION_END)
-               {
-                       return $data;
-               }
+        if ( $type == SECTION_END )
+        {
+            return;
+        }
 
-        (my $key, $data) = unpack('C/a*a*', $data);
+        read $fd, $data, 1;
+        my $length = unpack('C', $data);
+        read $fd, my $key, $length;
 
         if ( $type == KEY_VALUE )
         {
-            (my $value, $data) = unpack('n/a*a*', $data);
+            read $fd, $data, 2;
+            my $length = unpack('n', $data);
+            read $fd, my $value, $length;
             $hash->{$key} = $value;
         }
         elsif ( $type == SECTION_START )
         {
             my %section = ();
-            $data = parse($data, \%section);
+            parse($fd, \%section);
             $hash->{$key} = \%section;
         }
         elsif ( $type == LIST_START )
@@ -92,19 +100,23 @@ sub parse {
             my @list = ();
             my $more = 1;
 
-            while (length($data) > 0 and $more)
+            while ( !eof($fd) and $more )
             {
-                (my $type, $data) = unpack('Ca*', $data);
+                read $fd, $data, 1;
+                my $type = unpack('C', $data);
+
                 if ( $type == LIST_ITEM )
                 {
-                    (my $value, $data) = unpack('n/a*a*', $data);
+                    read $fd, $data, 2;
+                    my $length = unpack('n', $data);
+                    read $fd, my $value, $length;
                     push(@list, $value);
                 }
                 elsif ( $type == LIST_END )
                 {
                     $more = 0;
                     $hash->{$key} = \@list;
-                 }
+                }
                 else
                 {
                     die "message parsing error: ", $type, "\n"
@@ -116,7 +128,6 @@ sub parse {
             die "message parsing error: ", $type, "\n"
         }
     }
-    return $data;
 }