unit class IO::Socket::TLSViaAsync does IO::Socket;

use IO::Socket::Async::SSL;

has ProtocolFamily:D $.family = PF_UNSPEC;

has SocketType:D   $.type  is built(False) = SOCK_STREAM;
has ProtocolType:D $.proto is built(False) = PROTO_TCP;

has Int $.backlog = 128;

has Str $.host;
has Int $.port;
has Str $.localhost;
has Int $.localport;
has Bool $.listening;
has Int $.ins = 0;

has Encoding::Decoder $!my-decoder;
has Encoding::Encoder $!my-encoder;

has $!con-tap;
has Lock $!con-lock;
has $!con-lock-cond;
has $!next-con;

has IO::Socket::Async::SSL $!async is built;
has $!in-tap;
has Lock $!in-lock;
has $!in-lock-cond;
constant max-in-buf-size = 1048576; # 2^21
has Buf $!in-buf;

my module PIO {
    constant MIN_PORT = 0;
    constant MAX_PORT = 65_535; # RFC 793: TCP/UDP port limit
}

my sub split-host-port($host is copy, $port is copy, $port-default, $family) {
    if ($host) {
        my ($split-host, $split-port) = $family == PF_INET6
            ?? v6-split($host)
            !! v4-split($host);

        if $split-port {
            $host = $split-host.Str;
            $port //= $split-port.Int
        }
    }

    $port //= $port-default;

    fail "Invalid port $port.gist(). Must be {PIO::MIN_PORT}..{PIO::MAX_PORT}"
        unless $port.defined and PIO::MIN_PORT <= $port <= PIO::MAX_PORT;

    return ($host, $port);
}

my sub v4-split($uri) {
    return $uri.split(':', 2);
}

my sub v6-split($uri) {
    my ($host, $port) = ($uri ~~ /^'[' (.+) ']' \: (\d+)$/)[0,1];
    return $host ?? ($host, $port) !! $uri;
}

method TWEAK(:listen(:$!listening) = False, *%args) {
    unless $!async {
        if !$!listening && $!host {
            ($!host, $!port) = (
                split-host-port $!host, $!port, 443, $!family
            orelse fail $_);

            $!async = await IO::Socket::Async::SSL.connect(
                $!host,
                $!port,
                |%args
            );
        }
        elsif $!listening && $!localhost {
            ($!localhost, $!localport) = (
                split-host-port $!localhost, $!localport, 443, $!family
            orelse fail $_);

            $!con-lock .= new;
            my $con-supply = IO::Socket::Async::SSL.listen(
                $!localhost,
                $!localport,
                $!backlog,
                |%args
            );
            $!con-tap = $con-supply.tap: -> $v {
                $!con-lock.protect: {
                    $!next-con = $v;
                    $!con-lock-cond.signal;
                }
            };
        }
        else {
            fail "Nothing given for new socket to connect or bind to. "
                ~ "Invalid arguments to .new?";
        }
    }

    if $!async {
        $!in-lock .= new;
        $!in-lock-cond = $!in-lock.condition;
        $!in-buf .= new;
        $!in-tap = $!async.Supply(:bin).tap: -> $data is copy {
            $!in-lock.protect: {
                if $!in-buf.elems == max-in-buf-size {
                    $!in-lock-cond.wait({ $!in-buf.elems < max-in-buf-size });
                }
                loop {
                    if $!in-buf.elems + $data.elems > max-in-buf-size {
                        my $allowed = max-in-buf-size - $!in-buf.elems;
                        $!in-buf.elems.append($data.subbuf(0, $allowed));
                        $data .= subbuf($allowed);
                        $!in-lock-cond.wait({ $!in-buf.elems < max-in-buf-size });
                    }
                    else {
                        $!in-buf.append($data);
                        $!in-lock-cond.signal;
                        last;
                    }
                }
            }
        },
        done => { $!in-tap = Nil },
        quit => -> $ex {
            $!in-tap = Nil;
            $ex.throw
        }
    }
}

method !my-ensure-decoder(--> Nil) {
    unless $!my-decoder.DEFINITE {
        my $encoding = Encoding::Registry.find($!encoding);
        $!my-decoder := $encoding.decoder();
        $!my-decoder.set-line-separators($!nl-in.list);
    }
}

method !my-ensure-encoder(--> Nil) {
    unless $!my-encoder.DEFINITE {
        my $encoding = Encoding::Registry.find($!encoding);
        $!my-encoder := $encoding.encoder();
    }
}

method !pull-bytes-from-async(Int $limit) {
    my $res;
    $!in-lock.protect: {
        loop {
            if $!in-buf.elems > $limit {
                my $new-buf = $!in-buf.subbuf($limit);
                $!in-buf.reallocate($limit);
                my $data = $!in-buf;
                $!in-buf = $new-buf;
                $!in-lock-cond.signal;
                $res = $data;
                last
            }
            elsif $!in-buf.elems {
                my $data = $!in-buf;
                $!in-buf .= new;
                $!in-lock-cond.signal;
                $res = $data;
                last
            }
            elsif !$!in-tap { # Connection has closed
                $res = $!in-buf;
                last
            }
            else {
                $!in-lock-cond.wait({ $!in-buf.elems });
            }
        }
    }
    $res
}

method !feed-decoder(Int $limit) {
    my $bytes = self!pull-bytes-from-async($limit);
    $!my-decoder.add-bytes($bytes);
    $bytes.elems
}

method !pull-bytes(Int $limit) {
    if $!my-decoder.DEFINITE {
        $!my-decoder.consume-exactly-bytes($limit)
            // self!pull-bytes-from-async($limit)
    }
    else {
        self!pull-bytes-from-async($limit)
    }
}

#TODO: Limit in IO::Socket is 65535. Why is this different?
method recv(::?CLASS:D: Cool $limit = 1048576, Bool :$bin = False) {
    fail('Socket not available') unless $!async;
    if $bin {
        self!pull-bytes($limit)
    }
    else {
        self!my-ensure-decoder();
        my $result = $!my-decoder.consume-exactly-chars($limit);
        without $result {
            self!feed-decoder(65535);
            $result = $!my-decoder.consume-exactly-chars($limit);
            without $result {
                $result = $!my-decoder.consume-all-chars();
            }
        }
        $result
    }
}

method read(::?CLASS:D: Int(Cool) $bufsize) {
    fail('Socket not available') unless $!async;
    my int $toread = $bufsize;

    my $res := self!pull-bytes($toread);

    while $res.elems < $toread {
        my $buf := self!pull-bytes($toread - $res.elems);
        $buf.elems
          ?? $res.append($buf)
          !! return $res
    }
    $res
}

method get(::?CLASS:D:) {
    self!my-ensure-decoder();
    my Str $line = $!my-decoder.consume-line-chars(:chomp);
    if $line.DEFINITE {
        $line
    }
    else {
        loop {
            my $read = self!feed-decoder(65535);
            $line = $!my-decoder.consume-line-chars(:chomp);
            last if $line.DEFINITE;
            if $read == 0 {
                $line = $!my-decoder.consume-line-chars(:chomp, :eof)
                    unless $!my-decoder.is-empty;
                last;
            }
        }
        $line.DEFINITE ?? $line !! Nil
    }
}

method lines(::?CLASS:D:) {
    gather while (my $line = self.get()).DEFINITE {
        take $line;
    }
}

method print(::?CLASS:D: Str(Cool) $string --> Int) {
    self!my-ensure-encoder();
    self.write($!my-encoder.encode-chars($string));
}

method put(::?CLASS:D: Str(Cool) $string --> Int) {
    self.print($string ~ $!nl-out);
}

method write(::?CLASS:D: Blob:D $buf --> Int) {
    await $!async.write($buf)
}

method close(::?CLASS:D:) {
    fail("Not connected!") unless $!async;
    .close with $!async;
    .close with $!in-tap;
    .close with $!con-tap;
}

method native-descriptor(::?CLASS:D:) {
    die "Not available on IO::Socket::TLSViaAsync";
}

method connect(IO::Socket::TLSViaAsync:U: Str() $host, Int() $port, ProtocolFamily:D(Int:D) :$family = PF_UNSPEC, *%async-args) {
    self.new(:$host, :$port, :family($family.value), |%async-args)
}

method listen(IO::Socket::TLSViaAsync:U: Str() $localhost, Int() $localport, ProtocolFamily:D(Int:D) :$family = PF_UNSPEC, *%async-args) {
    self.new(:listen, :$localhost, :$localport, :$family, |%async-args)
}

method accept(IO::Socket::TLSViaAsync:D:) {
    die "Not a server socket" unless $!listening;
    my $new-con;
    $!con-lock.protect: {
        $!con-lock-cond.wait({ $!next-con });
        $new-con = self.bless(async => $!next-con);
        $!next-con = Nil;
    }
    $new-con
}



head

IO::Socket::TLSViaAsync - Interface for TLS connections


use IO::Socket::TLSViaAsync;
my $ssl = IO::Socket::TLSViaAsync.new(:host<example.com>, :port(443));
if $ssl.print("GET / HTTP/1.1\r\n\r\n") {
    say $ssl.recv;
}


This module provides an interface for TLS connections. It's a drop in
replacement of C<IO::Socket::INET>.


Technically it's a wrapper around the C<IO::Socket::Async::SSL> module. The
C<new>, C<connect> and C<listen> methods forward their named arguments to the
C<connect> and C<listen> methods in C<IO::Socket::Async::SSL> respectively.


root

README

React

=begin React :component<HeaderCol> :id<menu> 
=para L<Documentation|/doc/introduction>
=para L<Modules| /mods>
=para L<Examples| file:../examples/index.podlite>
=para L<Download |file:../download/index.podlite>
=para L<About|file:../about/index.podlite>
=para 🔍 K<⌘K>/K<ctrl-K>
=end React


=begin React :component<HeaderCol> :id<footer>  
=begin nested :!nested
=item1 B<Language>
    =item2 L<Get started|file:../getting-started/getting-started.podlite>
    =item2 L<Why Raku?|/doc/language/faq#Why-should-I-learn-Raku-What's-so-great-about-it>
    =item2 L<Try Raku|https://glot.io/new/raku>
    =item2 L<Raku cheat sheet|https://github.com/Raku/mu/blob/master/docs/Perl6/Cheatsheet/cheatsheet.txt>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<Raku on Exercism|https://exercism.org/tracks/raku>
    =item2 L<Wikipedia|https://en.wikipedia.org/wiki/Raku_(programming_language)>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=end nested
=begin nested :!nested

=item1 B<L<Documentation|/doc>>
    =item2 L<Getting started, Migration guides from other languages, & Tutorials | file:../doc/introduction.podlite>
    =item2 L<Language References|file:../doc/reference.podlite>
    =item2 L<Type Reference| file:../doc/types.podlite>
    =item2 L<Miscellaneous| file:../doc/miscellaneous.podlite>
    =item2 L<FAQs (Frequently Asked Questions)|/doc/language/faq>
    =item2 L<Community|/doc/language/community>
    =item2 L<The list of all documents|file:../doc/index.podlite>

=item1 B<Resources>
    =item2 L<The Raku Guide|https://raku.guide/>
    =item2 L<Books |https://perl6book.com/>
    =item2 L<Rosetta Code | https://www.raku.org/community/rosettacode>

=end nested
=begin nested :!nested

=item1 B<Resoures>
    =item2 L<Download | file:../download/index.podlite>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=item1 B<Learning>
    =item2 L<The Raku Guide|https://raku.guide/>
    =item2 L<Wikibook |https://en.wikibooks.org/wiki/Raku_Programming>
    =item2 L<Books |https://perl6book.com/>
    =item2 L<Rosetta Code | https://www.raku.org/community/rosettacode>
    =item2 L<Learn Raku in Y minutes|https://learnxinyminutes.com/docs/raku/>
    =item2 L<Golfing |https://github.com/AlexDaniel/raku-golf-cheatsheet>
=end nested
=begin nested :!nested

=item1 B<Explore>
    =item2 L<Raku Blog Aggregator|https://planet.raku.org/>
    =item2 L<Rakudo Weekly|https://rakudoweekly.blog/>
    =item2 L<The Weekly Challenge |https://perlweeklychallenge.org/>
    =item2 L<Raku Advent Calendar|https://raku-advent.blog/>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=end nested
=end React


=begin React :component<CookieConsent> :id<CookieConsent> :buttonCaption("Got it!")
=para
This website uses cookies for analytics.
=end React


TLSViaAsync

NAME

SYNOPSIS

DESCRIPTION

IO-Socket-TLSViaAsync v1.0.0

Authors

License

Dependencies

Test Dependencies

Provides

Documentation