html.pm

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

package PunJab::Server::HTML;
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 PunJab;
use PunJab::Util;
use PunJab::Session;
use PunJab::Server::HTTP;

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;
use HTML::Template;
#use File::MimeInfo::Magic;
use File::Type;

my $html_config;


sub new {
    shift;
    my $config = shift;
    my $alias  = shift;
    $alias = "html" if not defined $alias;
    $html_config = $config; # why does POE::Component::TCP::Server not allow you to put stuff on the heap?
    PunJab::Server::HTTP->new($config,\&handler,\&streamer,\&html_error,'html_web_server');
    # All we do here is serve files!
    POE::Session->create
	( inline_states =>
	  { _start => sub {
	      my $kernel = $_[KERNEL];

	      if ($config->{debug}>0) {
		  &debug("HTML Server Session Started\n");
	      }
	      $kernel->alias_set($alias);
	      #$public_interfaces{$alias}{'file'} = 1;
	  },

         },
	  heap => { CONFIG => $config },
	  options => { debug => $config->{'debug'}, trace => $config->{'debug'} }
	  );
    
    return undef;

}


### Handlers for the html server. 
sub shutdown_service {
    # loop and delete all interfaces
    
    $_[KERNEL]->yield("shutdown");
}

sub html_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];

     if (defined $heap->{'buffer'}) {
	 $heap->{client}->set_output_filter( POE::Filter::Stream->new() );
	 if ($heap->{'buffer'} ne "") {
	     $heap->{'last_stream_count'} = $heap->{'stream_count'};
	 } 
	 &debug("stream count : last ($heap->{'last_stream_count'})  now ($heap->{'stream_count'}) \n\n");
	 if ($heap->{'stream_count'}==0) {
	     $heap->{'client'}->put("\n");
	     $heap->{'stream_count'}++;
	 }	 
	 $heap->{'client'}->put($heap->{'buffer'});
	 
	 $heap->{'buffer'} = "" if $heap->{'buffer'} ne "";
	 if ($heap->{'last_stream_count'} == $heap->{'stream_count'}) {	     
	     $heap->{'client'}->put("\n");
	     $heap->{'stream_count'}++;
	 }
	 
     }
    
}

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;
     }
    $heap->{'stream_count'} = 0;

    my $response = HTTP::Response->new();
    my $query_string = $request->uri->query();
    my $session                = "html_shell";
    my $http_method            = $request->method();
    my $request_content_type   = $request->header('Content-Type');
    my $request_content_length = $request->header('Content-Length');
    my $debug_request          = $request->header('DebugRequest');
    my $request_content        = $request->content();
    # need to parse this into hash similar to query
    my $uri_path;
    my @path       = split(/\//,$request->uri->path());
    shift @path;
    if (not defined $path[0]) {	
	$uri_path = $html_config->{'directory_index'};	
    } else {
	$uri_path = join('/',@path);
    }
    
    eval {
        HTMLTransaction->start($sender,
			       $request,
			       $response,
			       $session,
			       $http_method,
			       $uri_path,
			       $request_content);
    };
    
    if ($@) {
        _request_failed( $response,
                         500,
                         "Application Faulted",
                         "An exception fired while processing the request: $@",
                         $sender,
                         );
    }

    return;
}



sub _auth()
{
    my $html_transaction = shift;
    
    if (not defined $html_transaction->request()->authorization()) {
	# if it is a get do an http basic auth 	
	$html_transaction->auth("auth failed");	
	return;
    } 
    my ($jid,$pass) = $html_transaction->request()->authorization_basic();
    
    if (not defined $jid and not defined $pass) {
	$html_transaction->error("Error in authorization.");
	return +FALSE;
    }
    my ($username,$hostname,$resource) = &parse_jid($jid);

    ### Create the session
    # put this in a html header?
    my $id      = $html_transaction->request()->{remote_ip};

    my $shaobj  = new Digest::SHA1;
    $shaobj->add($jid.$pass.$resource.$id);
    my $sid = $shaobj->hexdigest();
    
    return $sid;
}

sub _return_request()
{

}

sub _request_failed()
 {
  my ($response, $fault_code, $fault_string, $result_description,$sender) = @_;
  # need to template this too
  my $response_content = qq{<html>
<body>
<b>$fault_code</b><br/>
<b>$fault_string</b><br/>
<b>$result_description</b><br/>
</body></html>};
  $response->code($fault_code);
  $response->header("Content-Type", "text/html");
  $response->header("Content-Length", length($response_content));
  $response->content($response_content);
  my $pb = $sender->postback( 'send_response', $response);
  $pb->($response);
}

package HTMLTransaction;
use URI::Split qw(uri_split uri_join);
use PunJab::Util;
use File::Basename;

sub TR_REQUEST  () { 0 }
sub TR_RESPONSE () { 1 }
sub TR_SESSION  () { 2 }
sub TR_METHOD   () { 3 }
sub TR_PATH     () { 4 }
sub TR_STDIN    () { 5 }
sub TR_PARAMS   () { 6 }
sub TR_CLIENT   () { 7 }

sub start {
  my ($type,$sender, $request, $response, $session,$method, $path, $stdin) = @_;

  my $params;
  my $client; 
  my $event;

  for my $key ($request->uri->query_param) {
      if ($key eq "event") {
	  $event = $request->uri->query_param($key);
	  next;
      }
      $params->{$key}= $request->uri->query_param($key);
  }

  $stdin =~ s/\x00//gi; # get rid of crap

  my $self = bless
      [ $request,
	$response,
	$session,
	$method,
	$path,
	$stdin,
	$params,
	$sender->postback( 'send_response', $response),
	], $type;
  # this will need to be changed
  if (not defined $event) {
      $self->return ( );	  
      return;
  }
  
  $POE::Kernel::poe_kernel->post($session, $event, $self);
  undef;
}

sub request {
    my $self = shift;
  return $self->[TR_REQUEST];
}


sub response {
    my $self = shift;
  return $self->[TR_RESPONSE];
}

sub params {
  my $self = shift;
  return $self->[TR_PARAMS];
}


sub stdin {
  my $self = shift;
  return $self->[TR_STDIN];
}

sub uri {
  my $self = shift;
  my $noq  = shift;
  my $uri;
  if (defined($noq)) {
      my ($scheme, $auth, $path, $query, $frag) = uri_split($self->[TR_REQUEST]->uri);
      $uri = uri_join($scheme, $auth, $path, undef, $frag);
  } else {
      $uri = $self->[TR_REQUEST]->uri->as_string;
  }

  return $uri;
}


sub method {
  my $self = shift;
  return $self->[TR_METHOD];
}

sub return {
    my $self = shift;
    my $output = shift;
    #my ($response, $path,$sender) = @_;
    # check for method?
    my $response = $self->response();
    my $path     = $self->[TR_PATH];
    my $params   = $self->params();
    my @tmp_p;
    
    my ($file_to_read,$template);
    if (defined $path) {
	$file_to_read = $html_config->{'html'} ."/".$path;
    } else {
	$file_to_read = $html_config->{'html'} ."/".$html_config->{'directory_index'};
    }
    my ($fname,$fdir,$fext) = File::Basename::fileparse($file_to_read,qr{\..*});
    $file_to_read .= "/".$html_config->{'directory_index'} if not defined $fext or $fext eq "";
    my $code = 200;
    # need a logging mechanism?
    &debug("LOG : ".$file_to_read); 
    eval {
	$template = HTML::Template->new(filename => $file_to_read,
					die_on_bad_params => 0);
	if (defined $output) {
	    $template->param('output' => $output);
	}
	push(@tmp_p,$params);	    
	$template->param('params' => \@tmp_p);
    };
    if ($@) {
	&debug($@);
	$code = 404;
	$file_to_read = $html_config->{'html'} ."/".$html_config->{'not_found'};
	$template = HTML::Template->new(filename => $file_to_read,
					die_on_bad_params => 0);
    }
    my $ft = File::Type->new();
    my $file_type = $ft->mime_type($file_to_read);    
    #my $file_type = mimetype($file_to_read); 
    my @types = split(/\//,$file_type);
    
    $file_type = join('/',@types);
    $file_type = "text/css" if ($file_to_read =~ /\.css$/);
    $file_type = "application/vnd.mozilla.xul+xml" if ($file_to_read =~ /\.xul$/);
    $file_type = "text/html" if ($file_to_read =~ /\.html$/);
    
    my $response_content = $template->output;
    
    
    if (!$params->{'stream'}) {	
 	# check file type and put the correct type
	$response->code($code);
	$response->header("Date", scalar localtime());
	$response->header("Content-Type", $file_type);	
	$response->header("Content-Length", length($response_content));
	$response->push_header("Pragma", "no-cache");	
	$response->push_header("Expires", "-1");	
	$response->content($response_content);
    } else {
	$response->header("Date", scalar localtime());
	$response->push_header("Content-Type", $file_type);
	$response->push_header("Cache-Control", "private");
	$response->push_header("Pragma", "no-cache");	
	$response->push_header("Expires", "-1");	
    }
    $self->[TR_CLIENT]->($response,$params->{'stream'},$response_content);
    return;

}



sub auth {
    my $self = shift;
    my $output;
    my ($content) = shift;
    my $response = $self->[TR_RESPONSE];
    my $code = 401;

    if ($self->method() eq "GET") {
	$response->header("status", "401 Unauthorized");
	$response->www_authenticate();
	$response->header("WWW-authenticate", "basic realm=\"PunJab\"");
    } else {
	$code = 500 if not defined $code;
    }
    $response->code($code);
    $response->header("Content-Type", "text/html");
    $response->header("Content-Length", length($content));
    $response->content($content);
    $self->[TR_CLIENT]->($response);
    return;

}

sub error {
    my $self     = shift;
    my $error    = shift;
    my $code     = shift;
    my $response = $self->[TR_RESPONSE];

    my $template = HTML::Template->new(filename => $html_config->{'html'} ."/error.html");
    
    $template->param('error' => $error);
    my $content  = $template->output;
    $code = 500 if not defined $code;

    $response->code($code);
    $response->header("Content-Type", "text/html");
    $response->header("Content-Length", length($content));
    $response->content($content);

    $self->[TR_CLIENT]->($response);
    return;
  
}

1;

__END__