view release on metacpan or  search on metacpan

lib/Plack/Middleware/Proxy/Connect/IO.pm  view on Meta::CPAN

    builder {
        enable "Proxy::Connect::IO", timeout => 30;
        enable "Proxy::Requests";
        Plack::App::Proxy->new->to_app;
    };

=for markdown ```

=head1 DESCRIPTION

This middleware handles the C<CONNECT> method. It allows to connect to
C<https> addresses.

The middleware runs on servers supporting C<psgix.io> and provides own
event loop so does not work correctly with C<psgi.nonblocking> servers.

The middleware uses only Perl's core modules: L<IO::Socket::INET> and
L<IO::Select>.

=for readme stop

=cut

use 5.006;

use strict;
use warnings;

our $VERSION = '0.0305';

use parent qw(Plack::Middleware);

use Plack::Util::Accessor qw(
    timeout
);

use IO::Socket::INET;
use IO::Select;
use Socket qw(IPPROTO_TCP TCP_NODELAY);

use constant CHUNKSIZE       => 64 * 1024;
use constant DEFAULT_TIMEOUT => 60;
use constant READ_TIMEOUT    => 0.5;
use constant WRITE_TIMEOUT   => 0.5;

sub prepare_app {
    my ($self) = @_;

    # the default values
    $self->timeout(DEFAULT_TIMEOUT) unless defined $self->timeout;
}

sub call {
    my ($self, $env) = @_;

    return $self->app->($env)
        unless $env->{REQUEST_METHOD} eq 'CONNECT';

    return [501, [], ['']]
        unless $env->{'psgi.streaming'} and $env->{'psgix.io'};

    return sub {
        my ($respond) = @_;

        my $client = $env->{'psgix.io'};

        my ($host, $port) = $env->{REQUEST_URI} =~ m{^(?:.+\@)?(.+?)(?::(\d+))?$};

        my $remote = IO::Socket::INET->new(
            PeerAddr => $host,
            PeerPort => $port,
            Blocking => 0,
            Timeout  => $self->timeout,
        );

        if (!$remote) {
            if ($! eq 'Operation timed out') {
                return $respond->([504, [], ['']]);
            } else {
                return $respond->([502, [], ['']]);
            }
        }

        $client->blocking(0);

        # missing on Android
        if (eval { TCP_NODELAY }) {
            $client->setsockopt(IPPROTO_TCP, TCP_NODELAY, 1);
            $remote->setsockopt(IPPROTO_TCP, TCP_NODELAY, 1);
        }

        my $ioset = IO::Select->new;

        $ioset->add($client);
        $ioset->add($remote);

        my $writer = $respond->([200, []]);

        my $bufin = '';
        my $bufout = '';

    IOLOOP: while (1) {
            for my $socket ($ioset->can_read(READ_TIMEOUT)) {
                my $read = $socket->sysread(my $chunk, CHUNKSIZE);

                if ($read) {
                    if ($socket == $client) {
                        $bufout .= $chunk;
                    } elsif ($socket == $remote) {
                        $bufin .= $chunk;
                    }
                } else {
                    $client->syswrite($bufin);
                    $client->close;
                    $remote->syswrite($bufout);
                    $remote->close;
                    last IOLOOP;
                }
            }