view release on metacpan or  search on metacpan

lib/Shuvgey/Server.pm  view on Meta::CPAN

    ();
}

sub create_tls {
    my $self = shift;
    my $tls;

    eval {
        $tls = AnyEvent::TLS->new(
            method    => "TLSv1_2",
            cert_file => $self->{tls_crt},
            key_file  => $self->{tls_key},
        );

        # ECDH curve ( Net-SSLeay >= 1.56, openssl >= 1.0.0 )
        if ( exists &Net::SSLeay::CTX_set_tmp_ecdh ) {
            my $curve = Net::SSLeay::OBJ_txt2nid('prime256v1');
            my $ecdh  = Net::SSLeay::EC_KEY_new_by_curve_name($curve);
            Net::SSLeay::CTX_set_tmp_ecdh( $tls->ctx, $ecdh );
            Net::SSLeay::EC_KEY_free($ecdh);
        }

        # ALPN (Net-SSLeay > 1.55, openssl >= 1.0.2)
        if ( exists &Net::SSLeay::CTX_set_alpn_select_cb ) {
            Net::SSLeay::CTX_set_alpn_select_cb( $tls->ctx,
                [ Protocol::HTTP2::ident_tls, H2_14 ] );
        }

        # NPN  (Net-SSLeay > 1.45, openssl >= 1.0.1)
        elsif ( exists &Net::SSLeay::CTX_set_next_protos_advertised_cb ) {
            Net::SSLeay::CTX_set_next_protos_advertised_cb( $tls->ctx,
                [ Protocol::HTTP2::ident_tls, H2_14 ] );
        }
        else {
            die "ALPN and NPN are not supported\n";
        }
    };

    $self->finish("Some problem with TLS: $@\n") if $@;
    return $tls;
}

sub finish {
    shift->{exit}->send(shift);
}

sub psgi_env {
    my ( $self, $host, $port, $peer_host, $peer_port, $headers, $data ) = @_;

    my $input;
    open $input, '<', \$data if defined $data;

    my $env = {
        'psgi.version'      => [ 1, 1 ],
        'psgi.input'        => $input,
        'psgi.errors'       => *STDERR,
        'psgi.multithread'  => FALSE,
        'psgi.multiprocess' => FALSE,
        'psgi.run_once'     => FALSE,
        'psgi.nonblocking'  => TRUE,
        'psgi.streaming'    => FALSE,
        'SCRIPT_NAME'       => '',
        'SERVER_NAME' => $host eq '0.0.0.0' ? $hostname : $host,
        'SERVER_PORT' => $port,

        'SERVER_PROTOCOL' => "HTTP/2",

        # This not in PSGI spec. Why not?
        'REMOTE_HOST' => $peer_host,
        'REMOTE_ADDR' => $peer_host,
        'REMOTE_PORT' => $peer_port,
    };

    for my $i ( 0 .. @$headers / 2 - 1 ) {
        my ( $h, $v ) = ( $headers->[ $i * 2 ], $headers->[ $i * 2 + 1 ] );
        if ( $h eq ':method' ) {
            $env->{REQUEST_METHOD} = $v;
        }
        elsif ( $h eq ':scheme' ) {
            $env->{'psgi.url_scheme'} = $v;
        }
        elsif ( $h eq ':path' ) {
            $env->{REQUEST_URI} = $v;
            my ( $path, $query ) = ( $v =~ /^([^?]*)\??(.*)?$/s );
            $env->{QUERY_STRING} = $query || '';
            $env->{PATH_INFO} = uri_unescape($path);
        }
        elsif ( $h eq ':authority' ) {

            #TODO: what to do with :authority?
        }
        elsif ( $h eq 'content-length' ) {
            $env->{CONTENT_LENGTH} = $v;
        }
        elsif ( $h eq 'content-type' ) {
            $env->{CONTENT_TYPE} = $v;
        }
        else {
            my $header = 'HTTP_' . uc($h);
            if ( exists $env->{$header} ) {
                $env->{$header} .= ', ' . $v;
            }
            else {
                $env->{$header} = $v;
            }
        }
    }
    @$headers = ();
    STOP and talk INFO, Dumper($env);
    return $env;
}

sub internal_error {
    my ( $self, $error ) = @_;

    my $message = "500 - Internal Server Error";
    STOP and talk ERROR, "$message: $error\n";

    return [
        500,
        [