From d6aa6537e7174a08cb3ac6efefcee2a74d540de8 Mon Sep 17 00:00:00 2001
From: Afschin Hormozdiary <afschin.hormozdiary@sophos.com>
Date: Tue, 5 Jun 2018 15:10:43 +0200
Subject: [PATCH] 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.
---
 .../perl/Vici-Session/lib/Vici/Message.pm     | 43 ++++++++++++-------
 1 file changed, 27 insertions(+), 16 deletions(-)

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;
 }