view release on metacpan or  search on metacpan

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

    }
  }

  # This is actually returning a subref to PSI/Plack
  # So put it at the end
  $server->loop;

=cut

use strict;
use warnings;

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

use Coro;
use Coro::Channel;
use Plack;
use Plack::App::File; # use this now; no surprises for later

warn "tested against Plack 0.9938; you have $Plack::VERSION" if $Plack::VERSION < 0.9938;

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

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

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

sub new {
  my $class = shift;
  bless {
    first_request => 1,
    debug_level => 1,
    debug_callback => sub { print STDERR "@_\n" },
    request_queue => Coro::Channel->new(),
    @_
  }, $class;
}

sub get_request {
  # called from Continuity's main loop (new calls start_request_loop; start_request_loop gets requests from here or wherever and passes them to the mapper)
  my ($self) = @_;
  my $request = $self->{request_queue}->get or die;
  return $request;
}

sub loop_hook {

  my $self = shift;

  # $server->loop calls this; plackup run .psgi files except a coderef as the
  # last value and this lets that coderef fall out of the call to
  # $server->loop.

  # unique to the PSGI adapter -- a coderef that gets invoked when a request
  # comes in

  my $app = sub {
    my $env = shift;

    unless ($env->{'psgi.streaming'}) {
      die 'This application needs psgi.streaming support!';
    }

    # stuff $env onto a queue that get_request above pulls from; get_request is
    # called from Continuity's main execution context/loop. Continuity's main
    # execution loop invokes the Mapper to send the request across a queue to
    # the per session execution context (creating a new one as needed).

    return sub {
      my $response = shift;

      async {
        local $Coro::current->{desc} = 'PSGI Response Maker';

        # make it now and send it through the queue fully formed
        my $request = Continuity::Adapt::PSGI::Request->new( $env, $response );
        $self->{request_queue}->put($request);

        # Now... we wait!
        $request->{response_done_watcher}->wait;
      };
    };
  };

  # Is this needed?
  Coro::cede();

  return $app;
}

=head2 C<< $adapter->map_path($path) >>

Decodes URL-encoding in the path and attempts to guard against malice.
Returns the processed filesystem path.

=cut

sub map_path {
  my $self = shift;
  my $path = shift() || '';
  my $docroot = $self->docroot || '';
  # my $docroot = Cwd::getcwd();
  # $docroot .= '/' if $docroot and $docroot ne '.' and $docroot !~ m{/$};
  # some massaging, also makes it more secure
  $path =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr hex $1/ge;
  $path =~ s%//+%/%g unless $docroot;
  $path =~ s%/\.(?=/|$)%%g;
  $path =~ s%/[^/]+/\.\.(?=/|$)%%g;

  # if($path =~ m%^/?\.\.(?=/|$)%) then bad

$self->Continuity::debug(2,"path: $docroot$path\n");

  return "$docroot$path";
}


sub send_static {
  my ($self, $r) = @_;

  # this is called from Continuity.pm to give a request back to us to deal with that it got from our get_request.