view release on metacpan or  search on metacpan

lib/Gepok.pm  view on Meta::CPAN

# run PSGI app, send PSGI response to client as HTTP response, and return it
sub _handle_psgi {
    my ($self, $req, $sock) = @_;

    my $env = $self->_prepare_env($req, $sock);

    # cache first before socket closes
    $self->{_sock_peerhost} = $env->{REMOTE_ADDR};

    my $res = Plack::Util::run_app($self->_app, $env);

    # trap i/o error when sending response
    eval {
        if (ref($res) eq 'CODE') {
            $res->(sub { $self->_finalize_response($env, $_[0], $sock) });
        } else {
            $self->_finalize_response($env, $res, $sock);
        }
    };

    $res;
}

# prepare PSGI env
sub _prepare_env {
    my ($self, $req, $sock) = @_;

    my $httpd   = ${*$sock}{httpd_daemon};
    my $is_unix = $httpd->isa('HTTP::Daemon::UNIX');
    my $is_ssl  = $httpd->isa('HTTP::Daemon::SSL');
    my $uri = $req->uri->as_string;
    my ($qs, $pi);
    if ($uri =~ /(.*)\?(.*)/) {
        $pi = $1;
        $qs = $2;
    } else {
        $pi = $uri;
        $qs = "";
    }
    $pi = uri_unescape($pi);

    #warn "uri=$uri, qs=$qs\n";
    my $env = {
        REQUEST_METHOD  => $req->method,
        SCRIPT_NAME     => '',
        PATH_INFO       => $pi,
        REQUEST_URI     => $uri,
        QUERY_STRING    => $qs,
        SERVER_PORT     => $is_unix ? 0 : $httpd->sockport,
        SERVER_NAME     => $is_unix ? $httpd->hostpath : $httpd->sockhost,
        SERVER_PROTOCOL => 'HTTP/1.1',
        REMOTE_ADDR     => $is_unix ? '127.0.0.1' : $sock->peerhost,

        'psgi.version'         => [ 1, 1 ],
        'psgi.input'           => IO::Scalar->new(\($req->{_content})),
        'psgi.errors'          => *STDERR,
        'psgi.url_scheme'      => $is_ssl ? 'https' : 'http',
        'psgi.run_once'        => Plack::Util::FALSE,
        'psgi.multithread'     => Plack::Util::FALSE,
        'psgi.multiprocess'    => Plack::Util::TRUE,
        'psgi.streaming'       => Plack::Util::TRUE,
        'psgi.nonblocking'     => Plack::Util::FALSE,
        'psgix.input.buffered' => Plack::Util::TRUE,
        'psgix.io'             => $sock,
        'psgix.input.buffered' => Plack::Util::TRUE,
        'psgix.harakiri'       => Plack::Util::TRUE,

        # additional/server-specific
        'gepok'                     => 1,
        'gepok.connect_time'        => $self->{_connect_time},
        'gepok.start_request_time'  => $self->{_start_req_time},
        'gepok.finish_request_time' => $self->{_finish_req_time},
        'gepok.client_protocol'     => $self->{_client_proto},
        'gepok.socket'              => $sock,
        'gepok.httpd_socket'        => $httpd,
    };
    $env->{HTTPS} = 'on' if $is_ssl;
    if ($is_unix) {
        $env->{'gepok.unix_socket'} = 1;
    } else {
        #
    }

    # HTTP_ vars
    my $rh = $req->headers;
    for my $hn ($rh->header_field_names) {
        my $key = uc($hn); $key =~ s/[^A-Z0-9]/_/g;
        $key = "HTTP_$key" unless $key =~ /\A(?:CONTENT_(?:TYPE|LENGTH))\z/;
        $env->{$key} = join(", ", $rh->header($hn));
    }

    $env;
}

sub _set_label_serving {
    my ($self, $sock) = @_;
    # sock can be undef when client timed out
    return unless $sock;

    my $httpd = ${*$sock}{httpd_daemon};
    my $is_unix = $httpd->isa('HTTP::Daemon::UNIX');

    if ($is_unix) {
        my $sock_path = $httpd->hostpath;
        my ($pid, $uid, $gid) = $httpd->peercred;
        log_trace("Unix socket info: path=$sock_path, ".
                        "pid=$pid, uid=$uid, gid=$gid");
        $self->_daemon->set_label("serving unix (pid=$pid, uid=$uid, ".
                                      "path=$sock_path)");
    } else {
        my $is_ssl = $httpd->isa('HTTP::Daemon::SSL') ? 1:0;
        my $server_port = $sock->sockport;
        my $remote_ip   = $sock->peerhost // "127.0.0.1";
        my $remote_port = $sock->peerport;
        if (log_is_trace) {
            log_trace(join("",
                             "TCP socket info: https=$is_ssl, ",
                             "server_port=$server_port, ",
                             "remote_ip=$remote_ip, ",
                             "remote_port=$remote_port"));
        }