Add ALPN, SNI, and negotiated protocol version support

doc/OpenSSL.rakudoc

@@ -8,9 +8,17 @@ OpenSSL - OpenSSL bindings
 
 =begin code :lang<raku>
 use OpenSSL;
-my $openssl = OpenSSL.new;
-$openssl.set-fd(123);
-$openssl.write("GET / HTTP/1.1\r\nHost: somehost\r\n\r\n");
+
+my $conn = IO::Socket::INET.new: :host<raku.org>, :port(443);
+
+my $openssl = OpenSSL.new(:client);
+$openssl.set-fd($conn.native-descriptor);
+
+$openssl.connect;
+
+$openssl.write("HEAD / HTTP/1.1\r\nHost: raku.org\r\n\r\n");
+say $openssl.read(1024);
+$openssl.close;
 =end code
 
 =head1 DESCRIPTION
@@ -23,23 +31,24 @@ TLS/SSL connection.
 =head2 method new
 
 =begin code :lang<raku>
-method new(Bool :$client = False, Int :$version?)
+method new(Bool :$client = False, ProtocolVersion :$version = -1)
 =end code
 
 A constructor. Initializes OpenSSL library, sets method and context.
-If $version is not specified, the highest possible version is negotiated.
+If C<$version> is not specified, the highest possible version is negotiated.
+
+For client connections, construct the object with C<:client> or call
+C<.set-connect-state> before C<.connect>.
 
 =head2 method set-fd
 
 =begin code :lang<raku>
 method set-fd(OpenSSL:, int32 $fd)
 =end code
 
-Assigns connection's file descriptor (file handle) $fd to the SSL object.
+Assigns connection's file descriptor (file handle) C<$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.
+This must be done before calling C<.connect> or C<.accept>.
 
 =head2 method set-connect-state
 
@@ -51,6 +60,9 @@ Sets SSL object to connect (client) state.
 
 Use it when you want to connect to SSL servers.
 
+If the object was not constructed with C<:client>, call this before
+C<.connect>.
+
 =head2 method set-accept-state
 
 =begin code :lang<raku>
@@ -67,10 +79,13 @@ Use it when you want to provide an SSL server.
 method connect(OpenSSL:)
 =end code
 
-Connects to the server using $fd (passed using .set-fd).
+Connects to the server using C<$fd> (passed using C<.set-fd>).
 
 Does all the SSL stuff like handshaking.
 
+For client connections, construct with C<:client> or call
+C<.set-connect-state> first.
+
 =head2 method accept
 
 =begin code :lang<raku>
@@ -87,33 +102,33 @@ Does all the SSL stuff like handshaking.
 method write(OpenSSL:, Str $s)
 =end code
 
-Sends $s to the other side (server/client).
+Sends C<$s> to the other side (server/client).
 
 =head2 method read
 
 =begin code :lang<raku>
 method read(OpenSSL:, Int $n, Bool :$bin)
 =end code
 
-Reads $n bytes from the other side (server/client).
+Reads C<$n> bytes from the other side (server/client).
 
-Bool :$bin if we want it to return Buf instead of Str.
+Use C<:$bin> if you want it to return C<Buf> instead of C<Str>.
 
 =head2 method use-certificate-file
 
 =begin code :lang<raku>
 method use-certificate-file(OpenSSL:, Str $file)
 =end code
 
-Assings a certificate (from file) to the SSL object.
+Assigns a certificate (from file) to the SSL object.
 
 =head2 method use-privatekey-file
 =begin code :lang<raku>
 method use-privatekey-file(OpenSSL:, Str $file)
 
 =end code
 
-Assings a private key (from file) to the SSL object.
+Assigns a private key (from file) to the SSL object.
 
 =head2 method check-private-key
 
@@ -123,6 +138,77 @@ method check-private-key(OpenSSL:)
 
 Checks if private key is valid.
 
+=head2 method version-code
+
+=begin code :lang<raku>
+method version-code(--> Int)
+=end code
+
+Returns the negotiated protocol version as an OpenSSL numeric constant.
+
+This method is useful after a successful C<.connect> or C<.accept>.
+
+=head2 method version-name
+
+=begin code :lang<raku>
+method version-name(--> Str)
+=end code
+
+Returns the negotiated protocol version as a string, for example
+C<TLSv1.2> or C<TLSv1.3>.
+
+This method is useful after a successful C<.connect> or C<.accept>.
+
+=head2 method protocol-version
+
+=begin code :lang<raku>
+method protocol-version(--> ProtocolVersion)
+=end code
+
+Returns the negotiated protocol version normalized to C<ProtocolVersion>.
+
+Returns one of the values accepted by C<ProtocolVersion>, including C<1.3>,
+or C<-1> if the negotiated version is unknown.
+
+This method is useful after a successful C<.connect> or C<.accept>.
+
+=head2 method set-sni-host-name
+
+=begin code :lang<raku>
+method set-sni-host-name(Str $host --> OpenSSL)
+=end code
+
+Sets the TLS SNI (Server Name Indication) host name.
+
+For client connections this should usually be called before C<.connect>,
+especially when connecting to virtual hosts or HTTPS servers by name.
+
+=head2 method set-alpn-protocols
+
+=begin code :lang<raku>
+method set-alpn-protocols(*@protos --> OpenSSL)
+=end code
+
+Sets the ALPN protocols offered by the client, for example
+C<h2> and C<http/1.1>.
+
+This must be called before C<.connect>.
+
+Each protocol must be non-empty and must not exceed 255 bytes.
+
+=head2 method selected-alpn
+
+=begin code :lang<raku>
+method selected-alpn(--> Str)
+=end code
+
+Returns the negotiated ALPN protocol as a string, for example C<h2> or
+C<http/1.1>.
+
+Returns C<Nil> if no ALPN protocol was selected.
+
+This method is useful after a successful C<.connect> or C<.accept>.
+
 =head2 method shutdown
 
 =begin code :lang<raku>
@@ -155,7 +241,7 @@ method close(OpenSSL:)
 
 Closes the connection.
 
-Unlike .shutdown it calls ssl-free, ctx-free, and then it shutdowns.
+Unlike C<.shutdown>, this also calls C<.ssl-free> and C<.ctx-free>.
 
 =head1 TOOLS
 

lib/OpenSSL.rakumod

@@ -25,7 +25,7 @@ class X::OpenSSL::Exception is Exception {
 }
 
 # SSLv2 | SSLv3 | TLSv1 | TLSv1.1 | TLSv1.2 | default
-subset ProtocolVersion of Numeric where * == 2| 3| 1| 1.1| 1.2| -1;
+subset ProtocolVersion of Numeric where * == 2| 3| 1| 1.1| 1.2| 1.3| -1;
 
 method new(Bool :$client = False, ProtocolVersion :$version = -1) {
 
@@ -309,6 +309,87 @@ method check-private-key {
     }
 }
 
+method protocol-version(--> ProtocolVersion) {
+    given self.version-code {
+        when 0x0300 { 3   }
+        when 0x0301 { 1   }
+        when 0x0302 { 1.1 }
+        when 0x0303 { 1.2 }
+        when 0x0304 { 1.3 }
+        default     { -1  }
+    }
+}
+
+method version-code(--> Int) {
+    with $!ssl {
+        OpenSSL::SSL::SSL_version($!ssl);
+    }
+}
+
+method version-name(--> Str) {
+    with $!ssl {
+        OpenSSL::SSL::SSL_get_version($!ssl);
+    }
+}
+
+method set-sni-host-name(Str $host --> OpenSSL) {
+    with $!ssl {
+        my $rc = OpenSSL::SSL::SSL_ctrl(
+            $!ssl,
+            OpenSSL::SSL::SSL_CTRL_SET_TLSEXT_HOSTNAME,
+            OpenSSL::SSL::TLSEXT_NAMETYPE_host_name,
+            $host
+        );
+        die X::OpenSSL::Exception.new(
+            message => 'SSL_ctrl failed'
+        ) if $rc == 0;
+
+        self
+    }
+}
+
+method set-alpn-protocols(*@protos --> OpenSSL) {
+    with $!ssl {
+        my $wire = Buf.new;
+
+        for @protos -> $proto {
+            my $enc = $proto.encode('ascii');
+
+            die X::OpenSSL::Exception.new(
+                message => "ALPN protocol must not be empty"
+            ) if $enc.elems == 0;
+
+            die X::OpenSSL::Exception.new(
+                message => "ALPN protocol too long (>255 bytes): $proto"
+            ) if $enc.elems > 255;
+
+            $wire.push: $enc.elems;
+            $wire.push: $enc;
+        }
+
+        my $rc = OpenSSL::SSL::SSL_set_alpn_protos($!ssl, $wire, $wire.elems);
+
+        die X::OpenSSL::Exception.new(
+            message => 'SSL_set_alpn_protos failed'
+        ) if $rc != 0;
+
+        self
+    }
+}
+
+method selected-alpn(--> Str) {
+    with $!ssl {
+        my $proto = CArray[CArray[uint8]].new;
+        $proto[0] = CArray[uint8].new;
+        my uint32 $len = 0;
+
+        OpenSSL::SSL::SSL_get0_alpn_selected($!ssl, $proto, $len);
+
+        return Nil if $len == 0;
+        buf8.new($proto[0][^$len]).decode('ascii')
+    }
+}
+
 method shutdown {
     with $!ssl {
         OpenSSL::SSL::SSL_shutdown($!ssl);

lib/OpenSSL/SSL.rakumod

@@ -8,6 +8,9 @@ use OpenSSL::Stack;
 
 use NativeCall;
 
+constant SSL_CTRL_SET_TLSEXT_HOSTNAME = 55;
+constant TLSEXT_NAMETYPE_host_name    = 0;
+
 class SSL is repr('CStruct') {
     has int32 $.version;
     has int32 $.type;
@@ -107,4 +110,28 @@ our sub SSL_ctrl(
   SSL, int32, long, Str
 --> long) is native(&ssl-lib) { ... }
 
+# const char *SSL_get_version(const SSL *ssl)
+our sub SSL_get_version(
+  SSL
+--> Str) is native(&ssl-lib) { ... }
+
+# int SSL_version(const SSL *s)
+our sub SSL_version(
+  SSL
+--> int32) is native(&ssl-lib) { ... }
+
+# int SSL_set_alpn_protos(SSL *ssl, const unsigned char *protos,
+#                         unsigned int protos_len)
+our sub SSL_set_alpn_protos(
+  SSL, Buf, uint32
+--> int32) is native(&ssl-lib) { ... }
+
+# void SSL_get0_alpn_selected(const SSL *ssl, const unsigned char **data,
+#                             unsigned int *len)
+our sub SSL_get0_alpn_selected(
+  SSL,
+  CArray[CArray[uint8]],
+  uint32 is rw
+) is native(&ssl-lib) { ... }
+
 # vim: expandtab shiftwidth=4