httpb.pm

Punjab is a jabber XMLRPC/SOAP/REST client. It is a xmlrpc, soap, or REST server that allows for p

package PunJab::Server::HTTPB;
use strict;
use warnings;

use POE;
use POE::Filter::XML;
use POE::Filter::XML::Node;
use POE::Filter::XML::NS qw/ :JABBER :IQ /;
use POE::Filter::XML::Utils;
use POE::Filter::Stream;

use HTTP::Status;
use HTTP::Request;
use HTTP::Response;

use PunJab::Util;
use PunJab::Session;
use PunJab::Server::HTTP;
use PunJab::Filter::HTTPB;

use POSIX qw(strftime);
use Digest::SHA1;
use Digest::MD5 qw(md5 md5_hex md5_base64);
use Data::Uniqid qw ( suniqid uniqid luniqid );
use URI::QueryParam;

my $httpb_session;

sub new {
    shift;
    my $config   = shift;
    my $session  = shift;
    my $input    = shift;
    my $output   = shift;

    $output      = 'output' if not defined $output;
    $input       = 'input' if not defined $input;
    $httpb_session = $session;
    PunJab::Server::HTTP->new($config,\&handler,\&streamer,\&b_error,'http_bind_server','PunJab::Filter::HTTPB');

    POE::Session->create
	( inline_states =>
	  { _start => sub {
	      my ($kernel,$heap) = @_[KERNEL, HEAP];
	      $heap->{'callback_session'} = $session;
	      $heap->{'input'} = $input;
	      $heap->{'output'} = $output; # this may need to change

	      if ($config->{debug}>0) {
		  &debug("HTTP Binding Server Started\n");
	      }
	      $kernel->alias_set($session."_server");

	  },
	    _stop => sub {
		$_[KERNEL]->alias_remove($_[HEAP]->{'callback_session'}."_server");
	    },
	    input  => \&input,
	    output => \&output,
	    
         },
	  heap => { CONFIG => $config },
	  options => { debug => $config->{'debug'}, trace => $config->{'debug'} }
	  );

    
    return undef;

}

sub output()
{
    my ($kernel , $heap, $id, $code, $content) = 
	@_[KERNEL, HEAP, ARG0 .. ARG2];


    &debug("HTTPB SERVER OUTPUT : \n". $id. "\n".$content);
    
    my $response = HTTP::Response->new();
    my ($params,$sender);
    $response->code($code);
    $response->header("Content-Type", "text/xml");
    $response->header("Content-Length", length($content));
    $response->content($content);
    my $pb = $sender->postback( 'send_response', $response);
    $pb->($response);
    return;
}

sub input()
{
    my ($kernel , $heap, $sender, $request, $remote_ip) = 
	@_[KERNEL, HEAP, ARG0 .. ARG1];

    $heap->{'stream_count'} = 0;
    my $event_id = $heap->{'event_id'}++;

    $heap->{'events'}->{$event_id}->{'query_string'} = $request->uri->query();
    $heap->{'events'}->{$event_id}->{'method'}   = $request->method();

    $heap->{'events'}->{$event_id}->{'content_type'}   = $request->header('Content-Type');
    $heap->{'events'}->{$event_id}->{'content_length'} = $request->header('Content-Length');
    $heap->{'events'}->{$event_id}->{'debug_request'}  = $request->header('DebugRequest');
    $heap->{'events'}->{$event_id}->{'request_content'}= $request->content();
    $heap->{'events'}->{$event_id}->{'remote_ip'} = $remote_ip;
    $heap->{'events'}->{$event_id}->{'sender'} = $sender;
    my $body = delete $request->{'node'};
    
    if ($body->name ne "body") {
	$kernel->yield('output',500,$event_id,"Missing the body element!");
	return;
    } else {
	$kernel->post($heap->{'callback_session'},
		      $heap->{'input'}
		      ,$body, $event_id);
	return;
    }
}


sub b_error()
{
     my ($kernel, $heap, $sender, $syscall_name, $error_number, $error_string) = 
	 @_[KERNEL, HEAP, SENDER, ARG0 .. ARG2];
     my $params;
     # when client dies we need to kill the stream event
     
     &debug($syscall_name);
     &debug($error_number);
     &debug($error_string);
}

sub streamer()
{
     my ($kernel, $heap, $sender) = @_[KERNEL, HEAP, SENDER];
     my $params;
     
     

}

sub handler()
{
    my ($kernel,$heap,$sender,$request) = @_[KERNEL, HEAP, SENDER, ARG0];
    if($request->isa('HTTP::Response'))
    {
         _request_failed( $request,
                          403,
                          "Bad Request",
                          "This was a response?",
                          $sender
                          );
         return;
     }
    my $response = HTTP::Response->new();
    
    $kernel->post($httpb_session."_server",'input',$sender,$request,$heap->{'remote_ip'});
    

    return;
}


sub _request_failed()
 {
  my ($response, $fault_code, $fault_string, $result_description,$sender) = @_;
  my $stream = 1;
  my $response_content = qq{<body type='terminate'
      condition='internal-server-error'
      xmlns='http://jabber.org/protocol/httpbind'>
$fault_string
$result_description
</body>};
  $response->code($fault_code);
  $response->header("Content-Type", "text/xml");
  $response->header("Content-Length", length($response_content));
  $response->content($response_content);
  my $pb = $sender->postback( 'send_response', $response,$stream);
  $pb->($response,$stream);

}


1;

__END__