| Subject: | RPC::XML goes into deep recursion with cyclic references |
When passed a cyclic data structure RPC::XML::(struct|array)::new will
go into deep recursion with RPC::XML::smart_encode() which consequently
will eat up all memory.
Cyclic data structures are rather common - E.g. every DBIx::Class
related object instance includes them.
Pseudo Code to reproduce the problem:
my $rs = $db->resultset('Some::Schema');
my $search_result = $rs->search({
amount => { '<', $value },
})->first();
# $search_result will hold cyclic references and the process will
# start to eat up all cpu and mem resources...
my $type = RPC::XML::struct->new($search_result);
Potential approaches to fix this:
* Check for cyclic references in the data structures passed
* Allow to specify and enforce a maximum recursion limit
* Deny to handle any blessed references (object instances)
The following version of the RPC::XML::struct constructor checks for
cyclic references in the data passed.
my %cyclic;
my %seen_cyclic;
sub RPC::XML::struct::new {
my $class = shift;
my %args;
if ( UNIVERSAL::isa($_[0], 'HASH') ) {
# this is slooowww....
# find_weakened_cycle should only be called at the first level of
# recursion. for that, RPC::XML::smart_encode would need to pass
# an additional flag to RPC::XML::struct::new....
Devel::Cycle::find_weakened_cycle($_[0], \&callback );
%args = %{$_[0]};
}
else {
# struct::new should only get hashes from
RPC::XML::smart_encode(), so...
%args = @_;
}
# First ensure that each argument passed in is itself one of the
data-type
# class instances.
for (keys %args) {
if ( UNIVERSAL::isa($args{$_}, 'CODE') ) {
# Remove CODE refs as we won't be able to stringify them
delete $args{$_};
}
# Check if we are dealing with a cyclic reference and if yes,
# make sure it will only be handled once
elsif ( exists $cyclic{$args{$_}} and not exists
$seen_cyclic{$args{$_}} ) {
$seen_cyclic{$args{$_}} = 1;
$args{$_} = RPC::XML::smart_encode($args{$_})
unless (UNIVERSAL::isa($args{$_},
'RPC::XML::datatype'));
}
elsif ( not exists $seen_cyclic{$args{$_}} ) {
$args{$_} = RPC::XML::smart_encode($args{$_})
unless (UNIVERSAL::isa($args{$_},
'RPC::XML::datatype'));
}
else {
delete $args{$_};
}
}
bless \%args, $class;
}
sub callback {
my $data = shift;
foreach my $item ( @$data ) {
$cyclic{$item->[2]} = 1 unless exists $cyclic{$item->[2]};
}
}