From: Afschin Hormozdiary <afschin.hormozdiary@sophos.com>
Date: Tue, 5 Jun 2018 13:10:43 +0000 (+0200)
Subject: vici: Improve message parsing performance in Perl bindings
X-Git-Tag: 5.7.0rc1~41
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=d6aa6537e7174a08cb3ac6efefcee2a74d540de8;p=thirdparty%2Fstrongswan.git

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 b0a942c04f..b777e25170 100644
--- 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;
 }