unit class OpenSSL;

use OpenSSL::SSL;
use OpenSSL::Bio;
use OpenSSL::Err;
use OpenSSL::EVP;
use OpenSSL::X509;

use NativeCall;

has OpenSSL::Ctx::SSL_CTX $.ctx;
has OpenSSL::SSL::SSL $.ssl;
has $.client;

has $.using-bio = False;
has $.bio-read-buf = buf8.new;
has $.net-write;
has $.net-read;

has $.net-bio;
has $.internal-bio;

class X::OpenSSL::Exception is Exception {
    has $.message;
}

# SSLv2 | SSLv3 | TLSv1 | TLSv1.1 | TLSv1.2 | default
subset ProtocolVersion of Numeric where * == 2| 3| 1| 1.1| 1.2| -1;

method new(Bool :$client = False, ProtocolVersion :$version = -1) {

    # make a simple call to ensure libeay32.dll is loaded before ssleay32.dll (on windows)
    #
    # if we're using our bundled .dll files, and we try to load ssleay32.dll first, LoadLibrary
    # can't find the required libeay32.dll anywhere in the path, and so fails to load the dll
    OpenSSL::EVP::EVP_aes_128_cbc();
    
    # Provisional support for OpenSSL 1.1
    try {
        CATCH {
            default { OpenSSL::SSL::OPENSSL_init_ssl(0, OpaquePointer); }
        }
        OpenSSL::SSL::SSL_library_init();
        OpenSSL::SSL::SSL_load_error_strings();
    }

    my $method;
    given $version {
        when 2 {
            $method = ($client ?? OpenSSL::Method::SSLv2_client_method() !! OpenSSL::Method::SSLv2_server_method());
        }
        when 3 {
            $method = ($client ?? OpenSSL::Method::SSLv3_client_method() !! OpenSSL::Method::SSLv3_server_method());
        }
        when 1 {
            $method = ($client ?? OpenSSL::Method::TLSv1_client_method() !! OpenSSL::Method::TLSv1_server_method());
        }
        when 1.1 {
            $method = ($client ?? OpenSSL::Method::TLSv1_1_client_method() !! OpenSSL::Method::TLSv1_1_server_method());
        }
        when 1.2 {
            $method = ($client ?? OpenSSL::Method::TLSv1_2_client_method() !! OpenSSL::Method::TLSv1_2_server_method());
        }
        # No explicit version means: negotiate.
        # In OpenSSL 1.1.0, TLS_method() replaces SSLv23_method()
        default {
            $method = try {$client ?? OpenSSL::Method::TLS_client_method()    !! OpenSSL::Method::TLS_server_method()} \
                   || try {$client ?? OpenSSL::Method::SSLv23_client_method() !! OpenSSL::Method::SSLv23_server_method()};
        }
    }
    my $ctx     = OpenSSL::Ctx::SSL_CTX_new( $method );
    my $ssl     = OpenSSL::SSL::SSL_new( $ctx );


    self.bless(:$ctx, :$ssl, :$client);
}

method set-server-name(Str $server-name) {
    explicitly-manage($server-name);
    OpenSSL::SSL::SSL_ctrl($!ssl, 55, 0, $server-name);

}

method set-fd(int32 $fd) {
    OpenSSL::SSL::SSL_set_fd($!ssl, $fd);
}

method set-socket(IO::Socket $s) {
    # see http://wiki.openssl.org/index.php/Manual:BIO_s_bio(3)

    $!using-bio = True;
    my $n-ptr = CArray[OpaquePointer].new;
    $n-ptr[0] = OpaquePointer;
    my $i-ptr = CArray[OpaquePointer].new;
    $i-ptr[0] = OpaquePointer;

    my $ret = OpenSSL::Bio::BIO_new_bio_pair($n-ptr, 0, $i-ptr, 0);
    if $ret == 0 {
        my $e = OpenSSL::Err::ERR_get_error();
        say "err code: $e";
        say OpenSSL::Err::ERR_error_string($e);
    }
    $!net-bio = $n-ptr[0];
    $!internal-bio = $i-ptr[0];
    OpenSSL::SSL::SSL_set_bio($!ssl, $.internal-bio, $.internal-bio);

    if $s.?host {
        self.set-server-name($s.host);
    }

    $!net-write = -> $buf {
        $s.write($buf);
    }

    $!net-read = -> $n = Inf {
        $s.recv($n, :bin);
    }
    0;
}

method bio-write {
    # if we're handling the network in P6, dump everything we can
    if $.using-bio {
        my $cbuf = buf8.new;
        $cbuf[1024] = 0;
        while (my $len = OpenSSL::Bio::BIO_read($.net-bio, $cbuf, 1024)) > 0 {
            my $buf = $cbuf.subbuf(0, $len);
            $.net-write.($buf);
        }
    }
}
method bio-read {
    # if we're handling the network in P6, read everything we can
    my $read = 0;
    if $.using-bio {
        if $!bio-read-buf.bytes == 0 {
            $!bio-read-buf = $.net-read.();
        }
        $read = $!bio-read-buf.bytes;
        my $bytes = OpenSSL::Bio::BIO_write($.net-bio, $!bio-read-buf, $!bio-read-buf.bytes);
        $!bio-read-buf = $!bio-read-buf.subbuf($bytes);
    }
    return $read;
}
method handle-error($code) {
    my $e = OpenSSL::SSL::SSL_get_error($!ssl, $code);
    return 0 unless $e;
    my $try-recover = -1;
    if $e == 2 && $.using-bio { # SSL_ERROR_WANT_READ
        $.bio-write;
        my $read = $.bio-read;
        $try-recover = 1 if $read;
    } elsif $e == 3 && $.using-bio { # SSL_ERROR_WANT_WRITE
        $.bio-write;
        $try-recover = 1;
    } else {
        # we don't know what to do with it - pass the error up the stack
        $try-recover = -1;
    }

    $try-recover;
}

method set-connect-state {
    OpenSSL::SSL::SSL_set_connect_state($!ssl);
}

method set-accept-state {
    OpenSSL::SSL::SSL_set_accept_state($!ssl);
}

method connect {
    my $ret;

    loop {
        $ret = OpenSSL::SSL::SSL_connect($!ssl);

        my $e = $.handle-error($ret);
        last unless $e > 0;
    }

    $ret;
}

method accept {
    my $ret;

    loop {
        $ret = OpenSSL::SSL::SSL_accept($!ssl);

        my $e = $.handle-error($ret);
        last unless $e > 0;
    }

    $ret;
}

multi method write(Str $s) {
    $.write($s.encode);
}

multi method write(Blob $b) {
    my int32 $n = $b.bytes;
    my $ret;

    loop {
        $ret = OpenSSL::SSL::SSL_write($!ssl, $b, $n);

        my $e = $.handle-error($ret);
        last unless $e > 0;
    }

    $.bio-write;

    $ret;
}

method read(Int $n, Bool :$bin) {
    my int32 $count = $n;
    my $carray = buf8.allocate($n min 16384);
    my $total-read = 0;
    my $buf = buf8.new;
    loop {
        my $read = OpenSSL::SSL::SSL_read($!ssl, $carray, $count - $total-read);

        if $read > 0 {
            $buf.append($carray.subbuf(0, $read));
            $total-read += $read;
        }

        last if $total-read >= $n;

        my $e = 0;
        $e = $.handle-error($read) if $read < 0;
        last if $e <= 0 || $total-read >= $n;
    }

    return $bin ?? $buf !! $buf.decode('latin-1');
}

method use-certificate-file(Str $file) {
    # only PEM file so far : TODO : more file types
    if OpenSSL::Ctx::SSL_CTX_use_certificate_file($!ctx, $file, 1) <= 0 {
        die "Failed to set certificate file";
    }
}

method use-privatekey-file(Str $file) {
    # only PEM file so far : TODO : more file types
    if OpenSSL::Ctx::SSL_CTX_use_PrivateKey_file($!ctx, $file, 1) <= 0 {
        die "Failed to set PrivateKey file";
    }
}

method use-client-ca-file(Str $file, :$debug is copy) {
    unless my $ca-stack = OpenSSL::SSL::SSL_load_client_CA_file( CArray[uint8].new( $file.encode.list, 0 ) ) {
        my $e = OpenSSL::Err::ERR_get_error();
        die X::OpenSSL::Exception.new( message => "OpenSSL error $e -- " ~ OpenSSL::Err::ERR_error_string( $e, Nil ) );
    }

    if $debug || %*ENV<OPENSSL_CA_DEBUG> {
        $debug = $*ERR unless $debug ~~ IO::Handle;

        say $debug: "*** OPENSSL CA LIST -- LOADED ***";
        OpenSSL::X509::dump_x509_stack($ca-stack, :FH($debug));
    }

    OpenSSL::SSL::SSL_set_client_CA_list( $!ssl, $ca-stack );

    $ca-stack;
}

method get-client-ca-list (:$debug is copy) {
    my $ca-stack = OpenSSL::SSL::SSL_get_client_CA_list( $!ssl );

    if $debug || %*ENV<OPENSSL_CA_DEBUG> {
        $debug = $*ERR unless $debug ~~ IO::Handle;

        say $debug: "*** OPENSSL CA LIST ***";
        OpenSSL::X509::dump_x509_stack($ca-stack, :FH($debug));
    }

    $ca-stack;
}

method check-private-key {
    unless OpenSSL::Ctx::SSL_CTX_check_private_key($!ctx) {
        die "Private key does not match the public certificate";
    }
}

method shutdown {
    with $!ssl {
        OpenSSL::SSL::SSL_shutdown($!ssl);
    }
}

method ctx-free {
    with $!ctx {
        OpenSSL::Ctx::SSL_CTX_free($!ctx);
        $!ctx = Nil;
    }
}

method ssl-free {
    with $!ssl {
        OpenSSL::SSL::SSL_free($!ssl);
        if $.using-bio {
            # $.internal-bio is freed by the SSL_free call
            OpenSSL::Bio::BIO_free($.net-bio);
        }
        $!ssl = Nil;
    }
}

method close {
    until self.shutdown {};
    self.ssl-free;
    self.ctx-free;
    1;
}



head

use OpenSSL;
my $openssl = OpenSSL.new;
$openssl.set-fd(123);
$openssl.write("GET / HTTP/1.1\r\nHost: somehost\r\n\r\n");


A module which provides OpenSSL bindings, making us able to set up a TLS/SSL connection.


method new(Bool :$client = False, Int :$version?)


A constructor. Initializes OpenSSL library, sets method and context.
If $version is not specified, the highest possible version is negotiated.


Assings connection's file descriptor (file handle) $fd to the SSL object.


To get the $fd we should use C to set up the connection. (See L<NativeCall>)
I hope we will be able to use Raku's IO::Socket module instead of
connecting through C soon-ish.


Sets SSL object to connect (client) state.


Use it when you want to connect to SSL servers.


Sets SSL object to accept (server) state.


Use it when you want to provide an SSL server.


Connects to the server using $fd (passed using .set-fd).


Does all the SSL stuff like handshaking.


Sends $s to the other side (server/client).


method read(OpenSSL:, Int $n, Bool :$bin)


Reads $n bytes from the other side (server/client).


Bool :$bin if we want it to return Buf instead of Str.


method use-certificate-file(OpenSSL:, Str $file)


Assings a certificate (from file) to the SSL object.


method use-privatekey-file(OpenSSL:, Str $file)


Assings a private key (from file) to the SSL object.


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


OpenSSL

NAME

SYNOPSIS

DESCRIPTION

METHODS

method new

method set-fd

method set-connect-state

method set-accept-state

method connect

method accept

method write

method read

method use-certificate-file

method use-privatekey-file

method check-private-key

method shutdown

method ctx-free

method ssl-free

method close

SEE ALSO