view release on metacpan or  search on metacpan

lib/Continuity/Adapt/FCGI.pm  view on Meta::CPAN

package Continuity::Adapt::FCGI;

use strict;
use Continuity::Request;
use base 'Continuity::Request';

use FCGI;
use HTTP::Status;
use Continuity::RequestHolder;
use IO::Handle;

sub debug_level { exists $_[1] ? $_[0]->{debug_level} = $_[1] : $_[0]->{debug_level} }
sub debug_callback { exists $_[1] ? $_[0]->{debug_callback} = $_[1] : $_[0]->{debug_callback} }

=head1 NAME

Continuity::Adapt::FCGI - Use HTTP::Daemon as a continuation server

=head1 DESCRIPTION

This module provides the glue between FastCGI Web and Continuity, translating FastCGI requests into HTTP::RequestWrapper
objects that are sent to applications running inside Continuity.

=head1 METHODS

=over

=item $server = new Continuity::Adapt::FCGI(...)

Create a new continuation adapter and HTTP::Daemon. This actually starts the
HTTP server which is embedded.

=cut

sub new {
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = {};
  $self = {%$self, @_};
  bless $self, $class;

  my $env = {};
  my $in = new IO::Handle;
  my $out = new IO::Handle;
  my $err = new IO::Handle;

  $self->{fcgi_request} = FCGI::Request($in,$out,$err,$env);
  $self->{in} = $in;
  $self->{out} = $out;
  $self->{err} = $err;
  $self->{env} = $env;

  return $self;
}

=item mapPath($path) - map a URL path to a filesystem path

=cut

sub map_path {
  my ($self, $path) = @_;
  my $docroot = $self->{docroot};
  # some massaging, also makes it more secure
  $path =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr hex $1/ge;
  $path =~ s%//+%/%g;
  $path =~ s%/\.(?=/|$)%%g;
  1 while $path =~ s%/[^/]+/\.\.(?=/|$)%%;

  # if($path =~ m%^/?\.\.(?=/|$)%) then bad
# XXX this has fixes in the corresponding version I think -- sdw

  return "$docroot$path";
}


=item sendStatic($c, $path) - send static file to the $c filehandle

We cheat here... use 'magic' to get mimetype and send that. then the binary
file

=cut

sub send_static {
  my ($self, $r) = @_;
  my $c = $r->conn or die;
  my $path = $self->map_path($r->url->path) or do { 
       $self->Continuity::debug(1, "can't map path: " . $r->url->path); $c->send_error(404); return; 
  };
  $path =~ s{^/}{}g;
  unless (-f $path) {
      $c->send_error(404);
      return;
  }
  # For now we'll cheat and use file -- perhaps later this will be overridable
  open my $magic, '-|', 'file', '-bi', $path;
  my $mimetype = <$magic>;
  chomp $mimetype;
  # And for now we'll make a raw exception for .html
  $mimetype = 'text/html' if $path =~ /\.html$/ or ! $mimetype;
  print $c "Content-type: $mimetype\r\n\r\n";
  open my $file, '<', $path or return;
  while(read $file, my $buf, 8192) {
      $c->print($buf);
  } 
  $self->Continuity::debug(2,"Static send '$path', Content-type: $mimetype");
}

sub get_request {
  my ($self) = @_;
  my $r = $self->{fcgi_request};
  #$SIG{__WARN__} = sub { print STDERR @_ };
  #$SIG{__DIE__} = sub { print STDERR @_ };
  if($r->Accept >= 0) {
    $self->Continuity::debug(2,"FCGI request accepted, request: $r");
    return Continuity::Adapt::FCGI::Request->new(
      fcgi_request => $r,
    );
  }
  die "Continuity::Adapt::FCGI: ERROR: Not in FCGI environment?\n";
  return undef;
}


=back

=cut

#
#
#
#

package Continuity::Adapt::FCGI::Request;
use strict;

use CGI::Util qw(unescape);
use HTTP::Headers;
use base 'HTTP::Request';
use Continuity::Request;
use base 'Continuity::Request';

# CGI query params
sub cached_params { exists $_[1] ? $_[0]->{cached_params} = $_[1] : $_[0]->{cached_params} }

# The FCGI object
sub fcgi_request { exists $_[1] ? $_[0]->{fcgi_request} = $_[1] : $_[0]->{fcgi_request} }

sub debug_level :lvalue { $_[0]->{debug_level} }
sub debug_callback :lvalue { $_[0]->{debug_callback} }

=item $request = Continuity::Adapt::FCGI::Request->new($client, $id, $cgi, $query)

Creates a new C<Continuity::Adapt::FCGI::Request> object. This deletes values
from C<$cgi> while converting it into a L<HTTP::Request> object.
It also assumes $cgi contains certain CGI variables.

This code was borrowed from POE::Component::FastCGI

=cut

sub new {
  my $class = shift;
  my %args = @_;
  my $fcgi_request = $args{fcgi_request};
  my $cgi = $fcgi_request->GetEnvironment;
  my ($in, $out, $err) = $fcgi_request->GetHandles;
  my $content;
  {
    local $/;
    $content = <$in>;
  }
  my $host = defined $cgi->{HTTP_HOST} ? $cgi->{HTTP_HOST} :
     $cgi->{SERVER_NAME};

  my $self = $class->SUPER::new(
     $cgi->{REQUEST_METHOD},
     "http" .  (defined $cgi->{HTTPS} and $cgi->{HTTPS} ? "s" : "") .
        "://$host" . $cgi->{REQUEST_URI},
     # Convert CGI style headers back into HTTP style
     HTTP::Headers->new(
        map {
           my $p = $_;
           s/^HTTP_//;
           s/_/-/g;
           ucfirst(lc $_) => $cgi->{$p};
        } grep /^HTTP_/, keys %$cgi
     ),
     $content
  );
  $self->fcgi_request($fcgi_request);
  $self->{out} = $out;
  $self->{env} = $cgi;
  $self->{content} = $content;
  $self->{debug_level} = $args{debug_level};
  $self->{debug_callback} = $args{debug_callback};
  $self->Continuity::debug(2, "\n====== Got new request ======\n"
             . "       Conn: ".$self->{out}."\n"
             . "    Request: $self"
  );
  return $self;
}

sub send_error {
  my ($self) = @_;
  $self->print("Error");
}

sub peerhost {
  my ($self) = @_;
  my $env = $self->fcgi_request->GetEnvironment;
  return $env->{REMOTE_ADDR};
}

=item $request->error($code[, $text])