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.
This commit is contained in:
Afschin Hormozdiary 2018-06-05 15:10:43 +02:00 committed by Tobias Brunner
parent 5100a3ed7d
commit d6aa6537e7
1 changed files with 27 additions and 16 deletions

View File

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