view release on metacpan or  search on metacpan

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

  usage: httpd set hostname=example.com
---
Agent::TCLI::Command:
  name: show
  call_style: session
  command: tcli_httpd
  contexts:
    httpd: show
  handler: show
  help: show tail default settings and state
  parameters:
    logging:
    address:
    port:
    hostname:
    regex:
    response:
    handlers:
    ports:
  topic: testing
  usage: httpd show settings
...

}

sub _start {
	my ($kernel,  $self,  $session) =
      @_[KERNEL, OBJECT,   SESSION];
	$self->Verbose("_start: tcli httpd starting");

	# are we up before OIO has finished initializing object?
	if (!defined( $self->name ))
	{
		$kernel->yield('_start');
		return;
	}

	# There is only one command object per TCLI
    $kernel->alias_set($self->name);

	$self->handlers( [
			{
				'DIR'		=>	'.*',
				'SESSION'	=>	$self->name,
				'EVENT'		=>	'NA404',
			},
	] ) unless defined($self->handlers);

	$self->Verbose("_start Dump ".$self->dump(1),3);

}

sub _shutdown :Cumulative {
    my ($kernel,  $self, $session) =
      @_[KERNEL, OBJECT,  SESSION];
	$self->Verbose($self->name.':_shutdown:');

	foreach my $port ( keys %{ $self->ports } )
	{
		$self->Verbose("_shutdown: $port");
		$kernel->post( 'HTTPD'.$port  , 'SHUTDOWN' );
	}
	return ('_shutdown '.$self->name )
}

sub _stop {
    my ($kernel,  $self,) =
      @_[KERNEL, OBJECT,];
	$self->Verbose("_stop: ".$self->name." stopping",2);
}

=item spawn

This POE event handler executes the spawn command to start a new HTTPD listener.

=cut

sub spawn {
    my ($kernel,  $self, $sender, $request, ) =
      @_[KERNEL, OBJECT,  SENDER,     ARG0, ];

	my $txt = '';
	my $param;
	my $command = $request->command->[0];
	my $cmd = $self->commands->{$command};

	return unless ( $param = $cmd->Validate($kernel, $request, $self) );

	$self->Verbose("spawn: param dump",4,$param);

	# is one running already?
	if (exists( $self->ports->{ $param->{'port'} } ))
	{
		$self->Verbose("spawn: ".$param->{'port'}." already running");
		$request->Respond($kernel,"HTTPD server on port ".
			$param->{'port'}." already running",400);
		return;
	}

	# Start the server!
	$self->ports->{ $param->{'port'} } =
		POE::Component::Server::SimpleHTTP->new(
		'ALIAS'		=>	'HTTPD'.$param->{'port'},
		'ADDRESS'	=>	defined($param->{'address'})
			? $param->{'address'}
			: $sender->get_heap->local_address,
		'PORT'		=>	$param->{'port'},
		'HOSTNAME'	=>	defined($param->{'hostname'})
			? $param->{'hostname'}
			: '',
		'HANDLERS'	=>	$self->handlers,

#		'LOGHANDLER' => {
#				'SESSION' => $self->name,
#				'EVENT'   => 'Log',
#		},

		# In the testing phase...
#		'SSLKEYCERT'	=>	[ 'public-key.pem', 'public-cert.pem' ],
	);

	unless (defined( $self->ports->{ $param->{'port'} } ) )
	{
		 $request->Respond($kernel,'Unable to create the HTTPD Server',400);
		 return;
	}

	# store the $sender for later use.
	$self->SetWheelKey($param->{'port'}, 'control' => $sender );

	$request->Respond($kernel,'HTTPD Started on port '.$param->{'port'},200);
}

=item stop

This POE Event handler executes the stop command to shutdown a HTTPD listener.

=cut

sub stop {
    my ($kernel,  $self, $sender, $request, ) =
      @_[KERNEL, OBJECT,  SENDER,     ARG0, ];

	my $txt = '';
	my $param;
	my $command = $request->command->[0];
	my $cmd = $self->commands->{$command};

	return unless ( $param = $cmd->Validate($kernel, $request, $self) );

	$self->Verbose("spawn: param dump",4,$param);

	unless (defined( $self->ports->{ $param->{'port'} } ) )
	{
		 $request->Respond($kernel,'Unable to locate the HTTPD Server',404);
		 return;
	}

	$kernel->post( 'HTTPD'.$param->{'port'}  , 'SHUTDOWN' );

	# remove the stored control for this server
	$self->SetWheelKey( $param->{'port'} , 'control' );

	delete( $self->ports->{ $param->{'port'} } );

	$request->Respond($kernel,'HTTPD Stopped on port '.$param->{'port'},200);
}

=item uri

This POE Event handler excecutes the uri add and uri delete commands.

=cut

sub uri {
    my ($kernel,  $self, $sender, $request, ) =
      @_[KERNEL, OBJECT,  SENDER,     ARG0, ];

	my $txt = '';
	my $code;
	my $param;
	my $command = $request->command->[0];
	my $cmd = $self->commands->{'uri_'.$command};

	return unless ( $param = $cmd->Validate($kernel, $request, $self) );

	if ( $command eq 'add' )
	{
		my $last = $self->pop_handlers;
		$self->push_handlers(
			{
				'DIR'		=>	$param->{'regex'},
				'SESSION'	=>	$self->name,
				'EVENT'		=>	$param->{'response'},
			},
			$last
		);
		$txt = 'uri added';
		$code = 200;
	}
	elsif ( $command eq 'delete' )
	{
		my $i = 0;
		$txt = "regex not found, delete failed";
		$code = 404;
		# This will loop over the handlers and removel ALL matches.
		foreach my $handler ( @{$self->handlers} )
		{
			if ( $param->{'regex'} eq $handler->{'DIR'} &&
				$i != $self->depth_handlers ) # Don't remove last one, ever.
			{
				my $goner = splice( @{$self->handlers},$i,1 );
				$txt .= "regex ".$goner->{'DIR'}." with response ".
					$goner->{'EVENT'}." deleted \n";
				$code = 200;
			}
			$i++;
		}
	}

	$request->Respond($kernel,$txt,$code);
}

=item BeGone

This POE Event handler is used as a target event for URIs. It simply drops the
connection. It will log the conenction if logging is turned on.

=cut

sub BeGone {
	# 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;

	# Do our stuff to HTTP::Response
	$response->code( 0 );

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

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

=item OK200

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

=cut

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

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

	# Do our stuff to HTTP::Response
	$response->code( 200 );
	$response->content( 'OK' );

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

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

=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