view release on metacpan or  search on metacpan

lib/Plack/Handler/FCGI.pm  view on Meta::CPAN

            %env,
            'psgi.version'      => [1,1],
            'psgi.url_scheme'   => ($env{HTTPS}||'off') =~ /^(?:on|1)$/i ? 'https' : 'http',
            'psgi.input'        => $self->{stdin},
            'psgi.errors'       => 
                ($self->{keep_stderr} ? \*STDERR : $self->{stderr}),
            'psgi.multithread'  => Plack::Util::FALSE,
            'psgi.multiprocess' => defined $proc_manager,
            'psgi.run_once'     => Plack::Util::FALSE,
            'psgi.streaming'    => Plack::Util::TRUE,
            'psgi.nonblocking'  => Plack::Util::FALSE,
            'psgix.harakiri'    => defined $proc_manager,
            'psgix.cleanup'     => 1,
            'psgix.cleanup.handlers' => [],
        };

        delete $env->{HTTP_CONTENT_TYPE};
        delete $env->{HTTP_CONTENT_LENGTH};

        # lighttpd munges multiple slashes in PATH_INFO into one. Try recovering it
        my $uri = URI->new("http://localhost" .  $env->{REQUEST_URI});
        $env->{PATH_INFO} = uri_unescape($uri->path);
        $env->{PATH_INFO} =~ s/^\Q$env->{SCRIPT_NAME}\E//;

        # root access for mod_fastcgi
        if (!exists $env->{PATH_INFO}) {
            $env->{PATH_INFO} = '';
        }

        # typical fastcgi_param from nginx might get empty values
        for my $key (qw(CONTENT_TYPE CONTENT_LENGTH)) {
            no warnings;
            delete $env->{$key} if exists $env->{$key} && $env->{$key} eq '';
        }

        if (defined(my $HTTP_AUTHORIZATION = $env->{Authorization})) {
            $env->{HTTP_AUTHORIZATION} = $HTTP_AUTHORIZATION;
        }

        my $res = Plack::Util::run_app $app, $env;

        if (ref $res eq 'ARRAY') {
            $self->_handle_response($res);
        }
        elsif (ref $res eq 'CODE') {
            $res->(sub {
                $self->_handle_response($_[0]);
            });
        }
        else {
            die "Bad response $res";
        }

        # give pm_post_dispatch the chance to do things after the client thinks
        # the request is done
        $request->Finish;

        $proc_manager && $proc_manager->pm_post_dispatch();

        # When the fcgi-manager exits it sends a TERM signal to the workers.
        # However, if we're busy processing the cleanup handlers, testing
        # shows that the worker doesn't actually exit in that case.
        # Trapping the TERM signal and finshing up fixes that.
        my $exit_due_to_signal = 0;
        if ( @{ $env->{'psgix.cleanup.handlers'} || [] } ) {
            local $SIG{TERM} = sub { $exit_due_to_signal = 1 };
            for my $handler ( @{ $env->{'psgix.cleanup.handlers'} } ) {
                $handler->($env);
            }
        }

        if ($proc_manager && $env->{'psgix.harakiri.commit'}) {
            $proc_manager->pm_exit("safe exit with harakiri");
        }
        elsif ($exit_due_to_signal) {
            $proc_manager && $proc_manager->pm_exit("safe exit due to signal");
            exit;    # want to exit, even without a $proc_manager
        }
    }
}

sub _handle_response {
    my ($self, $res) = @_;

    $self->{stdout}->autoflush(1);
    binmode $self->{stdout};

    my $hdrs;
    my $message = status_message($res->[0]);
    $hdrs = "Status: $res->[0] $message\015\012";

    my $headers = $res->[1];
    while (my ($k, $v) = splice @$headers, 0, 2) {
        $hdrs .= "$k: $v\015\012";
    }
    $hdrs .= "\015\012";

    print { $self->{stdout} } $hdrs;

    my $cb = sub { print { $self->{stdout} } $_[0] };
    my $body = $res->[2];
    if (defined $body) {
        Plack::Util::foreach($body, $cb);
    }
    else {
        return Plack::Util::inline_object
            write => $cb,
            close => sub { };
    }
}

sub daemon_fork {
    require POSIX;
    fork && exit;
}

sub daemon_detach {
    my $self = shift;
    print "FastCGI daemon started (pid $$)\n";
    open STDIN,  "+</dev/null" or die $!; ## no critic
    open STDOUT, ">&STDIN"     or die $!;