view release on metacpan or  search on metacpan

lib/LightTCP/SSLclient.pm  view on Meta::CPAN

package LightTCP::SSLclient;

use strict;
use warnings;
use IO::Socket::SSL;
use IO::Socket::INET;
use MIME::Base64 qw(encode_base64);
use URI;

our $VERSION = '1.06';

use base 'Exporter';

our @EXPORT_OK = qw(
    ECONNECT
    EREQUEST
    ERESPONSE
    ETIMEOUT
    ESSL
);

our %EXPORT_TAGS = (
    errors => [qw(ECONNECT EREQUEST ERESPONSE ETIMEOUT ESSL)],
);

use constant {
    ECONNECT  => 1,
    EREQUEST  => 2,
    ERESPONSE => 3,
    ETIMEOUT  => 4,
    ESSL      => 5,
};

sub new {
    my ($class, %opts) = @_;
    my $self = {
        timeout        => $opts{timeout} // 10,
        insecure       => $opts{insecure} // 0,
        cert           => $opts{cert} // undef,
        verbose        => $opts{verbose} // 0,
        user_agent     => $opts{user_agent} // 'LightTCP::SSLclient/'.$VERSION,
        ssl_protocols  => $opts{ssl_protocols} // ['TLSv1.2', 'TLSv1.3'],
        ssl_ciphers    => $opts{ssl_ciphers} // 'HIGH:!aNULL:!MD5:!RC4',
        keep_alive     => $opts{keep_alive} // 0,
        buffer_size    => $opts{buffer_size} // 8192,
        max_redirects  => $opts{max_redirects} // 5,
        follow_redirects => $opts{follow_redirects} // 1,
        _socket        => undef,
        _connected     => 0,
        _target_host   => undef,
        _target_port   => undef,
        _proxy         => undef,
        _proxy_auth    => undef,
        _buffer        => '',
        _redirect_count=> 0,
        _redirect_history => [],
    };
    bless $self, $class;
    return $self;
}

sub _parse_proxy_address {
    my ($proxy) = @_;

    if ($proxy =~ /^\[(.+)\]:(\d+)$/) {

lib/LightTCP/SSLclient.pm  view on Meta::CPAN

        $$buffer_ref = $2;
        return $1 . $delim;
    }
    return undef;
}

sub _read_exact_bytes {
    my ($socket, $bytes, $timeout) = @_;
    my $result = '';
    my $buf;

    eval {
        local $SIG{ALRM} = sub { die "timeout\n" };
        alarm $timeout;

        while (length($result) < $bytes) {
            my $read = sysread($socket, $buf, $bytes - length($result));
            last unless defined $read && $read > 0;
            $result .= $buf;
        }

        alarm 0;
    };
    if ($@) {
        return substr($result, 0, length($result));
    }
    return $result;
}

sub _hex_dump {
    my ($data) = @_;
    return join('', map { sprintf('%02x', ord($_)) } split(//, $data));
}

sub connect {
    my ($self, $target_host, $target_port, $proxy, $proxy_auth) = @_;

    my $timeout = $self->{timeout};
    my $socket;

    my @debug;
    my @errors;
    push(@debug, "# === LightTCP::SSLclient::connect ===\n") if $self->{verbose};

    $self->{_target_host} = $target_host;
    $self->{_target_port} = $target_port;
    $self->{_proxy} = $proxy;
    $self->{_proxy_auth} = $proxy_auth;
    $self->{_buffer} = '';

    my %ssl_opts = (
        SSL_verifycn_scheme => 'http',
        SSL_verifycn_name   => $target_host,
        SSL_hostname        => $target_host,
        Timeout             => $timeout,
        SSL_protocols       => $self->{ssl_protocols},
        SSL_cipher_list     => $self->{ssl_ciphers},
    );

    if ($self->{insecure}) {
        $ssl_opts{SSL_verify_mode} = IO::Socket::SSL::SSL_VERIFY_NONE;
    } else {
        $ssl_opts{SSL_verify_mode} = IO::Socket::SSL::SSL_VERIFY_PEER;
    }

    if ($self->{cert} && -f $self->{cert}.'.key' && -f $self->{cert}.'.crt') {
        $ssl_opts{SSL_key_file}  = $self->{cert}.'.key';
        $ssl_opts{SSL_cert_file} = $self->{cert}.'.crt';
    }

    if ($self->{verbose}) {
        push(@debug, "# === ssl_opts ===\n");
        foreach my $k (sort keys %ssl_opts) {
            next if $k =~ /SSL_(key|cert)_file/;
            push(@debug, "- $k = $ssl_opts{$k}\n");
        }
    }

    if ($proxy) {
        my ($proxy_host, $proxy_port) = _parse_proxy_address($proxy);
        unless ($proxy_host && $proxy_port) {
            push(@errors, "- ERROR: Invalid proxy address format: $proxy\n");
            return (0, \@errors, \@debug, ECONNECT);
        }

        push(@debug, "# Connecting to proxy $proxy_host:$proxy_port...\n") if $self->{verbose};
        $socket = IO::Socket::INET->new(
            PeerAddr => $proxy_host,
            PeerPort => $proxy_port,
            Proto    => 'tcp',
            Timeout  => $timeout,
        );
        unless ($socket) {
            push(@errors, "- ERROR: Cannot connect to proxy: $!\n");
            return (0, \@errors, \@debug, ECONNECT);
        }

        my $connect_req = "CONNECT $target_host:$target_port HTTP/1.1\r\n";
        $connect_req   .= "Host: $target_host:$target_port\r\n";
        if ($proxy_auth) {
            my $encoded = encode_base64($proxy_auth, '');
            $connect_req .= "Proxy-Authorization: Basic $encoded\r\n";
            push(@debug, "- Proxy-Authorization: " . _sanitize_credentials("Basic $encoded") . "\n") if $self->{verbose};
        }
        $connect_req .= "\r\n";
        print $socket $connect_req;

        my $proxy_resp = _read_line_from_socket($self, $socket, $timeout, \$self->{_buffer});
        unless ($proxy_resp) {
            push(@errors, "- ERROR: Failed to read proxy response: $!\n");
            $socket->close() if $socket;
            return (0, \@errors, \@debug, ECONNECT);
        }

        unless ($proxy_resp =~ /^HTTP\/1\.[01]\s+200\b/i) {
            $socket->close() if $socket;
            push(@errors, "- ERROR: Proxy CONNECT failed:\n$proxy_resp");
            return (0, \@errors, \@debug, ECONNECT);
        }
        push(@debug, "- Proxy tunnel established.\n") if $self->{verbose};

        if (IO::Socket::SSL->start_SSL($socket, %ssl_opts)) {
            $socket->timeout($timeout);
            push(@debug, "- SSL connect established.\n") if $self->{verbose};
            $self->{_socket}    = $socket;
            $self->{_connected} = 1;
            return (1, \@errors, \@debug, 0);
        } else {
            push(@errors, "- ERROR: SSL connect failed: $SSL_ERROR\n");
            return (0, \@errors, \@debug, ESSL);
        }
    } else {
        push(@debug, "# Connecting to $target_host:$target_port...\n") if $self->{verbose};
        $socket = IO::Socket::SSL->new(
            PeerHost => $target_host,
            PeerPort => $target_port,
            %ssl_opts,
        );
        if ($socket) {
            $socket->timeout($timeout);
            push(@debug, "- Direct SSL connect established.\n") if $self->{verbose};
            $self->{_socket}    = $socket;
            $self->{_connected} = 1;
            return (1, \@errors, \@debug, 0);
        } else {
            push(@errors, "- ERROR: Direct SSL connection failed: $SSL_ERROR\n");
            return (0, \@errors, \@debug, ESSL);
        }
    }
}

sub reconnect {
    my ($self) = @_;
    return 0 unless $self->{_target_host} && $self->{_target_port};
    $self->close();
    my ($ok, $err, $dbg, $code) = $self->connect(
        $self->{_target_host},
        $self->{_target_port},
        $self->{_proxy},
        $self->{_proxy_auth},
    );
    return $ok;
}

sub request {
    my ($self, $method, $path, %opts) = @_;

    my $socket = $self->{_socket};
    my @debug;
    my @errors;

    push(@debug, "# === LightTCP::SSLclient::request ===\n") if $self->{verbose};
    push(@debug, "- Sending: $method $path HTTP/1.1\n") if $self->{verbose};

    unless ($socket) {
        push(@errors, "- ERROR: No connection established\n");
        return (0, \@errors, \@debug, EREQUEST);
    }

    my $host    = $opts{host}    // '';
    my $payload = $opts{payload} // '';
    my $ph      = $opts{headers} // {};

    my $length = defined $payload ? length($payload) : 0;

    $ph->{'Host'}         ||= $host;
    $ph->{'Accept'}       ||= '*/*';
    $ph->{'User-Agent'}   ||= $self->{user_agent};
    $ph->{'Connection'}   ||= $self->{keep_alive} ? 'keep-alive' : 'close';

    my $timeout = $self->{timeout};
    my $send_ok = 1;

    eval {