view release on metacpan or  search on metacpan

lib/POE/Component/Server/Bayeux.pm  view on Meta::CPAN

        $request->complete();
    }

    $kernel->alarm_remove_all();
    $kernel->alias_set( $heap->{manager} );

    $kernel->call( $heap->{http_aliases}{httpd}, 'shutdown' );
    $kernel->call( $heap->{http_aliases}{tcp}, 'shutdown' );
}

sub http_server_generic {
    my ($kernel, $heap, $request, $response) = @_[KERNEL, HEAP, ARG0, ARG1];

    my $uri = URI->new($request->uri);
    my $path = $heap->{args}{DocumentRoot} . '/' . $uri->path;

    # Attempt to find a directory index
    if (-d $path) {
        $path .= '/' unless $path =~ m{/$};
        foreach my $index_name (@{ $heap->{args}{DirectoryIndex} }) {
            next unless -f $path . $index_name;
            $path .= $index_name;
            last;
        }

    }
    if (-d $path) {
        $response->code(RC_OK);
        $response->content("Directory listing denied");
    }
    elsif (-f $path) {
        $response->code(RC_OK);
        open my $in, '<', $path;
        if (! $in) {
            $response->content("Unable to open '$path': $!");
            return RC_OK;
        }

        # Find a file type
        my $type;
        foreach my $possible_type (keys %file_types) {
            next unless grep { $path =~ $_ } @{ $file_types{$possible_type} };
            $type = $possible_type;
            last;
        }
        $type ||= 'text/plain';
        $response->content_type($type);

        if (my $whence = $heap->{args}{TypeExpires}{$type}) {
            $response->expires( time() + $whence );
        }

        my $content;
        {
            local $/ = undef;
            $content = <$in>;
        }
        close $in;
        $response->content($content);

        my $ip = $request->header('X-Forwarded-For') || $request->{connection}{remote_ip};
        $heap->{logger}->info(sprintf 'Serving %s %s %s', $ip, $uri->path, $response->content_type);
    }
    else {
        $response->code(RC_NOT_FOUND);
        $response->content("Path '".$uri->path."' not found");
    }

    if ($heap->{args}{PostHandle}) {
        $heap->{args}{PostHandle}($request, $response);
    }

    # Ensure no KeepAlive
    $request->header(Connection => 'close');

    return RC_OK;
}

## Remote clients, long-polling ###

sub handle_cometd {
    my ($kernel, $heap, $request, $response) = @_[KERNEL, HEAP, ARG0, ARG1];

    # Deny based upon ClientMaxConnections restrictions

    my $ip = $request->header('X-Forwarded-For') || $request->{connection}{remote_ip};
    if (! $ip) {
        $ip = '0.0.0.0';
        $heap->{logger}->error("No IP found for cometd request");
    }

    $heap->{requests_by_ip}{$ip} ||= {};
    my @request_ids = keys %{ $heap->{requests_by_ip}{$ip} };
    if (int @request_ids > $heap->{args}{ClientMaxConnections}) {
        $heap->{logger}->info("Denying $ip; too many connections (".int(@request_ids).")");

        $response->code(RC_SERVICE_UNAVAILABLE);
        $response->header( 'Content-Type' => "text/json; charset=utf-8" );
        $response->content( '{ "error": "Too many connections from your IP", "successful": false }' );
        return RC_OK;
    }
    else {
        #$heap->{logger}->info("IP $ip has " . int(@request_ids) . " connections");
    }

    # Proceed with processing

    #$heap->{logger}->debug("Handling new cometd request");

    #$heap->{logger}->debug($request->as_string);

    my $bayeux_request = POE::Component::Server::Bayeux::Request->new(
        request => $request,
        response => $response,
        server_heap => $heap,
        ip => $ip,
    );
    $bayeux_request->handle();

    if ($bayeux_request->is_complete) {
        $heap->{logger}->debug("Immediate remote response:", $bayeux_request->json_response);
        return RC_OK;
    }
    else {
        $heap->{requests}{ $bayeux_request->id } = $bayeux_request;
        $heap->{requests_by_ip}{$ip}{ $bayeux_request->id } = $bayeux_request;
        return RC_WAIT;
    }
}

sub delay_request {
    my ($kernel, $heap, $request_id, $delay) = @_[KERNEL, HEAP, ARG0, ARG1];

    $heap->{logger}->debug("Delaying $delay to process request $request_id");
    $kernel->delay_add('complete_request', $delay, $request_id);
}

sub complete_request {
    my ($kernel, $heap, $request_id) = @_[KERNEL, HEAP, ARG0];

    return unless defined $heap->{requests}{$request_id};
    my $request = delete $heap->{requests}{$request_id};

    my $ip = $request->ip;
    if ($heap->{requests_by_ip}{$ip}) {
        delete $heap->{requests_by_ip}{$ip}{$request_id};