| Date: | Sat, 17 Apr 2004 19:22:36 -0400 |
| From: | Apocalypse <apocalypse [...] 0ne.us> |
| To: | "POE" <bug-POE [...] rt.cpan.org> |
| Subject: | HTTP::Request object is leaking, but I don't know where it is |
I hope somebody can track this down...
Just modify the PORT/IP subroutines then run it, and fire up a
webbrowser against it for 2 times, then shut it down via ctrl+C
You'll see that the HTTP::Request object created in the first connection
is still around, but I don't know what is holding a reference to it :X
--
Apocalypse
Homepage: http://JiNxEdStAr.0ne.us
IRC: Apocalypse@irc.perl.org
IRC: Apocal@EFnet
CPAN ID: APOCAL
#!/usr/bin/perl
# Set Port + IP
sub SimpleHTTP2::PORT () { 12345 }
sub SimpleHTTP2::IP () { '192.168.1.123' }
# Start the server!
SimpleHTTP2->new() or die 'Unable to create the HTTP Server';
# Start POE!
POE::Kernel->run();
# Declare our package
package SimpleHTTP2;
# Standard stuff to catch errors
use strict qw(subs vars refs); # Make sure we can't mess up
use warnings FATAL => 'all'; # Enable warnings to catch errors
# Initialize our version
our $VERSION = '1.05';
# Import what we need from the POE namespace
use POE; # For the constants
use POE::Session; # To create our own :)
# POE modules to handle the connection
use POE::Wheel::SocketFactory;
use POE::Wheel::ReadWrite;
use POE::Driver::SysRW;
use POE::Filter::HTTPD;
# HTTP-related modules
use HTTP::Date;
use HTTP::Response;
use Devel::Peek;
use Scalar::Util;
use Data::Dumper;
my $weakref = undef;
# Set some constants
BEGIN {
# Debug fun!
if ( ! defined &DEBUG ) {
eval "sub DEBUG () { 0 }";
}
# Our own definition of the max retries
if ( ! defined &MAX_RETRIES ) {
eval "sub MAX_RETRIES () { 5 }";
}
}
# Set things in motion!
sub new {
# Create a new session for ourself
POE::Session->create(
# Our subroutines
'inline_states' => {
# Maintenance events
'_start' => \&StartServer,
'_stop' => \&StopServer,
'_child' => sub {},
'SetupWheel' => \&SetupWheel,
# Wheel::ReadWrite stuff
'Got_Connection' => \&Got_Connection,
'Got_Input' => \&Got_Input,
'Got_Flush' => \&Got_Flush,
'Got_Error' => \&Got_Error,
'Got_ServerError' => \&Got_ServerError,
},
# Set up the heap for ourself
'heap' => {
'WHEELS' => {},
'SOCKETFACTORY' => undef,
'Retries' => 0,
},
) or die 'Unable to create a new session!';
# Return success
return 1;
}
# Starts the server!
sub StartServer {
# Debug stuff
if ( DEBUG ) {
warn 'Starting up SimpleHTTP now';
}
# Register an alias for ourself
$_[KERNEL]->alias_set( 'SimpleHTTP' );
# Setup the wheel
$_[KERNEL]->yield( 'SetupWheel' );
# All done!
return 1;
}
# Sets up the wheel :)
sub SetupWheel {
# Debug stuff
if ( DEBUG ) {
warn 'Creating SocketFactory wheel now';
}
# Check if we should set up the wheel
if ( $_[HEAP]->{'Retries'} == MAX_RETRIES ) {
die 'POE::Component::Server::SimpleHTTP tried ' . MAX_RETRIES . ' times to create a Wheel and is giving up...';
} else {
# Increment the retries count
$_[HEAP]->{'Retries'}++;
# Create our own SocketFactory :)
$_[HEAP]->{'SOCKETFACTORY'} = POE::Wheel::SocketFactory->new(
'BindPort' => PORT,
'BindAddress' => IP,
'Reuse' => 'yes',
'SuccessEvent' => 'Got_Connection',
'FailureEvent' => 'Got_ServerError',
);
}
}
# Stops the server!
sub StopServer {
# Shutdown the SocketFactory wheel
delete $_[HEAP]->{'SOCKETFACTORY'};
# Forcibly close all sockets that are open
foreach my $conn ( values %{ $_[HEAP]->{'WHEELS'} } ) {
$conn->[0]->shutdown_input;
$conn->[0]->shutdown_output;
}
# Delete our alias
$_[KERNEL]->alias_remove( 'SimpleHTTP' );
# Remove all connections
delete $_[HEAP]->{'WHEELS'};
# Debug stuff
if ( DEBUG ) {
warn 'Successfully stopped SimpleHTTP';
}
if ( defined $weakref ) {
if ( Scalar::Util::isweak( $weakref ) ) {
print "Weakref is really a weakref!\n"
} else {
print "Weakref is NOT a weakref!\n";
}
print "Devel::Peek::Dump weakref!\n";
print Devel::Peek::Dump( $weakref );
print "Data::Dumper::Dumper weakref!\n";
print Data::Dumper::Dumper( $weakref );
} else {
print "Weakref is undef!\n";
}
# Return success
return 1;
}
# The actual manager of connections
sub Got_Connection {
# ARG0 = Socket, ARG1 = Remote Address, ARG2 = Remote Port
my $socket = $_[ ARG0 ];
# Set up the Wheel to read from the socket
my $wheel = POE::Wheel::ReadWrite->new(
'Handle' => $socket,
'Driver' => POE::Driver::SysRW->new(),
'Filter' => POE::Filter::HTTPD->new(),
'InputEvent' => 'Got_Input',
'FlushedEvent' => 'Got_Flush',
'ErrorEvent' => 'Got_Error',
);
# Save this wheel!
# 0 = wheel, 1 = Output done?
$_[HEAP]->{'WHEELS'}->{ $wheel->ID } = [ $wheel, 0 ];
# Debug stuff
if ( DEBUG ) {
warn "Got_Connection completed creation of ReadWrite wheel ( " . $wheel->ID . " )";
}
}
# Finally got input, set some stuff and send away!
sub Got_Input {
# ARG0 = HTTP::Request object, ARG1 = Wheel ID
my $id = $_[ ARG1 ];
# Make a response
my $response = HTTP::Response->new();
$response->code( 200 );
$response->content( 'foo' );
if ( ! defined $weakref ) {
print "Making weakref!\n";
$weakref = $_[ARG0];
Scalar::Util::weaken( $weakref );
} else {
print "WeakRef still around!\n";
}
$response->header( 'Date', time2str( time ) );
$response->header( 'Content-Length', length( $response->content ) );
$response->header( 'Content-Type', 'text/html' );
$_[HEAP]->{'WHEELS'}->{ $id }->[0]->put( $response );
# Mark this socket done
$_[HEAP]->{'WHEELS'}->{ $id }->[1] = 1;
}
# Finished with a wheel!
sub Got_Flush {
# ARG0 = wheel ID
my $id = $_[ ARG0 ];
# Check if we are shutting down
if ( $_[HEAP]->{'WHEELS'}->{ $id }->[1] ) {
# Shutdown read/write on the wheel
$_[HEAP]->{'WHEELS'}->{ $id }->[0]->shutdown_input();
$_[HEAP]->{'WHEELS'}->{ $id }->[0]->shutdown_output();
# Delete the wheel
delete $_[HEAP]->{'WHEELS'}->{ $id };
} else {
# Ignore this, eh?
if ( DEBUG ) {
warn "Got Flush event for socket ( $id ) when did not send anything!";
}
}
}
# Got some sort of error from ReadWrite
sub Got_Error {
# ARG0 = operation, ARG1 = error number, ARG2 = error string, ARG3 = wheel ID
my ( $operation, $errnum, $errstr, $wheel_id ) = @_[ ARG0 .. ARG3 ];
# Debug stuff
warn "Wheel $wheel_id generated $operation error $errnum: $errstr\n";
# Delete this connection
delete $_[HEAP]->{'WHEELS'}->{ $wheel_id };
}
# Got some sort of error from SocketFactory
sub Got_ServerError {
# ARG0 = operation, ARG1 = error number, ARG2 = error string, ARG3 = wheel ID
my ( $operation, $errnum, $errstr, $wheel_id ) = @_[ ARG0 .. ARG3 ];
# Debug stuff
warn "SocketFactory Wheel $wheel_id generated $operation error $errnum: $errstr\n";
# Setup the SocketFactory wheel
$_[KERNEL]->call( $_[SESSION], 'SetupWheel' );
}
# End of module
1;