view release on metacpan or  search on metacpan

lib/Agent/TCLI/Package/Net/HTTPD.pm  view on Meta::CPAN

=item NA404

This POE Event handler is used as a target event for URIs. It will
send an HTTP response code of 404 with an error message.
It will log the conenction if logging is turned on.

=cut

sub NA404 {
	# ARG0 = HTTP::Request object, ARG1 = HTTP::Response object,
	# ARG2 = the DIR that matched
	my ($kernel, $self, $request, $response, $dirmatch ) =
	  @_[KERNEL, OBJECT, ARG0 .. ARG2 ];

	my $port = $response->connection->local_port;

	# Check for errors
	if ( ! defined $request ) {
		$_[KERNEL]->post( 'HTTPD'.$port, 'DONE', $response );
		return;
	}

	# Do our stuff to HTTP::Response
	$response->code( 404 );
	$response->content( "Hi visitor from " . $response->connection->remote_ip.
		", Page not found -> '" . $request->uri->path . "'" );

	$kernel->call($self->name => 'Log' => $request, $response ) if $self->logging;

	$kernel->post('HTTPD'.$port, 'DONE', $response );
}

=item Log

This POE Event handler is used internally to provide the logging. It sends
the time, remote ip:port, local ip:port, uri and optionally the SSL cipher
to the Tail session.

=back

=cut

sub Log {
	my ($kernel,  $self, $request, $response) =
	  @_[KERNEL, OBJECT, ARG0    , ARG1];

	$self->Verbose("Log: request(".$request->uri);
	my $port = $response->connection->local_port;

	my $log;
	# If the request was malformed, $request = undef
	if ( $request )
	{
		 $log = join (' ',
		 		time(),
		 		$response->connection->remote_ip.':'.$response->connection->remote_port,
		 		$response->connection->local_ip.':'.$port,
		 		$response->code,
		 		$request->uri,
		 		$response->connection->ssl ? $response->connection->sslcipher : '',
		 	)."\n";
	}
	else
	{
		 $log = join (' ',
		 		time(),
		 		$response->connection->remote_ip.':'.$response->connection->remote_port,
		 		$response->connection->local_ip.':'.$port,
		 		$response->code,
				'Bad request',
		 		$response->connection->ssl ? $response->connection->sslcipher : '',
			)."\n";
	}

	# In the future we'll need to resolve port to control to send to correct tail
	my $control = $self->GetWheelKey( $port, 'control');

	$kernel->post('tcli_tail', 'Append', $log );
	return;
}

1;
#__END__

=head3 INHERITED METHODS

This module is an Object::InsideOut object that inherits from Agent::TCLI::Package::Base. It
inherits methods from both. Please refer to their documentation for more
details.

=head1 AUTHOR

Eric Hacker	 E<lt>hacker at cpan.orgE<gt>

=head1 BUGS

One cannot add uri's while a HTTPD server is running.

SHOULDS and MUSTS are currently not enforced.

Test scripts not thorough enough.

Probably many others.

=head1 LICENSE

Copyright (c) 2007, Alcatel Lucent, All rights resevred.

This package is free software; you may redistribute it
and/or modify it under the same terms as Perl itself.

=cut