SOAP Daemon memory leak

[email protected] ("Mike Gent") Tue, 21 Aug 2007 15:10:28 -0500
Newsgroups perl.ithreads
Message-ID <[email protected]>
I have an application that runs as a stand-alone daemon returning SOAP
results. It's been running fine for a long time, but I recently noticed
the memory growing and not being released after every connection.

I've created a custom module based on the code of
SOAP::Transport::HTTP::Daemon, but supporting spawning threads when a
connection is accepted.

Running ActivePerl 5.8.8.822 with threads 1.6.3 and threads::shared 1.12
under CentOS Linux.

Here's a sample application that can be used to reproduce the problem.

SOAPServer.pl:
--------------
#!perl

use strict;
use threads ('stack_size' => 32*4096, 'exit' => 'threads_only');
use SOAPDaemon;

sub Start {
	my $SOAPServerThread = threads->new(sub {
		my $SOAPServer = SOAPDaemon->new(
			LocalPort       => 10000,
			ReuseAddr       => 1
		)->dispatch_to('main');
		
		$SOAPServer->Handle;
	});
}

sub Ping {
	my $Self = shift;
	
	return {Valid => 1, Output => 'Pong'};
}

Start();

while(1) {
	sleep(1);
}

SOAPDaemon.pm:
--------------
#!perl
package SOAPDaemon;

# Custom package derived from SOAP::Transport::HTTP::Daemon

use Data::Dumper;
use Carp ();
use HTTP::Daemon;
use SOAP::Transport::HTTP;

use vars qw($AUTOLOAD @ISA);
@ISA = qw(SOAP::Transport::HTTP::Server);

sub DESTROY { SOAP::Trace::objects('()') }

sub new {
	my $self = shift;
	
	unless (ref $self) {
		my $class = ref($self) || $self;
		
		my(@params, @methods);
		while (@_) { $class->can($_[0]) ? push(@methods, shift()
=> shift) : push(@params, shift) }
		$self = $class->SUPER::new;
		
		$self->{_daemon} = HTTP::Daemon->new(@params) or
Carp::croak "Can't create daemon: $!";
		
	
$self->myuri(URI->new($self->url)->canonical->as_string);
		while (@methods) {
			my($method, $params) = splice(@methods,0,2);
			$self->$method(ref $params eq 'ARRAY' ? @$params
: $params) 
		}
		SOAP::Trace::objects('()');
	}
	
	return $self;
}

sub AUTOLOAD {
	my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
	return if $method eq 'DESTROY';
	
	no strict 'refs';
	*$AUTOLOAD = sub { shift->{_daemon}->$method(@_) };
	goto &$AUTOLOAD;
}

sub Handle {
	my $self = shift->new;
	
	while (my $c = $self->accept) {
		threads->new(\&SOAPWorker, $self, $c);
	}
}

sub SOAPWorker {
	my $Obj = shift;
	my $c   = shift;
	
	while (my $r = $c->get_request(0)) {
		$Obj->request($r);
		$Obj->SUPER::handle;
		$c->send_response($Obj->response);
	}
	
	# replaced ->close, thanks to Sean Meisner
<[email protected]>
	# shutdown() doesn't work on AIX. close() is used in this case.
Thanks to Jos Clijmans <[email protected]>
	UNIVERSAL::isa($c, 'shutdown') ? $c->shutdown(2) : $c->close(); 
	$c->close;
	
	threads->self()->detach();
}

# Always end package with true
1;

__END__