
(********************************************************************)
(*                                                                  *)
(*  tls.s7i       Support for Transport Layer Security (TLS/SSL).   *)
(*  Copyright (C) 2013 - 2018  Thomas Mertes                        *)
(*                                                                  *)
(*  This file is part of the Seed7 Runtime Library.                 *)
(*                                                                  *)
(*  The Seed7 Runtime Library is free software; you can             *)
(*  redistribute it and/or modify it under the terms of the GNU     *)
(*  Lesser General Public License as published by the Free Software *)
(*  Foundation; either version 2.1 of the License, or (at your      *)
(*  option) any later version.                                      *)
(*                                                                  *)
(*  The Seed7 Runtime Library is distributed in the hope that it    *)
(*  will be useful, but WITHOUT ANY WARRANTY; without even the      *)
(*  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR *)
(*  PURPOSE.  See the GNU Lesser General Public License for more    *)
(*  details.                                                        *)
(*                                                                  *)
(*  You should have received a copy of the GNU Lesser General       *)
(*  Public License along with this program; if not, write to the    *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


include "socket.s7i";
include "asn1.s7i";
include "x509cert.s7i";
include "hmac.s7i";
include "cipher.s7i";
include "arc4.s7i";
include "des.s7i";
include "tdes.s7i";
include "aes.s7i";


const type: cipherSuite is integer;

const cipherSuite: TLS_NULL_WITH_NULL_NULL         is 16#0000;
const cipherSuite: TLS_RSA_WITH_RC4_128_MD5        is 16#0004;
const cipherSuite: TLS_RSA_WITH_RC4_128_SHA        is 16#0005;
const cipherSuite: TLS_RSA_WITH_DES_CBC_SHA        is 16#0009;
const cipherSuite: TLS_RSA_WITH_3DES_EDE_CBC_SHA   is 16#000a; # Mandatory TLS 1.1 Cipher
const cipherSuite: TLS_RSA_WITH_AES_128_CBC_SHA    is 16#002f; # Mandatory TLS 1.2 Cipher
const cipherSuite: TLS_RSA_WITH_AES_256_CBC_SHA    is 16#0035;
const cipherSuite: TLS_RSA_WITH_AES_128_CBC_SHA256 is 16#003c;
const cipherSuite: TLS_RSA_WITH_AES_256_CBC_SHA256 is 16#003d;

const array cipherSuite: supportedCiphers is [] (
    TLS_RSA_WITH_3DES_EDE_CBC_SHA,
    TLS_RSA_WITH_RC4_128_SHA,
    TLS_RSA_WITH_RC4_128_MD5,
    TLS_RSA_WITH_DES_CBC_SHA,
    TLS_RSA_WITH_AES_128_CBC_SHA,
    TLS_RSA_WITH_AES_256_CBC_SHA,
    TLS_RSA_WITH_AES_128_CBC_SHA256,
    TLS_RSA_WITH_AES_256_CBC_SHA256
  );

const string: SSL_3_0 is "\3;\0;";
const string: TLS_1_0 is "\3;\1;";
const string: TLS_1_1 is "\3;\2;";
const string: TLS_1_2 is "\3;\3;";

const type: tlsParameters is new struct
    var boolean:             isClient                is TRUE;
    var string:              session_id              is "";
    var string:              hostName                is "";
    var cipherSuite:         cipher_suite            is TLS_NULL_WITH_NULL_NULL;
    var cipherAlgorithm:     bulk_cipher_algorithm   is NO_CIPHER;
    var boolean:             block_cipher            is FALSE;
    var integer:             key_size                is 0;
    var integer:             key_material_length     is 0;
    var integer:             block_size              is 0;
    var boolean:             is_exportable           is FALSE;
    var digestAlgorithm:     mac_algorithm           is NO_DIGEST;
    var integer:             hash_size               is 0;
    var integer:             compression_algorithm   is 0;
    var string:              tls_version             is TLS_1_2;  # TLS_1_0;
    var string:              master_secret           is ""; # length: 48
    var string:              client_random           is ""; # length: 32
    var string:              server_random           is ""; # length: 32
    var certAndKey:          serverCertificates      is certAndKey.value;
    var rsaKey:              publicCertificateKey    is rsaKey.value;
    var rsaKey:              privateCertificateKey   is rsaKey.value;
    var string:              readMacSecret           is "";
    var string:              writeMacSecret          is "";
    var cipherState:         readCipherState         is cipherState.value;
    var cipherState:         writeCipherState        is cipherState.value;
    var integer:             readSequenceNumber      is 0;
    var integer:             writeSequenceNumber     is 0;
    var boolean:             writeEncryptedRecords   is FALSE;
    var string:              handshake_messages      is "";
  end struct;

const char: NO_MESSAGE         is EOF;
const char: CHANGE_CIPHER_SPEC is '\20;';
const char: ALERT              is '\21;';
const char: HANDSHAKE          is '\22;';
const char: APPLICATION_DATA   is '\23;';

const char: CLIENT_HELLO        is '\1;';
const char: SERVER_HELLO        is '\2;';
const char: SESSION_TICKET      is '\4;';
const char: CERTIFICATE         is '\11;';
const char: SERVER_KEY_EXCHANGE is '\12;';
const char: CERTIFICATE_REQUEST is '\13;';
const char: SERVER_HELLO_DONE   is '\14;';
const char: CERTIFICATE_VERIFY  is '\15;';
const char: CLIENT_KEY_EXCHANGE is '\16;';
const char: FINISHED            is '\20;';

const char: CLOSE_NOTIFY        is '\0;';
const char: UNEXPECTED_MESSAGE  is '\10;';
const char: BAD_RECORD_MAC      is '\20;';
const char: DECRYPTION_FAILED   is '\21;';
const char: HANDSHAKE_FAILURE   is '\40;';
const char: PROCOCOL_VERSION    is '\70;';
const char: NO_RENEGOTIATION    is '\100;';

# Extensions:
const integer: SERVER_NAME                            is     0;  # RFC6066
const integer: MAX_FRAGMENT_LENGTH                    is     1;  # RFC6066
const integer: CLIENT_CERTIFICATE_URL                 is     2;  # RFC6066
const integer: TRUSTED_CA_KEYS                        is     3;  # RFC6066
const integer: TRUNCATED_HMAC                         is     4;  # RFC6066
const integer: STATUS_REQUEST                         is     5;  # RFC6066
const integer: USER_MAPPING                           is     6;  # RFC4681
const integer: CLIENT_AUTHZ                           is     7;  # RFC5878
const integer: SERVER_AUTHZ                           is     8;  # RFC5878
const integer: CERT_TYPE                              is     9;  # RFC6091
const integer: ELLIPTIC_CURVES                        is    10;  # RFC4492
const integer: EC_POINT_FORMATS                       is    11;  # RFC4492
const integer: SRP                                    is    12;  # RFC5054
const integer: SIGNATURE_ALGORITHMS                   is    13;  # RFC5246
const integer: USE_SRTP                               is    14;  # RFC5764
const integer: HEARTBEAT                              is    15;  # RFC6520
const integer: APPLICATION_LAYER_PROTOCOL_NEGOTIATION is    16;  # RFC7301
const integer: STATUS_REQUEST_V2                      is    17;  # RFC6961
const integer: SIGNED_CERTIFICATE_TIMESTAMP           is    18;  # RFC6962
const integer: CLIENT_CERTIFICATE_TYPE                is    19;  # RFC7250
const integer: SERVER_CERTIFICATE_TYPE                is    20;  # RFC7250
const integer: PADDING                                is    21;
const integer: ENCRYPT_THEN_MAC                       is    22;  # RFC7366
const integer: EXTENDED_MASTER_SECRET                 is    23;
const integer: SESSION_TICKET_TLS                     is    35;  # RFC4507
const integer: NEXT_PROTOCOL_NEGOTIATION              is 13172;
const integer: RENEGOTIATION_INFO                     is 65281;  # RFC5746

const type: tlsParseState is new struct
    var char: contentType is NO_MESSAGE;
    var integer: length is 0;
    var string: message is "";
    var integer: pos is 1;
    var char: alert is CLOSE_NOTIFY;
  end struct;

const type: tlsFile is sub null_file struct
    var file: sock is STD_NULL;
    var tlsParseState: parseState is tlsParseState.value;
    var tlsParameters: parameters is tlsParameters.value;
    var string: readBuffer is "";
  end struct;

const type: clientSession is new struct
    var string:              session_id              is "";
    var cipherAlgorithm:     bulk_cipher_algorithm   is NO_CIPHER;
    var string:              master_secret           is "";
    var time:                last_use                is time.value;
  end struct;

const duration: clientCacheValid is 1 . MINUTES;
const type: clientSessionCacheType is hash [socketAddress] clientSession;

var clientSessionCacheType: clientSessionCache is clientSessionCacheType.value;

const string: MD5_PAD1 is "\16#36;" mult 48;
const string: MD5_PAD2 is "\16#5c;" mult 48;
const string: SHA_PAD1 is "\16#36;" mult 40;
const string: SHA_PAD2 is "\16#5c;" mult 40;


const proc: showChangeCipherSpec (in string: stri) is func
  begin
    writeln("change_cipher_spec");
    writeln("type: " <& ord(stri[6]));
  end func;


const proc: showAlert (in string: stri) is func
  begin
    writeln("alert");
    writeln("Version: " <& ord(stri[2]) <& "." <& ord(stri[3]));
    writeln("Length: " <& bytes2Int(stri[4 len 2], UNSIGNED, BE));
    writeln("level: " <& ord(stri[6]));
    write("description: " <& ord(stri[7]));
    case ord(stri[7]) of
      when {  0}: write(" - close_notify");
      when { 10}: write(" - unexpected_message");
      when { 20}: write(" - bad_record_mac");
      when { 21}: write(" - decryption_failed");
      when { 22}: write(" - record_overflow");
      when { 30}: write(" - decompression_failure");
      when { 40}: write(" - handshake_failure");
      when { 41}: write(" - no_certificate");
      when { 42}: write(" - bad_certificate");
      when { 43}: write(" - unsupported_certificate");
      when { 44}: write(" - certificate_revoked");
      when { 45}: write(" - certificate_expired");
      when { 46}: write(" - certificate_unknown");
      when { 47}: write(" - illegal_parameter");
      when { 48}: write(" - unknown_ca");
      when { 49}: write(" - access_denied");
      when { 50}: write(" - decode_error");
      when { 51}: write(" - decrypt_error");
      when { 60}: write(" - export_restriction");
      when { 70}: write(" - protocol_version");
      when { 71}: write(" - insufficient_security");
      when { 80}: write(" - internal_error");
      when { 86}: write(" - inappropriate_fallback");
      when { 90}: write(" - user_canceled");
      when {100}: write(" - no_renegotiation");
      when {110}: write(" - unsupported_extension");
      when {111}: write(" - certificate_unobtainable");
      when {112}: write(" - unrecognized_name");
      when {113}: write(" - bad_certificate_status_response");
      when {114}: write(" - bad_certificate_hash_value");
    end case;
    writeln;
  end func;


const proc: showExtensions (in string: stri, inout integer: pos) is func
  local
    var integer: extensionBytes is 0;
    var integer: beyond is 0;
    var integer: index is 0;
    var integer: extensionType is 0;
    var integer: dataSize is 0;
  begin
    extensionBytes := bytes2Int(stri[pos len 2], UNSIGNED, BE);
    writeln("Extension bytes: " <& extensionBytes);
    pos +:= 2;
    beyond := pos + extensionBytes;
    index := 1;
    while pos < beyond do
      write("Extension-" <& index <& ": ");
      extensionType := bytes2Int(stri[pos len 2], UNSIGNED, BE);
      pos +:= 2;
      case extensionType of
        when {SERVER_NAME}:                            writeln("server_name");
        when {MAX_FRAGMENT_LENGTH}:                    writeln("max_fragment_length");
        when {CLIENT_CERTIFICATE_URL}:                 writeln("client_certificate_url");
        when {TRUSTED_CA_KEYS}:                        writeln("trusted_ca_keys");
        when {TRUNCATED_HMAC}:                         writeln("truncated_hmac");
        when {STATUS_REQUEST}:                         writeln("status_request");
        when {USER_MAPPING}:                           writeln("user_mapping");
        when {CLIENT_AUTHZ}:                           writeln("client_authz");
        when {SERVER_AUTHZ}:                           writeln("server_authz");
        when {CERT_TYPE}:                              writeln("cert_type");
        when {ELLIPTIC_CURVES}:                        writeln("elliptic_curves");
        when {EC_POINT_FORMATS}:                       writeln("ec_point_formats");
        when {SRP}:                                    writeln("srp");
        when {SIGNATURE_ALGORITHMS}:                   writeln("signature_algorithms");
        when {USE_SRTP}:                               writeln("use_srtp");
        when {HEARTBEAT}:                              writeln("heartbeat");
        when {APPLICATION_LAYER_PROTOCOL_NEGOTIATION}: writeln("application_layer_protocol_negotiation");
        when {STATUS_REQUEST_V2}:                      writeln("status_request_v2");
        when {SIGNED_CERTIFICATE_TIMESTAMP}:           writeln("signed_certificate_timestamp");
        when {CLIENT_CERTIFICATE_TYPE}:                writeln("client_certificate_type");
        when {SERVER_CERTIFICATE_TYPE}:                writeln("server_certificate_type");
        when {PADDING}:                                writeln("padding");
        when {ENCRYPT_THEN_MAC}:                       writeln("encrypt_then_mac");
        when {EXTENDED_MASTER_SECRET}:                 writeln("extended_master_secret");
        when {SESSION_TICKET_TLS}:                     writeln("SessionTicket TLS");
        when {NEXT_PROTOCOL_NEGOTIATION}:              writeln("next_protocol_negotiation");
        when {RENEGOTIATION_INFO}:                     writeln("renegotiation_info");
        otherwise:                                     writeln(extensionType);
      end case;
      dataSize := bytes2Int(stri[pos len 2], UNSIGNED, BE);
      pos +:= 2;
      writeln("Data: " <& literal(stri[pos len dataSize]));
      pos +:= dataSize;
      incr(index);
    end while;
  end func;


const proc: showClientHello (in string: stri, inout integer: pos) is func
  local
    var integer: length is 0;
    var integer: beyond is 0;
    var integer: vectorLen is 0;
    var integer: index is 0;
  begin
    writeln("client_hello");
    length := bytes2Int(stri[pos len 3], UNSIGNED, BE);
    pos +:= 3;
    writeln("Length: " <& length);
    beyond := pos + length;
    writeln("Bytes there: " <& length(stri) - pos + 1);
    writeln("Version: " <& ord(stri[pos]) <& "." <& ord(stri[succ(pos)]));
    pos +:= 2;
    writeln("Random: " <& hex(stri[12 len 32]));
    pos +:= 32;
    vectorLen := ord(stri[pos]);
    incr(pos);
    writeln("SessionId: " <& hex(stri[pos len vectorLen]));
    pos +:= vectorLen;
    vectorLen := bytes2Int(stri[pos len 2], UNSIGNED, BE) div 2;
    writeln("Number of Ciphers: " <& vectorLen);
    pos +:= 2;
    for index range 1 to vectorLen do
      writeln("Cipher-" <& index <& ": " <&
              bytes2Int(stri[pos len 2], UNSIGNED, BE) radix 16 lpad0 4);
      pos +:= 2;
    end for;
    vectorLen := ord(stri[pos]);
    writeln("Number of CompressionMethods: " <& vectorLen);
    incr(pos);
    for index range 1 to vectorLen do
      writeln("CompressionMethod-" <& index <& ": " <& ord(stri[pos]));
      incr(pos);
    end for;
    if pos <= beyond - 2 then
      showExtensions(stri, pos);
    end if;
    writeln("Final pos: " <& pos);
    writeln("Leftover bytes: " <& literal(stri[pos ..]));
  end func;


const proc: showServerHello (in string: stri, inout integer: pos) is func
  local
    var integer: length is 0;
    var integer: beyond is 0;
    var integer: sessionIdLen is 0;
  begin
    writeln("server_hello");
    length := bytes2Int(stri[pos len 3], UNSIGNED, BE);
    pos +:= 3;
    writeln("Length: " <& length);
    beyond := pos + length;
    writeln("Bytes there: " <& length(stri) - pos + 1);
    writeln("Version: " <& ord(stri[pos]) <& "." <& ord(stri[succ(pos)]));
    pos +:= 2;
    writeln("Random: " <& hex(stri[12 len 32]));
    pos +:= 32;
    sessionIdLen := ord(stri[pos]);
    incr(pos);
    writeln("SessionId: " <& hex(stri[pos len sessionIdLen]));
    pos +:= sessionIdLen;
    writeln("Cipher: " <&
            bytes2Int(stri[pos len 2], UNSIGNED, BE) radix 16 lpad0 4);
    pos +:= 2;
    writeln("CompressionMethod: " <& ord(stri[pos]));
    incr(pos);
    if pos <= beyond - 2 then
      showExtensions(stri, pos);
    end if;
    writeln("Final pos: " <& pos);
    writeln("Leftover bytes: " <& literal(stri[pos ..]));
  end func;


const proc: showX509Cert (in x509cert: cert) is func
  local
    var integer: pos is 1;
    var string: publicKey is "";
  begin
    writeln("Algorithm: " <& literal(cert.tbsCertificate.subjectPublicKeyInfo.algorithm.algorithm));
    writeln("Public key: " <& literal(cert.tbsCertificate.subjectPublicKeyInfo.subjectPublicKey));
    publicKey := cert.tbsCertificate.subjectPublicKeyInfo.subjectPublicKey;
    while pos < length(publicKey) do
      printAsn1(publicKey, pos);
    end while;
    writeln("rsa public key modulus:  " <& cert.tbsCertificate.subjectPublicKeyInfo.publicRsaKey.modulus radix 16);
    writeln("rsa public modulus len:  " <& bitLength(cert.tbsCertificate.subjectPublicKeyInfo.publicRsaKey.modulus));
    writeln("rsa public key exponent: " <& cert.tbsCertificate.subjectPublicKeyInfo.publicRsaKey.exponent radix 16);
  end func;


const proc: showCertificate (in string: stri, inout integer: pos) is func
  local
    var integer: length is 0;
    var integer: sequenceLen is 0;
    var integer: certLen is 0;
    var integer: index is 1;
    var x509cert: cert is x509cert.value;
    var array x509cert: certList is 0 times x509cert.value;
  begin
    writeln("certificate: " <& literal(stri));
    length := bytes2Int(stri[pos len 3], UNSIGNED, BE);
    pos +:= 3;
    writeln("Length: " <& length);
    writeln("Bytes there: " <& length(stri) - pos + 1);
    sequenceLen := bytes2Int(stri[pos len 3], UNSIGNED, BE);
    pos +:= 3;
    writeln("Sequence length: " <& sequenceLen);
    writeln("Bytes there: " <& length(stri) - pos + 1);
    while pos <= 3 + sequenceLen do
      certLen := bytes2Int(stri[pos len 3], UNSIGNED, BE);
      pos +:= 3;
      writeln("ASN.1Cert-" <& index <& " length: " <& certLen);
      writeln("ASN.1Cert-" <& index <& ": " <& literal(stri[pos len certLen]));
      printAsn1(stri[pos len certLen]);
      cert := getX509Cert(stri[pos len certLen]);
      showX509Cert(cert);
      certList &:= cert;
      pos +:= certLen;
      incr(index);
    end while;
    writeln("Final pos: " <& pos);
    writeln("Leftover bytes: " <& literal(stri[pos ..]));
    for index range 1 to pred(length(certList)) do
      writeln("validate Cert-" <& index <& " with Cert-" <& succ(index));
      writeln(validateSignature(certList[index], certList[succ(index)].tbsCertificate.subjectPublicKeyInfo.publicRsaKey));
    end for;
    # writeln("validate Cert-" <& length(certList) <& " with Cert-" <& length(certList));
    # writeln(validateSignature(certList[length(certList)], certList[length(certList)].tbsCertificate.subjectPublicKeyInfo.publicRsaKey));
    # publicKey := certList[1].tbsCertificate.subjectPublicKeyInfo.publicRsaKey;
  end func;


const proc: showServerKeyExchange (in string: stri, inout integer: pos) is func
  local
    var integer: length is 0;
  begin
    writeln("server_key_exchange");
    length := bytes2Int(stri[pos len 3], UNSIGNED, BE);
    pos +:= 3;
    writeln("Length: " <& length);
    writeln("Bytes there: " <& length(stri) - pos + 1);
    writeln("exchange_keys: " <& hex(stri[pos len length]));
    pos +:= length;
    writeln("Final pos: " <& pos);
    writeln("Leftover bytes: " <& literal(stri[pos ..]));
  end func;


const proc: showCertificateRequest (in string: stri, inout integer: pos) is func
  local
    var integer: length is 0;
    var integer: index is 0;
  begin
    writeln("certificate_request");
    length := bytes2Int(stri[pos len 3], UNSIGNED, BE);
    pos +:= 3;
    writeln("length: " <& length);
    writeln("Bytes there: " <& length(stri) - pos + 1);
    writeln("Version: " <& ord(stri[pos]) <& "." <& ord(stri[succ(pos)]));
    pos +:= 2;
    length := ord(stri[pos]);
    incr(pos);
    writeln("length: " <& length);
  end func;


const proc: showServerHelloDone (in string: stri, inout integer: pos) is func
  local
    var integer: length is 0;
  begin
    writeln("server_hello_done");
    length := bytes2Int(stri[pos len 3], UNSIGNED, BE);
    pos +:= 3;
    writeln("Length: " <& length);
    writeln("Bytes there: " <& length(stri) - pos + 1);
    writeln("Final pos: " <& pos);
    writeln("Leftover bytes: " <& literal(stri[pos ..]));
  end func;


const proc: showClientKeyExchange (in string: stri, inout integer: pos) is func
  local
    var integer: length is 0;
  begin
    writeln("client_key_exchange");
    length := bytes2Int(stri[pos len 3], UNSIGNED, BE);
    pos +:= 3;
    writeln("Length: " <& length);
    writeln("Bytes there: " <& length(stri) - pos + 1);
    writeln("exchange_keys: " <& hex(stri[pos len length]));
    pos +:= length;
    writeln("Final pos: " <& pos);
    writeln("Leftover bytes: " <& literal(stri[pos ..]));
  end func;


const proc: showFinished (in string: stri, inout integer: pos) is func
  local
    var integer: length is 0;
  begin
    writeln("finished");
    length := bytes2Int(stri[pos len 3], UNSIGNED, BE);
    pos +:= 3;
    writeln("Length: " <& length);
    writeln("Bytes there: " <& length(stri) - pos + 1);
    writeln("verify_data: " <& hex(stri[pos len length]));
    pos +:= length;
    writeln("Final pos: " <& pos);
    writeln("Leftover bytes: " <& literal(stri[pos ..]));
  end func;


const proc: showHandshakeMsg (in string: stri, in var integer: pos) is func
  local
    var char: handshakeType is ' ';
  begin
    handshakeType := stri[pos];
    incr(pos);
    write("HandshakeType: ");
    if handshakeType = CLIENT_HELLO then
      showClientHello(stri, pos);
    elsif handshakeType = SERVER_HELLO then
      showServerHello(stri, pos);
    elsif handshakeType = CERTIFICATE then
      showCertificate(stri, pos);
    elsif handshakeType = SERVER_KEY_EXCHANGE then
      showServerKeyExchange(stri, pos);
    elsif handshakeType = CERTIFICATE_REQUEST then
      showCertificateRequest(stri, pos);
    elsif handshakeType = SERVER_HELLO_DONE then
      showServerHelloDone(stri, pos);
    elsif handshakeType = CLIENT_KEY_EXCHANGE then
      showClientKeyExchange(stri, pos);
    elsif handshakeType = FINISHED then
      showFinished(stri, pos);
    else
      writeln(ord(handshakeType));
    end if;
  end func;


const proc: showHandshake (in string: stri) is func
  begin
    writeln("handshake");
    writeln("Version: " <& ord(stri[2]) <& "." <& ord(stri[3]));
    writeln("Length: " <& bytes2Int(stri[4 len 2], UNSIGNED, BE));
    writeln("Bytes there: " <& length(stri) - 5);
    if bytes2Int(stri[4 len 2], UNSIGNED, BE) <> length(stri) - 5 then
      writeln(" ***** TLS record length not ok");
    end if;
    if bytes2Int(stri[7 len 3], UNSIGNED, BE) > length(stri) - 9 then
      writeln(" ***** TLS handshake length not ok");
      writeln("handshake length field: " <& literal(stri[7 len 3]));
      writeln("handshake length from field: " <& bytes2Int(stri[7 len 3], UNSIGNED, BE));
      writeln("actual length: " <& length(stri) - 9);
      writeln("record length field: " <& literal(stri[4 len 2]));
      writeln("HandshakeType: " <& ord(stri[6]));
    else
      showHandshakeMsg(stri, 6);
    end if;
  end func;


const proc: showApplicationData (in string: stri) is func
  begin
    writeln("application data");
    writeln("Version: " <& ord(stri[2]) <& "." <& ord(stri[3]));
    writeln("Length: " <& bytes2Int(stri[4 len 2], UNSIGNED, BE));
    writeln("Bytes there: " <& length(stri) - 5);
    writeln("Data: " <& literal(stri[6 ..]));
  end func;


const proc: showTlsMsg (in string: stri) is func
  begin
    writeln("MsgLength: " <& length(stri));
    if length(stri) <> 0 then
      write("ContentType: ");
      if stri[1] = CHANGE_CIPHER_SPEC then
        showChangeCipherSpec(stri);
      elsif stri[1] = ALERT then
        showAlert(stri);
      elsif stri[1] = HANDSHAKE then
        showHandshake(stri);
      elsif stri[1] = APPLICATION_DATA then
        showApplicationData(stri);
      else
        writeln(ord(stri[1]));
        writeln("Final pos: 1");
        writeln("Leftover bytes: " <& literal(stri));
      end if;
    end if;
  end func;


const proc: showTlsMsgType (in string: stri) is func
  begin
    if length(stri) <> 0 then
      if stri[1] = CHANGE_CIPHER_SPEC then
        writeln("ChangeCipherSpec");
      elsif stri[1] = ALERT then
        writeln("Alert");
      elsif stri[1] = HANDSHAKE then
        if stri[6] = CLIENT_HELLO then
          writeln("ClientHello");
        elsif stri[6] = SERVER_HELLO then
          writeln("ServerHello");
        elsif stri[6] = SESSION_TICKET then
          writeln("NewSessionTicket");
        elsif stri[6] = CERTIFICATE then
          writeln("Certificate");
        elsif stri[6] = SERVER_KEY_EXCHANGE then
          writeln("ServerKeyExchange");
        elsif stri[6] = CERTIFICATE_REQUEST then
          writeln("CertificateRequest");
        elsif stri[6] = SERVER_HELLO_DONE then
          writeln("ServerHelloDone");
        elsif stri[6] = CLIENT_KEY_EXCHANGE then
          writeln("ClientKeyExchange");
        elsif stri[6] = FINISHED then
          writeln("Finished");
        else
          writeln("Handshake " <& ord(stri[6]));
        end if;
      elsif stri[1] = APPLICATION_DATA then
        writeln("ApplicationData");
      else
        writeln(ord(stri[1]));
      end if;
    end if;
  end func;


const proc: storeCipherSuite (inout tlsParameters: parameters) is func
  begin
    # writeln("cipher_suite: " <& ord(parameters.cipher_suite) radix 16 lpad0 4);
    if parameters.cipher_suite = TLS_NULL_WITH_NULL_NULL then
      parameters.bulk_cipher_algorithm := NO_CIPHER;
      parameters.key_material_length := 0;
      parameters.mac_algorithm := NO_DIGEST;
    elsif parameters.cipher_suite = TLS_RSA_WITH_RC4_128_MD5 then
      parameters.bulk_cipher_algorithm := RC4;
      parameters.key_material_length := 16;
      parameters.mac_algorithm := MD5;
    elsif parameters.cipher_suite = TLS_RSA_WITH_RC4_128_SHA then
      parameters.bulk_cipher_algorithm := RC4;
      parameters.key_material_length := 16;
      parameters.mac_algorithm := SHA1;
    elsif parameters.cipher_suite = TLS_RSA_WITH_3DES_EDE_CBC_SHA then
      parameters.bulk_cipher_algorithm := TDES;
      parameters.key_material_length := 24;
      parameters.mac_algorithm := SHA1;
    elsif parameters.cipher_suite = TLS_RSA_WITH_DES_CBC_SHA then
      parameters.bulk_cipher_algorithm := DES;
      parameters.key_material_length := 8;
      parameters.mac_algorithm := SHA1;
    elsif parameters.cipher_suite = TLS_RSA_WITH_AES_128_CBC_SHA then
      parameters.bulk_cipher_algorithm := AES;
      parameters.key_material_length := 16;
      parameters.mac_algorithm := SHA1;
    elsif parameters.cipher_suite = TLS_RSA_WITH_AES_256_CBC_SHA then
      parameters.bulk_cipher_algorithm := AES;
      parameters.key_material_length := 32;
      parameters.mac_algorithm := SHA1;
    elsif parameters.cipher_suite = TLS_RSA_WITH_AES_128_CBC_SHA256 then
      parameters.bulk_cipher_algorithm := AES;
      parameters.key_material_length := 16;
      parameters.mac_algorithm := SHA256;
    elsif parameters.cipher_suite = TLS_RSA_WITH_AES_256_CBC_SHA256 then
      parameters.bulk_cipher_algorithm := AES;
      parameters.key_material_length := 32;
      parameters.mac_algorithm := SHA256;
    else
      writeln("Unsupported cipher_suite: " <& ord(parameters.cipher_suite) radix 16 lpad0 4);
      # raise RANGE_ERROR;
    end if;
    parameters.block_size := blockSize(parameters.bulk_cipher_algorithm);
    parameters.hash_size := digestSize(parameters.mac_algorithm);
  end func;


const proc: computeMasterSecret (inout tlsParameters: parameters,
    in string: preMasterSecret) is func
  begin
    # writeln("preMasterSecret: " <& hex(preMasterSecret));
    if parameters.tls_version = SSL_3_0 then
      parameters.master_secret := keyBlockFunction(preMasterSecret,
          parameters.client_random & parameters.server_random, 48);
    elsif parameters.tls_version = TLS_1_2 then
      parameters.master_secret := p_hash(SHA256, preMasterSecret,
          "master secret" & parameters.client_random & parameters.server_random, 48);
    else
      parameters.master_secret := pseudoRandomFunction(preMasterSecret,
          "master secret", parameters.client_random & parameters.server_random, 48);
    end if;
    # writeln("master_secret: " <& hex(parameters.master_secret));
  end func;


const proc: storeKeys (inout tlsParameters: parameters) is func
  local
    var string: key_block is "";
    var integer: key_block_pos is 1;
    var string: client_write_MAC_secret is "";
    var string: server_write_MAC_secret is "";
    var string: client_write_key is "";
    var string: server_write_key is "";
    var string: client_initialization_vector is "";
    var string: server_initialization_vector is "";
  begin
    # writeln("client_random: " <& hex(parameters.client_random));
    # writeln("server_random: " <& hex(parameters.server_random));
    if parameters.tls_version = SSL_3_0 then
      key_block := keyBlockFunction(parameters.master_secret,
          parameters.server_random & parameters.client_random,
          2 * parameters.hash_size + 2 * parameters.key_material_length + 2 * parameters.block_size);
    elsif parameters.tls_version = TLS_1_2 then
      key_block := p_hash(SHA256, parameters.master_secret,
          "key expansion" & parameters.server_random & parameters.client_random,
          2 * parameters.hash_size + 2 * parameters.key_material_length + 2 * parameters.block_size);
    else
      key_block := pseudoRandomFunction(parameters.master_secret,
          "key expansion", parameters.server_random & parameters.client_random,
          2 * parameters.hash_size + 2 * parameters.key_material_length + 2 * parameters.block_size);
    end if;
    # writeln("key_block: " <& hex(key_block));
    # writeln("length(key_block): " <& length(key_block));
    client_write_MAC_secret := key_block[key_block_pos len parameters.hash_size];
    key_block_pos +:= parameters.hash_size;
    server_write_MAC_secret := key_block[key_block_pos len parameters.hash_size];
    key_block_pos +:= parameters.hash_size;
    client_write_key := key_block[key_block_pos len parameters.key_material_length];
    key_block_pos +:= parameters.key_material_length;
    server_write_key := key_block[key_block_pos len parameters.key_material_length];
    key_block_pos +:= parameters.key_material_length;
    client_initialization_vector := key_block[key_block_pos len parameters.block_size];
    key_block_pos +:= parameters.block_size;
    server_initialization_vector := key_block[key_block_pos len parameters.block_size];
    # writeln("client_write_MAC_secret: " <& hex(client_write_MAC_secret));
    # writeln("server_write_MAC_secret: " <& hex(server_write_MAC_secret));
    # writeln("client_write_key: " <& hex(client_write_key));
    # writeln("server_write_key: " <& hex(server_write_key));
    if parameters.isClient then
      parameters.readMacSecret := server_write_MAC_secret;
      parameters.writeMacSecret := client_write_MAC_secret;
      parameters.readCipherState := setCipherKey(parameters.bulk_cipher_algorithm,
          server_write_key, server_initialization_vector);
      parameters.writeCipherState := setCipherKey(parameters.bulk_cipher_algorithm,
          client_write_key, client_initialization_vector);
    else
      parameters.readMacSecret := client_write_MAC_secret;
      parameters.writeMacSecret := server_write_MAC_secret;
      parameters.readCipherState := setCipherKey(parameters.bulk_cipher_algorithm,
          client_write_key, client_initialization_vector);
      parameters.writeCipherState := setCipherKey(parameters.bulk_cipher_algorithm,
          server_write_key, server_initialization_vector);
    end if;
  end func;


const proc: processCertificate (inout tlsParameters: parameters, inout tlsParseState: state) is func
  local
    var integer: startPos is 0;
    var integer: sequenceLen is 0;
    var integer: certLen is 0;
    var integer: index is 1;
    var x509cert: cert is x509cert.value;
  begin
    # writeln("certificate");
    startPos := state.pos;
    state.pos +:= 4;
    sequenceLen := bytes2Int(state.message[state.pos len 3], UNSIGNED, BE);
    state.pos +:= 3;
    while state.pos <= 3 + sequenceLen do
      certLen := bytes2Int(state.message[state.pos len 3], UNSIGNED, BE);
      state.pos +:= 3;
      parameters.serverCertificates.certList &:= [] (state.message[state.pos len certLen]);
      state.pos +:= certLen;
    end while;
    cert := getX509Cert(parameters.serverCertificates.certList[1]);
    # showX509Cert(cert);
    parameters.serverCertificates.privateKey := cert.tbsCertificate.subjectPublicKeyInfo.publicRsaKey;
    parameters.publicCertificateKey := parameters.serverCertificates.privateKey;
    parameters.handshake_messages &:= state.message[startPos .. pred(state.pos)];
  end func;


const proc: processClientHello (inout tlsParameters: parameters, inout tlsParseState: state) is func
  local
    var integer: startPos is 0;
    var integer: length is 0;
    var integer: beyond is 0;
    var integer: sessionIdLen is 0;
    var integer: numCipherSuites is 0;
    var integer: numCompressionMethods is 0;
    var integer: extensionBytes is 0;
    var integer: index is 0;
    var integer: cipher_suite_number is ord(TLS_NULL_WITH_NULL_NULL);
    var integer: searchIndex is 0;
    var integer: minIndex is succ(length(supportedCiphers));
  begin
    # writeln("client_hello");
    startPos := state.pos;
    incr(state.pos);
    length := bytes2Int(state.message[state.pos len 3], UNSIGNED, BE);
    state.pos +:= 3;
    beyond := state.pos + length;
    if state.message[state.pos len 2] >= SSL_3_0 and
        state.message[state.pos len 2] <= TLS_1_2 then
      if state.message[state.pos len 2] < parameters.tls_version then
        parameters.tls_version := state.message[state.pos len 2];
      end if;
      state.pos +:= 2;
      parameters.client_random := state.message[state.pos len 32];
      state.pos +:= 32;
      sessionIdLen := ord(state.message[state.pos]);
      incr(state.pos);
      # writeln("SessionId: " <& hex(state.message[state.pos len sessionIdLen]));
      state.pos +:= sessionIdLen;
      numCipherSuites := bytes2Int(state.message[state.pos len 2], UNSIGNED, BE) div 2;
      state.pos +:= 2;
      for index range 1 to numCipherSuites do
        cipher_suite_number := bytes2Int(state.message[state.pos len 2], UNSIGNED, BE);
        for key searchIndex range supportedCiphers do
          if ord(supportedCiphers[searchIndex]) = cipher_suite_number and
              searchIndex < minIndex then
            minIndex := searchIndex;
          end if;
        end for;
        state.pos +:= 2;
      end for;
      if minIndex <= length(supportedCiphers) then
        parameters.cipher_suite := supportedCiphers[minIndex];
        storeCipherSuite(parameters);
      else
        state.alert := HANDSHAKE_FAILURE;
      end if;
      numCompressionMethods := ord(state.message[state.pos]);
      state.pos +:= 1 + numCompressionMethods;
      if state.pos <= beyond - 2 then
        extensionBytes := bytes2Int(state.message[state.pos len 2], UNSIGNED, BE);
        state.pos +:= 2 + extensionBytes;
      end if;
    else
      state.alert := PROCOCOL_VERSION;
    end if;
    parameters.handshake_messages &:= state.message[startPos .. pred(state.pos)];
  end func;


const proc: processServerHello (inout tlsParameters: parameters, inout tlsParseState: state) is func
  local
    var integer: startPos is 0;
    var integer: length is 0;
    var integer: beyond is 0;
    var integer: sessionIdLen is 0;
    var integer: extensionBytes is 0;
  begin
    # writeln("server_hello");
    startPos := state.pos;
    incr(state.pos);
    length := bytes2Int(state.message[state.pos len 3], UNSIGNED, BE);
    state.pos +:= 3;
    beyond := state.pos + length;
    if state.message[state.pos len 2] >= SSL_3_0 and
        state.message[state.pos len 2] <= parameters.tls_version then
      parameters.tls_version := state.message[state.pos len 2];
      state.pos +:= 2;
      parameters.server_random := state.message[state.pos len 32];
      state.pos +:= 32;
      sessionIdLen := ord(state.message[state.pos]);
      incr(state.pos);
      parameters.session_id := state.message[state.pos len sessionIdLen];
      state.pos +:= sessionIdLen;
      parameters.cipher_suite := cipherSuite conv bytes2Int(state.message[state.pos len 2], UNSIGNED, BE);
      # writeln("Cipher: " <& ord(parameters.cipher_suite));
      storeCipherSuite(parameters);
      state.pos +:= 2;
      parameters.compression_algorithm := ord(state.message[state.pos]);
      incr(state.pos);
      if state.pos <= beyond - 2 then
        extensionBytes := bytes2Int(state.message[state.pos len 2], UNSIGNED, BE);
        state.pos +:= 2 + extensionBytes;
      end if;
    else
      state.alert := PROCOCOL_VERSION;
    end if;
    parameters.handshake_messages &:= state.message[startPos .. pred(state.pos)];
  end func;


const proc: processCertificateRequest (inout tlsParameters: parameters, inout tlsParseState: state) is func
  local
    var integer: startPos is 0;
    var integer: length is 0;
  begin
    # writeln("certificate_request");
    startPos := state.pos;
    incr(state.pos);
    length := bytes2Int(state.message[state.pos len 3], UNSIGNED, BE);
    state.pos +:= 3;
    state.pos +:= length;
    parameters.handshake_messages &:= state.message[startPos .. pred(state.pos)];
  end func;


const proc: processServerHelloDone (inout tlsParameters: parameters, inout tlsParseState: state) is func
  local
    var integer: startPos is 0;
    var integer: length is 0;
  begin
    # writeln("server_hello_done");
    startPos := state.pos;
    incr(state.pos);
    length := bytes2Int(state.message[state.pos len 3], UNSIGNED, BE);
    state.pos +:= 3;
    parameters.handshake_messages &:= state.message[startPos .. pred(state.pos)];
  end func;


const proc: processClientKeyExchange (inout tlsParameters: parameters, inout tlsParseState: state) is func
  local
    var integer: startPos is 0;
    var integer: length is 0;
    var integer: encryptedSecretLength is 0;
    var string: encryptedPreMasterSecret is "";
    var string: preMasterSecret is "";
  begin
    # writeln("client_key_exchange");
    startPos := state.pos;
    incr(state.pos);
    length := bytes2Int(state.message[state.pos len 3], UNSIGNED, BE);
    state.pos +:= 3;
    if parameters.tls_version = SSL_3_0 then
      encryptedSecretLength := length;
    else
      encryptedSecretLength := bytes2Int(state.message[state.pos len 2], UNSIGNED, BE);
      state.pos +:= 2;
    end if;
    encryptedPreMasterSecret := state.message[state.pos len encryptedSecretLength];
    state.pos +:= encryptedSecretLength;
    # writeln("encryptedPreMasterSecret: " <& hex(encryptedPreMasterSecret));
    # writeln("length(encryptedPreMasterSecret): " <& length(encryptedPreMasterSecret));
    preMasterSecret := rsaesPkcs1V15Decrypt(parameters.privateCertificateKey,
        encryptedPreMasterSecret);
    # preMasterSecret := rsaesOaepDecrypt(parameters.privateCertificateKey,
    #     encryptedPreMasterSecret, "");
    computeMasterSecret(parameters, preMasterSecret);
    storeKeys(parameters);
    parameters.handshake_messages &:= state.message[startPos .. pred(state.pos)];
  end func;


const proc: processChangeCipherSpec (inout tlsParameters: parameters, inout tlsParseState: state) is func
  local
    var integer: startPos is 0;
    var integer: length is 0;
  begin
    # writeln("change_cipher_spec");
    startPos := state.pos;
    incr(state.pos);
    length := bytes2Int(state.message[state.pos len 3], UNSIGNED, BE);
    state.pos +:= 4;
  end func;


const proc: processFinished (inout tlsParameters: parameters, inout tlsParseState: state) is func
  local
    var integer: startPos is 0;
    var integer: length is 0;
    var string: finished_label is "";
    var string: verify_data is "";
    var string: handshake_hash is "";
    var string: computed_verify_data is "";
  begin
    # writeln("finished");
    startPos := state.pos;
    incr(state.pos);
    length := bytes2Int(state.message[state.pos len 3], UNSIGNED, BE);
    state.pos +:= 3;
    verify_data := state.message[state.pos len length];
    state.pos +:= length;
    # writeln("verify_data: " <& hex(verify_data));
    # writeln("master_secret: " <& hex(parameters.master_secret));
    # writeln("handshake_messages: " <& hex(parameters.handshake_messages));
    # writeln("tls_version: " <& literal(parameters.tls_version));
    if parameters.tls_version = SSL_3_0 then
      if parameters.isClient then
        finished_label := "SRVR";  # The sender is a server.
      else
        finished_label := "CLNT";  # The sender is a client.
      end if;
      # writeln("finished_label: " <& literal(finished_label));
      computed_verify_data := md5(parameters.master_secret & MD5_PAD2 &
                                  md5(parameters.handshake_messages & finished_label &
                                      parameters.master_secret & MD5_PAD1)) &
                              sha1(parameters.master_secret & SHA_PAD2 &
                                   sha1(parameters.handshake_messages & finished_label &
                                        parameters.master_secret & SHA_PAD1));
    else
      if parameters.isClient then
        finished_label := "server finished";  # The sender is a server.
      else
        finished_label := "client finished";  # The sender is a client.
      end if;
      # writeln("finished_label: " <& literal(finished_label));
      if parameters.tls_version = TLS_1_2 then
        computed_verify_data := p_hash(SHA256, parameters.master_secret, finished_label &
                                       sha256(parameters.handshake_messages), 12);
      else
        handshake_hash := md5(parameters.handshake_messages) &
                          sha1(parameters.handshake_messages);
        # writeln("handshake_hash: " <& hex(handshake_hash));
        # writeln("handshake_hash size: " <& length(handshake_hash));
        computed_verify_data := pseudoRandomFunction(parameters.master_secret, finished_label,
                                                     handshake_hash, 12);
      end if;
    end if;
    # writeln("computed_verify_data: " <& hex(computed_verify_data));
    if verify_data <> computed_verify_data then
      writeln(" ***** Handshake not verified");
      raise RANGE_ERROR;
    end if;
    parameters.handshake_messages &:= state.message[startPos .. pred(state.pos)];
  end func;


const proc: getTlsMsgRecord (inout file: sock, inout tlsParseState: state) is func
  local
    var integer: missing is 0;
    var string: msg2 is "";
  begin
    # writeln("in getTlsMsgRecord");
    if state.pos > length(state.message) then
      state.message := gets(sock, 5);
      if length(state.message) = 5 and
          state.message[1] >= CHANGE_CIPHER_SPEC and state.message[1] <= APPLICATION_DATA then
        state.contentType := state.message[1];
        state.length := bytes2Int(state.message[4 len 2], UNSIGNED, BE);
        missing := state.length;
        repeat
          msg2 := gets(sock, missing);
          state.message &:= msg2;
          missing -:= length(msg2);
        until missing = 0 or eof(sock);
        if missing = 0 then
          state.pos := 6;
        else
          state.contentType := NO_MESSAGE;
          state.length := 0;
        end if;
      else
        state.contentType := NO_MESSAGE;
        state.length := 0;
        # writeln("EOF = " <& eof(sock));
        # writeln("length(message) = " <& length(state.message));
        # writeln("message = " <& literal(state.message));
        # raise RANGE_ERROR;
      end if;
    end if;
    # writeln("getTlsMsgRecord -> " <& length(state.message) <& " " <& literal(state.message));
    # showTlsMsgType(state.message);
    # showTlsMsg(state.message);
  end func;


const proc: loadCompleteHandshakeMsg (inout file: sock, inout tlsParseState: state) is func
  local
    var integer: lengthOfHandshakeMsg is 0;
    var integer: remainingBytesInMsgRecord is 0;
    var integer: totallyMissing is 0;
    var string: stri is "";
    var integer: recordLength is 0;
    var integer: missing is 0;
    var string: msg2 is "";
  begin
    if length(state.message) >= state.pos + 3 then
      # Determine the length of the handshake message.
      lengthOfHandshakeMsg := bytes2Int(state.message[state.pos + 1 len 3], UNSIGNED, BE);
      remainingBytesInMsgRecord := length(state.message) - state.pos - 3;
      if lengthOfHandshakeMsg > remainingBytesInMsgRecord then
        # In the current TLS message record are not enough characters.
        totallyMissing := lengthOfHandshakeMsg - remainingBytesInMsgRecord;
        # writeln("totallyMissing: " <& totallyMissing);
        repeat
          # Get the next TLS message record.
          stri := gets(sock, 5);
          if length(stri) = 5 and stri[1] = HANDSHAKE then
            # We are reading additional data for a handshake message.
            recordLength := bytes2Int(stri[4 len 2], UNSIGNED, BE);
            missing := recordLength;
            repeat
              msg2 := gets(sock, missing);
              state.message &:= msg2;
              missing -:= length(msg2);
            until missing = 0 or eof(sock);
            totallyMissing -:= recordLength;
          else
            state.alert := UNEXPECTED_MESSAGE;
          end if;
        until totallyMissing <= 0 or eof(sock);
      end if;
    end if;
  end func;


const func string: genExtension (in integer: extensionType, in string: extensionData) is
  return int16AsTwoBytesBe(extensionType) &
      int16AsTwoBytesBe(length(extensionData)) & extensionData;


const func string: serverNameExtension (in string: serverName) is
  return int16AsTwoBytesBe(length(serverName) + 3) &
         "\0;" & int16AsTwoBytesBe(length(serverName)) & serverName;


const func string: genClientExtensions (in tlsParameters: parameters) is func
  result
    var string: extensionBytes is "";
  begin
    if parameters.hostName <> "" then
      extensionBytes &:= genExtension(SERVER_NAME, serverNameExtension(parameters.hostName));
    end if;
    if extensionBytes <> "" then
      extensionBytes := int16AsTwoBytesBe(length(extensionBytes)) & extensionBytes;
    end if;
  end func;


const func string: genClientHello (inout tlsParameters: parameters, in string: sessionId) is func
  result
    var string: clientHello is "";
  local
    var integer: length is 0;
    var integer: count is 0;
    var cipherSuite: cipher is TLS_NULL_WITH_NULL_NULL;
  begin
    parameters.client_random := int32AsFourBytesBe(timestamp1970(time(NOW)));   # Random - gmt_unix_time
    parameters.client_random &:= int2Octets(rand(0_, 2_ ** (28 * 8) - 1_), 28); # Random - random_bytes
    clientHello := str(HANDSHAKE) &               # ContentType (index: 1)
                   parameters.tls_version &       # Version: 3.1
                   "\0;\0;" &                     # Length: filled later (index: 4)
                   str(CLIENT_HELLO) &            # HandshakeType (index: 6)
                   "\0;\0;\0;" &                  # Length: filled later
                   parameters.tls_version &       # Version: 3.1
                   parameters.client_random &     # Random - random_bytes
                   str(chr(length(sessionId))) &  # SessionId length
                   sessionId &                    # SessionId
                   int16AsTwoBytesBe(2 * length(supportedCiphers));  # Number of Ciphers in bytes
    for cipher range supportedCiphers do
      clientHello &:= int16AsTwoBytesBe(ord(cipher));
    end for;
    clientHello &:= "\1;" &                       # Number of CompressionMethods: 1 (1 byte)
                    "\0;";                        # CompressionMethod-1: 0
    clientHello &:= genClientExtensions(parameters);
    length := length(clientHello);
    clientHello @:= [4] int16AsTwoBytesBe(length - 5);
    clientHello @:= [8] int16AsTwoBytesBe(length - 9);
    parameters.handshake_messages &:= clientHello[6 ..];
  end func;


const func string: genServerHello (inout tlsParameters: parameters) is func
  result
    var string: serverHello is "";
  local
    const integer: SESSION_ID_LEN is 32;
    var integer: length is 0;
    var integer: count is 0;
  begin
    parameters.server_random := int32AsFourBytesBe(timestamp1970(time(NOW)));   # Random - gmt_unix_time
    parameters.server_random &:= int2Octets(rand(0_, 2_ ** (28 * 8) - 1_), 28); # Random - random_bytes
    parameters.session_id :=
        int2Octets(rand(0_, 2_ ** (SESSION_ID_LEN * 8) - 1_), SESSION_ID_LEN);  # SessionId
    serverHello := str(HANDSHAKE) &            # ContentType (index: 1)
                   parameters.tls_version &    # Version: take version from client_hello.
                   "\0;\0;" &                  # Length: filled later (index: 4)
                   str(SERVER_HELLO) &         # HandshakeType (index: 6)
                   "\0;\0;\0;" &               # Length: filled later
                   parameters.tls_version &    # Version: take version from client_hello.
                   parameters.server_random &  # Random
                   str(chr(SESSION_ID_LEN)) &  # SessionId length
                   parameters.session_id &     # SessionId
                   int16AsTwoBytesBe(ord(parameters.cipher_suite)) &
                   "\0;";                      # CompressionMethod: 0
    length := length(serverHello);
    serverHello @:= [4] int16AsTwoBytesBe(length - 5);
    serverHello @:= [8] int16AsTwoBytesBe(length - 9);
    parameters.handshake_messages &:= serverHello[6 ..];
  end func;


const func string: genCertificate (inout tlsParameters: parameters, in array string: certList) is func
  result
    var string: certificate is "";
  local
    var integer: length is 0;
    var integer: index is 0;
  begin
    certificate := str(HANDSHAKE) &          # ContentType (index: 1)
                   parameters.tls_version &  # Version: take version from client_hello.
                   "\0;\0;" &                # Length: filled later (index: 4)
                   str(CERTIFICATE) &        # HandshakeType (index: 6)
                   "\0;\0;\0;" &             # Length: filled later
                   "\0;\0;\0;";              # Sequence length: filled later
    for key index range certList do
      certificate &:= "\0;" & int16AsTwoBytesBe(length(certList[index])) &
                      certList[index];
    end for;
    length := length(certificate);
    certificate @:= [4] int16AsTwoBytesBe(length - 5);
    certificate @:= [8] int16AsTwoBytesBe(length - 9);
    certificate @:= [11] int16AsTwoBytesBe(length - 12);
    parameters.handshake_messages &:= certificate[6 ..];
  end func;


const func string: genServerHelloDone (inout tlsParameters: parameters) is func
  result
    var string: serverHelloDone is "";
  local
    var integer: length is 0;
  begin
    serverHelloDone := str(HANDSHAKE) &          # ContentType (index: 1)
                       parameters.tls_version &  # Version: take version from client_hello.
                       "\0;\0;" &                # Length: filled later (index: 4)
                       str(SERVER_HELLO_DONE) &  # HandshakeType (index: 6)
                       "\0;\0;\0;";              # Length: 0
    length := length(serverHelloDone);
    serverHelloDone @:= [4] int16AsTwoBytesBe(length - 5);
    parameters.handshake_messages &:= serverHelloDone[6 ..];
  end func;


const func string: genClientKeyExchange (inout tlsParameters: parameters) is func
  result
    var string: clientKeyExchange is "";
  local
    var integer: length is 0;
    var string: preMasterSecret is "";
    var string: encryptedPreMasterSecret is "";
  begin
    # writeln("genClientKeyExchange");
    preMasterSecret := parameters.tls_version;                          # ProtocolVersion
    preMasterSecret &:= int2Octets(rand(0_, 2_ ** (46 * 8) - 1_), 46);  # Random - random_bytes
    computeMasterSecret(parameters, preMasterSecret);
    storeKeys(parameters);
    clientKeyExchange := str(HANDSHAKE) &            # ContentType (index: 1)
                         parameters.tls_version &    # Version: 3.1
                         "\0;\0;" &                  # Length: filled later (index: 4)
                         str(CLIENT_KEY_EXCHANGE) &  # HandshakeType (index: 6)
                         "\0;\0;\0;";                # Length: filled later
    encryptedPreMasterSecret := rsaesPkcs1V15Encrypt(parameters.publicCertificateKey,
        preMasterSecret);
    # writeln("encryptedPreMasterSecret: " <& hex(encryptedPreMasterSecret));
    # writeln("length(encryptedPreMasterSecret): " <& length(encryptedPreMasterSecret));
    if parameters.tls_version <> SSL_3_0 then
      clientKeyExchange &:= int16AsTwoBytesBe(length(encryptedPreMasterSecret));
    end if;
    clientKeyExchange &:= encryptedPreMasterSecret;
    length := length(clientKeyExchange);
    clientKeyExchange @:= [4] int16AsTwoBytesBe(length - 5);
    clientKeyExchange @:= [8] int16AsTwoBytesBe(length - 9);
    parameters.handshake_messages &:= clientKeyExchange[6 ..];
  end func;


const func string: genChangeCipherSpec (in tlsParameters: parameters) is func
  result
    var string: changeCipherSpec is "";
  local
    var integer: length is 0;
  begin
    changeCipherSpec := str(CHANGE_CIPHER_SPEC) &  # ContentType (index: 1)
                        parameters.tls_version &   # Version: 3.1
                        "\0;\0;" &                 # Length: filled later (index: 4)
                        "\1;";                     # change_cipher_spec
    length := length(changeCipherSpec);
    changeCipherSpec @:= [4] int16AsTwoBytesBe(length - 5);
  end func;


const func string: genFinished (inout tlsParameters: parameters) is func
  result
    var string: finished is "";
  local
    var integer: length is 0;
    var string: finished_label is "";
    var string: verify_data is "";
  begin
    finished := str(HANDSHAKE) &          # ContentType (index: 1)
                parameters.tls_version &  # Version: 3.1
                "\0;\0;" &                # Length: filled later (index: 4)
                str(FINISHED) &           # HandshakeType (index: 6)
                "\0;\0;\0;";              # Length: filled later
    # writeln("master_secret: " <& hex(parameters.master_secret));
    # writeln("handshake_messages: " <& hex(parameters.handshake_messages));
    if parameters.tls_version = SSL_3_0 then
      if parameters.isClient then
        finished_label := "CLNT";
      else
        finished_label := "SRVR";
      end if;
      # writeln("finished_label: " <& literal(finished_label));
      verify_data := md5(parameters.master_secret & MD5_PAD2 &
                         md5(parameters.handshake_messages & finished_label &
                             parameters.master_secret & MD5_PAD1)) &
                     sha1(parameters.master_secret & SHA_PAD2 &
                          sha1(parameters.handshake_messages & finished_label &
                               parameters.master_secret & SHA_PAD1));
    else
      if parameters.isClient then
        finished_label := "client finished";
      else
        finished_label := "server finished";
      end if;
      # writeln("finished_label: " <& literal(finished_label));
      if parameters.tls_version = TLS_1_2 then
        verify_data := p_hash(SHA256, parameters.master_secret, finished_label &
                              sha256(parameters.handshake_messages), 12);
      else
        verify_data := pseudoRandomFunction(parameters.master_secret, finished_label,
                                            md5(parameters.handshake_messages) &
                                            sha1(parameters.handshake_messages), 12);
      end if;
    end if;
    # writeln("verify_data: " <& hex(verify_data));
    finished &:= verify_data;
    length := length(finished);
    finished @:= [4] int16AsTwoBytesBe(length - 5);
    finished @:= [8] int16AsTwoBytesBe(length - 9);
    parameters.handshake_messages &:= finished[6 ..];
  end func;


const func string: genAlert (inout tlsParameters: parameters, in char: description) is func
  result
    var string: alert is "";
  local
    var integer: length is 0;
  begin
    alert := str(ALERT) &              # ContentType (index: 1)
             parameters.tls_version &  # Version: 3.1
             "\0;\0;" &                # Length: filled later (index: 4)
             "\1;" &                   # level: 1
             str(description);         # AlertDescription
    length := length(alert);
    alert @:= [4] int16AsTwoBytesBe(length - 5);
  end func;


const func string: tlsEncryptRecord (inout tlsParameters: parameters, in string: plain) is func
  result
    var string: encrypted is "";
  local
    var string: content is "";
    var string: iv is "";
    var string: mac is "";
    var integer: padding_length is 0;
    var string: padding is "";
    var string: encoded is "";
    var integer: length is 0;
  begin
    # writeln("plain: " <& literal(plain));
    # writeln("length(plain): " <& length(plain));
    encrypted := plain[.. 3] &         # Head stays unchanged
                 "\0;\0;";             # Length: filled later (index: 4)
    # writeln("mac secret: " <& hex(parameters.writeMacSecret));
    if parameters.tls_version = SSL_3_0 then
      mac := msgDigest(parameters.mac_algorithm, parameters.writeMacSecret & SHA_PAD2 &
                       msgDigest(parameters.mac_algorithm, parameters.writeMacSecret & SHA_PAD1 &
                                 int64AsEightBytesBe(parameters.writeSequenceNumber) &
                                 plain[1 len 1] & plain[4 ..]));
    else
      # writeln("mac algorithm: " <& ord(parameters.mac_algorithm));
      # writeln("mac secret: " <& hex(parameters.writeMacSecret));
      # writeln("hmac in: " <& hex(int64AsEightBytesBe(parameters.writeSequenceNumber) & plain));
      mac := hmac(parameters.mac_algorithm, parameters.writeMacSecret,
                  int64AsEightBytesBe(parameters.writeSequenceNumber) & plain);
    end if;
    content := plain[6 ..];
    if parameters.block_size <> 0 then
      if parameters.tls_version >= TLS_1_1 then
        iv := int2Octets(rand(0_, 2_ ** (parameters.block_size * 8) - 1_), parameters.block_size);
      end if;
      padding_length := parameters.block_size - 1 -
                        (length(content) + length(mac)) mod parameters.block_size;
      # writeln("padding_length: " <& padding_length);
      padding := str(chr(padding_length)) mult succ(padding_length);
    end if;
    # writeln("bulk_cipher_algorithm: " <& ord(parameters.bulk_cipher_algorithm));
    # writeln("data: " <& hex(content));
    # writeln("mac: " <& hex(mac));
    # writeln("before encode: " <& hex(iv & content & mac & padding));
    encoded := encode(parameters.writeCipherState, iv & content & mac & padding);
    # writeln("encoded: " <& literal(encoded));
    # writeln("length(encoded): " <& length(encoded));
    encrypted &:= encoded;
    length := length(encrypted);
    encrypted @:= [4] int16AsTwoBytesBe(length - 5);
    # writeln("encrypted message: " <& hex(encrypted));
    # writeln("length: " <& length(encrypted));
    incr(parameters.writeSequenceNumber);
  end func;


const func boolean: tlsDecryptRecord (inout tlsParameters: parameters, inout tlsParseState: state) is func
  result
    var boolean: decryptOkay is TRUE;
  local
    var string: version is "";
    var string: decoded is "";
    var integer: padding_length is 0;
    var string: content is "";
    var string: mac is "";
    var string: verify is "";
    var string: plain is "";
  begin
    # writeln("tlsDecryptRecord");
    version := state.message[2 len 2];
    # writeln("Version: " <& ord(version[1]) <& "." <& ord(version[2]));
    # writeln("message: " <& literal(state.message));
    decoded := decode(parameters.readCipherState, state.message[state.pos len state.length]);
    if parameters.block_size <> 0 then
      padding_length := ord(decoded[length(decoded)]);
      if decoded[length(decoded) - padding_length ..] =
          str(chr(padding_length)) mult succ(padding_length) then
        decoded := decoded[.. length(decoded) - succ(padding_length)];
        if version >= TLS_1_1 then
          # writeln("iv: " <& hex(decoded[.. parameters.block_size]));
          decoded := decoded[succ(parameters.block_size) ..]; # Remove iv
        end if;
      else
        decryptOkay := FALSE;
        state.alert := DECRYPTION_FAILED;
      end if;
    end if;
    if decryptOkay then
      content := decoded[.. length(decoded) - digestSize(parameters.mac_algorithm)];
      mac := decoded[length(decoded) - digestSize(parameters.mac_algorithm) + 1 ..];
      plain := state.message[.. 3] &
               int16AsTwoBytesBe(length(content)) &
               content;
      # writeln("plain: " <& hex(plain));
      # writeln("mac: " <& hex(mac));
      if version = SSL_3_0 then
        verify := msgDigest(parameters.mac_algorithm, parameters.readMacSecret & SHA_PAD2 &
                            msgDigest(parameters.mac_algorithm, parameters.readMacSecret & SHA_PAD1 &
                                      int64AsEightBytesBe(parameters.readSequenceNumber) &
                                      plain[1 len 1] & plain[4 ..]));
      else
        verify := hmac(parameters.mac_algorithm, parameters.readMacSecret,
                       int64AsEightBytesBe(parameters.readSequenceNumber) & plain);
      end if;
      # writeln("verify: " <& hex(verify));
      if mac = verify then
        state.length := length(content);
        state.message := plain;
      else
        decryptOkay := FALSE;
        state.alert := BAD_RECORD_MAC;
      end if;
    end if;
    incr(parameters.readSequenceNumber);
  end func;


const proc: sendAlertAndClose (inout tlsFile: aFile, in char: alertDescription) is func
  local
    var string: alert is "";
  begin
    alert := genAlert(aFile.parameters, alertDescription);
    # showTlsMsg(alert);
    if aFile.parameters.writeEncryptedRecords then
      alert := tlsEncryptRecord(aFile.parameters, alert);
    end if;
    block
      write(aFile.sock, alert);
    exception
      catch FILE_ERROR: noop;
    end block;
    close(aFile.sock);
    aFile.sock := STD_NULL;
    aFile.parseState.pos := succ(length(aFile.parseState.message));
  end func;


const proc: updateClientCache (in tlsParameters: parameters, in socketAddress: address) is func
  local
    var clientSession: session is clientSession.value;
  begin
    if parameters.session_id <> "" then
      session.session_id            := parameters.session_id;
      session.bulk_cipher_algorithm := parameters.bulk_cipher_algorithm;
      session.master_secret         := parameters.master_secret;
      session.last_use              := time(NOW);
      clientSessionCache @:= [address] session;
    end if;
  end func;


const func file: negotiateSecurityParameters (inout tlsFile: new_file) is func
  result
    var file: tlsSock is STD_NULL;
  local
    var string: clientKeyExchange is "";
    var string: changeCipherSpec is "";
    var string: finished is "";
    var boolean: serverHelloDone is FALSE;
    var boolean: unexpectedMessage is FALSE;
  begin
    repeat
      getTlsMsgRecord(new_file.sock, new_file.parseState);
      # showTlsMsg(new_file.parseState.message);
      if new_file.parseState.contentType = HANDSHAKE then
        loadCompleteHandshakeMsg(new_file.sock, new_file.parseState);
        if new_file.parseState.alert = CLOSE_NOTIFY then
          # showHandshakeMsg(new_file.parseState.message, new_file.parseState.pos);
          if new_file.parseState.message[new_file.parseState.pos] = CERTIFICATE then
            processCertificate(new_file.parameters, new_file.parseState);
          elsif new_file.parseState.message[new_file.parseState.pos] = CERTIFICATE_REQUEST then
            processCertificateRequest(new_file.parameters, new_file.parseState);
          elsif new_file.parseState.message[new_file.parseState.pos] = SERVER_HELLO_DONE then
            processServerHelloDone(new_file.parameters, new_file.parseState);
            serverHelloDone := TRUE;
          else  # Any other handshake
            unexpectedMessage := TRUE;
          end if;
        else
          unexpectedMessage := TRUE;
        end if;
      else
        unexpectedMessage := TRUE;
      end if;
    until serverHelloDone or unexpectedMessage;
    if serverHelloDone then
      clientKeyExchange := genClientKeyExchange(new_file.parameters);
      # showTlsMsg(clientKeyExchange);
      write(new_file.sock, clientKeyExchange);
      changeCipherSpec := genChangeCipherSpec(new_file.parameters);
      # showTlsMsg(changeCipherSpec);
      write(new_file.sock, changeCipherSpec);
      new_file.parameters.writeEncryptedRecords := TRUE;
      finished := genFinished(new_file.parameters);
      # showTlsMsg(finished);
      finished := tlsEncryptRecord(new_file.parameters, finished);
      write(new_file.sock, finished);
      repeat
        getTlsMsgRecord(new_file.sock, new_file.parseState);
        # writeln(literal(new_file.parseState.message));
        # showTlsMsg(new_file.parseState.message);
      until new_file.parseState.contentType = CHANGE_CIPHER_SPEC or
            new_file.parseState.contentType = ALERT or
            new_file.parseState.contentType = NO_MESSAGE;
      if new_file.parseState.contentType = CHANGE_CIPHER_SPEC then
        processChangeCipherSpec(new_file.parameters, new_file.parseState);
        getTlsMsgRecord(new_file.sock, new_file.parseState);
        if new_file.parseState.contentType = HANDSHAKE then  # Handshake with encoded Finished message
          if tlsDecryptRecord(new_file.parameters, new_file.parseState) then
            # showTlsMsg(new_file.parseState.message);
            if new_file.parseState.message[new_file.parseState.pos] = FINISHED then
              processFinished(new_file.parameters, new_file.parseState);
              # writeln("Version: " <& ord(new_file.parameters.tls_version[1]) <& "." <& ord(new_file.parameters.tls_version[2]));
              # writeln("Cipher: " <& ord(new_file.parameters.cipher_suite));
              updateClientCache(new_file.parameters, peerAddress(new_file.sock));
              tlsSock := toInterface(new_file);
            else
              sendAlertAndClose(new_file, UNEXPECTED_MESSAGE);
            end if;
          else
            sendAlertAndClose(new_file, new_file.parseState.alert);
          end if;
        else
          sendAlertAndClose(new_file, UNEXPECTED_MESSAGE);
        end if;
      else
        sendAlertAndClose(new_file, UNEXPECTED_MESSAGE);
      end if;
    else
      sendAlertAndClose(new_file, UNEXPECTED_MESSAGE);
    end if;
  end func;


const func file: openTlsSocket (inout file: sock, in clientSession: session) is func
  result
    var file: tlsSock is STD_NULL;
  local
    var tlsFile: new_file is tlsFile.value;
    var socketAddress: peerAddress is socketAddress.value;
    var string: sessionId is "";
    var string: clientHello is "";
    var string: changeCipherSpec is "";
    var string: finished is "";
  begin
    if sock <> STD_NULL then
      peerAddress := peerAddress(sock);
      new_file.sock := sock;
      new_file.parameters.isClient := TRUE;
      if session.last_use + clientCacheValid > time(NOW) then
        sessionId := session.session_id;
      end if;
      clientHello := genClientHello(new_file.parameters, sessionId);
      # showTlsMsg(clientHello);
      write(sock, clientHello);
      getTlsMsgRecord(sock, new_file.parseState);
      if new_file.parseState.contentType = HANDSHAKE and
          new_file.parseState.message[new_file.parseState.pos] = SERVER_HELLO then
        # showTlsMsg(new_file.parseState.message);
        processServerHello(new_file.parameters, new_file.parseState);
        if new_file.parseState.alert <> CLOSE_NOTIFY then
          sendAlertAndClose(new_file, new_file.parseState.alert);
        elsif new_file.parameters.session_id <> sessionId or
            new_file.parameters.bulk_cipher_algorithm <> session.bulk_cipher_algorithm then
          tlsSock := negotiateSecurityParameters(new_file);
        else
          getTlsMsgRecord(new_file.sock, new_file.parseState);
          if new_file.parseState.contentType = CHANGE_CIPHER_SPEC then
            processChangeCipherSpec(new_file.parameters, new_file.parseState);
            new_file.parameters.master_secret := session.master_secret;
            storeKeys(new_file.parameters);
            getTlsMsgRecord(new_file.sock, new_file.parseState);
            if new_file.parseState.contentType = HANDSHAKE then  # Handshake with encoded Finished message
              if tlsDecryptRecord(new_file.parameters, new_file.parseState) then
                # showTlsMsg(new_file.parseState.message);
                if new_file.parseState.message[new_file.parseState.pos] = FINISHED then
                  processFinished(new_file.parameters, new_file.parseState);
                  changeCipherSpec := genChangeCipherSpec(new_file.parameters);
                  # showTlsMsg(changeCipherSpec);
                  write(new_file.sock, changeCipherSpec);
                  new_file.parameters.writeEncryptedRecords := TRUE;
                  finished := genFinished(new_file.parameters);
                  # showTlsMsg(finished);
                  finished := tlsEncryptRecord(new_file.parameters, finished);
                  write(new_file.sock, finished);
                  updateClientCache(new_file.parameters, peerAddress);
                  tlsSock := toInterface(new_file);
                else
                  sendAlertAndClose(new_file, UNEXPECTED_MESSAGE);
                end if;
              else
                sendAlertAndClose(new_file, new_file.parseState.alert);
              end if;
            else
              sendAlertAndClose(new_file, UNEXPECTED_MESSAGE);
            end if;
          else
            sendAlertAndClose(new_file, UNEXPECTED_MESSAGE);
          end if;
        end if;
      else
        sendAlertAndClose(new_file, UNEXPECTED_MESSAGE);
      end if;
      if tlsSock = STD_NULL then
        excl(clientSessionCache, peerAddress);
      end if;
    end if;
  end func;


(**
 *  Return a connected TLS socket file based on the given ''sock''.
 *  @param sock A connected internet socket file (client side).
 *  @param hostName The server host name.
 *  @return an open TLS socket file, or [[null_file#STD_NULL|STD_NULL]]
 *          if it could not be opened.
 *  @exception MEMORY_ERROR An out of memory situation occurred.
 *)
const func file: openTlsSocket (inout file: sock, in string: hostName) is func
  result
    var file: tlsSock is STD_NULL;
  local
    var tlsFile: new_file is tlsFile.value;
    var string: clientHello is "";
  begin
    if sock <> STD_NULL then
      if peerAddress(sock) in clientSessionCache then
        tlsSock := openTlsSocket(sock, clientSessionCache[peerAddress(sock)]);
      else
        new_file.sock := sock;
        new_file.parameters.isClient := TRUE;
        new_file.parameters.hostName := hostName;
        clientHello := genClientHello(new_file.parameters, "");
        # showTlsMsg(clientHello);
        write(sock, clientHello);
        getTlsMsgRecord(sock, new_file.parseState);
        # showTlsMsg(new_file.parseState.message);
        if new_file.parseState.contentType = HANDSHAKE and
            new_file.parseState.message[new_file.parseState.pos] = SERVER_HELLO then
          processServerHello(new_file.parameters, new_file.parseState);
          if new_file.parseState.alert <> CLOSE_NOTIFY then
            sendAlertAndClose(new_file, new_file.parseState.alert);
          else
            tlsSock := negotiateSecurityParameters(new_file);
          end if;
        else
          sendAlertAndClose(new_file, UNEXPECTED_MESSAGE);
        end if;
      end if;
    end if;
  end func;


(**
 *  Return a connected TLS socket file based on the given ''sock''.
 *  @param sock A connected internet socket file (client side).
 *  @return an open TLS socket file, or [[null_file#STD_NULL|STD_NULL]]
 *          if it could not be opened.
 *  @exception MEMORY_ERROR An out of memory situation occurred.
 *)
const func file: openTlsSocket (inout file: sock) is
  return openTlsSocket (sock, "");


(**
 *  Return a connected TLS socket file at a port at ''hostName''.
 *  Here ''hostName'' is either a host name (e.g.: "www.example.org"),
 *  or an IPv4 address in standard dot notation (e.g.: "192.0.2.235").
 *  Operating systems supporting IPv6 may also accept an IPv6 address
 *  in colon notation.
 *  @return an open TLS socket file, or [[null_file#STD_NULL|STD_NULL]]
 *          if it could not be opened.
 *  @exception MEMORY_ERROR An out of memory situation occurred.
 *)
const func file: openTlsSocket (in string: hostName, in integer: portNumber) is func
  result
    var file: tlsSock is STD_NULL;
  local
    var file: sock is STD_NULL;
  begin
    sock := openInetSocket(hostName, portNumber);
    tlsSock := openTlsSocket(sock, hostName);
  end func;


(**
 *  Return a connected TLS socket file based on the given ''sock''.
 *  @param sock A connected internet socket file (server side).
 *  @param certList List of server certificates
 *  @param privateKey Private key of the first certificate.
 *  @return an open TLS socket file, or [[null_file#STD_NULL|STD_NULL]]
 *          if it could not be opened.
 *  @exception MEMORY_ERROR An out of memory situation occurred.
 *)
const func file: openServerTls (inout file: sock, in array string: certList,
    in rsaKey: privateKey) is func
  result
    var file: tlsSock is STD_NULL;
  local
    var tlsFile: new_file is tlsFile.value;
    var string: clientHello is "";
    var string: serverHello is "";
    var string: certificate is "";
    var string: serverHelloDone is "";
    var string: changeCipherSpec is "";
    var string: finished is "";
    var boolean: okay is TRUE;
  begin
    if sock <> STD_NULL then
      new_file.sock := sock;
      new_file.parameters.isClient := FALSE;
      new_file.parameters.privateCertificateKey := privateKey;
      # Read and process the request from sock.
      getTlsMsgRecord(sock, new_file.parseState);
      if new_file.parseState.contentType = HANDSHAKE and
          new_file.parseState.message[new_file.parseState.pos] = CLIENT_HELLO then
        # writeln(literal(new_file.parseState.message));
        # showTlsMsg(new_file.parseState.message);
        processClientHello(new_file.parameters, new_file.parseState);
        if new_file.parseState.alert <> CLOSE_NOTIFY then
          sendAlertAndClose(new_file, new_file.parseState.alert);
          okay := FALSE;
        else
          serverHello := genServerHello(new_file.parameters);
          # showTlsMsg(serverHello);
          write(sock, serverHello);
          certificate := genCertificate(new_file.parameters, certList);
          # showTlsMsg(certificate);
          block
            write(sock, certificate);
          exception
            catch FILE_ERROR:
              # getTlsMsgRecord(sock, new_file.parseState);
              # showTlsMsg(new_file.parseState.message);
              okay := FALSE;
          end block;
        end if;
        if okay then
          serverHelloDone := genServerHelloDone(new_file.parameters);
          # showTlsMsg(serverHelloDone);
          write(sock, serverHelloDone);
          repeat
            getTlsMsgRecord(sock, new_file.parseState);
            # writeln(literal(new_file.parseState.message));
            # showTlsMsg(new_file.parseState.message);
            if new_file.parseState.contentType = HANDSHAKE and
                new_file.parseState.message[new_file.parseState.pos] = CLIENT_KEY_EXCHANGE then
              processClientKeyExchange(new_file.parameters, new_file.parseState);
            end if;
          until new_file.parseState.contentType = CHANGE_CIPHER_SPEC or
                new_file.parseState.contentType = ALERT or
                new_file.parseState.contentType = NO_MESSAGE;
          if new_file.parseState.contentType = CHANGE_CIPHER_SPEC then
            processChangeCipherSpec(new_file.parameters, new_file.parseState);
            getTlsMsgRecord(sock, new_file.parseState);
            if new_file.parseState.contentType = HANDSHAKE then  # Handshake with encoded Finished message
              if tlsDecryptRecord(new_file.parameters, new_file.parseState) then
                # showTlsMsg(new_file.parseState.message);
                if new_file.parseState.message[new_file.parseState.pos] = FINISHED then
                  processFinished(new_file.parameters, new_file.parseState);
                  changeCipherSpec := genChangeCipherSpec(new_file.parameters);
                  # showTlsMsg(changeCipherSpec);
                  write(sock, changeCipherSpec);
                  new_file.parameters.writeEncryptedRecords := TRUE;
                  finished := genFinished(new_file.parameters);
                  # showTlsMsg(finished);
                  finished := tlsEncryptRecord(new_file.parameters, finished);
                  block
                    write(sock, finished);
                  exception
                    catch FILE_ERROR:
                      # getTlsMsgRecord(sock, new_file.parseState);
                      # tlsDecryptRecord(new_file.parameters, new_file.parseState);
                      # showTlsMsg(new_file.parseState.message);
                      okay := FALSE;
                  end block;
                  if okay then
                    tlsSock := toInterface(new_file);
                  end if;
                else
                  sendAlertAndClose(new_file, UNEXPECTED_MESSAGE);
                end if;
              else
                sendAlertAndClose(new_file, new_file.parseState.alert);
              end if;
            else
              sendAlertAndClose(new_file, UNEXPECTED_MESSAGE);
            end if;
          else
            sendAlertAndClose(new_file, UNEXPECTED_MESSAGE);
          end if;
        end if;
      else
        sendAlertAndClose(new_file, UNEXPECTED_MESSAGE);
      end if;
    end if;
  end func;


(**
 *  Return a connected TLS socket file based on the given ''sock''.
 *  @param sock A connected internet socket file (server side).
 *  @param sock Server socket (returned by accept).
 *  @param certificate Server certificate and corresponding private key.
 *  @return an open TLS socket file, or [[null_file#STD_NULL|STD_NULL]]
 *          if it could not be opened.
 *  @exception MEMORY_ERROR An out of memory situation occurred.
 *)
const func file: openServerTls (inout file: sock, in certAndKey: certificate) is func
  result
    var file: tlsSock is STD_NULL;
  begin
    tlsSock := openServerTls(sock, certificate.certList, certificate.privateKey);
  end func;


(**
 *  Close a tlsFile.
 *  @exception FILE_ERROR A system function returns an error.
 *)
const proc: close (inout tlsFile: aFile) is func
  begin
    sendAlertAndClose(aFile, CLOSE_NOTIFY);
  end func;


(**
 *  Determine the end-of-file indicator.
 *  The end-of-file indicator is set when at least one request to read
 *  from the socket failed. The socket functions ''getc'', ''gets'',
 *  ''getln'' and ''getwd'' indicate the end-of-file situation by
 *  setting ''bufferChar'' to [[char#EOF|EOF]].
 *  @return TRUE if the end-of-file indicator is set, FALSE otherwise.
 *)
const func boolean: eof (in tlsFile: inFile) is
  return inFile.bufferChar = EOF;


const func string: getApplicationData (inout tlsFile: inFile) is func
  result
    var string: applicationData is "";
  begin
    getTlsMsgRecord(inFile.sock, inFile.parseState);
    if inFile.parseState.contentType = APPLICATION_DATA then
      if tlsDecryptRecord(inFile.parameters, inFile.parseState) then
        # showTlsMsg(inFile.parseState.message);
        applicationData := inFile.parseState.message[inFile.parseState.pos ..];
        inFile.parseState.pos +:= inFile.parseState.length;
      else
        sendAlertAndClose(inFile, inFile.parseState.alert);
      end if;
    elsif inFile.parseState.contentType = ALERT then
      if tlsDecryptRecord(inFile.parameters, inFile.parseState) then
        # showTlsMsg(inFile.parseState.message);
        close(inFile);
      else
        sendAlertAndClose(inFile, inFile.parseState.alert);
      end if;
    elsif inFile.parseState.contentType = CLIENT_HELLO then
      sendAlertAndClose(inFile, NO_RENEGOTIATION);
    elsif inFile.parseState.contentType = NO_MESSAGE then
      close(inFile);
    else
      sendAlertAndClose(inFile, UNEXPECTED_MESSAGE);
    end if;
  end func;


(**
 *  Write a [[string]] to a tlsFile.
 *  @exception FILE_ERROR A system function returns an error.
 *  @exception RANGE_ERROR The string contains a character that does
 *             not fit into a byte.
 *)
const proc: write (inout tlsFile: outFile, in string: stri) is func
  local
    const integer: maxStriLen is 2**14 - 1;
    var integer: startIndex is 1;
    var string: plain is "";
    var string: message is "";
  begin
    # writeln("write(" <& literal(stri) <& ")");
    repeat
      plain := str(APPLICATION_DATA) &           # ContentType (index: 1)
               outFile.parameters.tls_version &  # Version: 3.1
               "\0;\0;" &                        # Length: filled later (index: 4)
               stri[startIndex len maxStriLen];
      plain @:= [4] int16AsTwoBytesBe(length(plain) - 5);
      # showTlsMsg(plain);
      message := tlsEncryptRecord(outFile.parameters, plain);
      write(outFile.sock, message);
      startIndex +:= maxStriLen;
    until startIndex > length(stri);
  end func;


(**
 *  Write a [[string]] followed by end-of-line to ''outSocket''.
 *  This function assures that string and '\n' are sent together.
 *)
const proc: writeln (inout tlsFile: outFile, in string: stri) is func
  begin
    # writeln("writeln(" <& literal(stri) <& ")");
    write(outFile, stri & "\n");
  end func;


(**
 *  Read a [[string]] with a maximum length from a tlsFile.
 *  @return the string read.
 *  @exception RANGE_ERROR The length is negative.
 *  @exception MEMORY_ERROR Not enough memory to represent the result.
 *)
const func string: gets (inout tlsFile: inFile, in integer: maxLength) is func
  result
    var string: striRead is "";
  begin
    if maxLength <= 0 then
      if maxLength <> 0 then
        raise RANGE_ERROR;
      end if;
    else
      # writeln("gets(, " <& maxLength <& ") actual length: " <& length(inFile.readBuffer));
      if inFile.readBuffer = "" and not eof(inFile.sock) then
        inFile.readBuffer := getApplicationData(inFile);
        # writeln("gets(, " <& maxLength <& ") actual length: " <& length(inFile.readBuffer));
      end if;
      if length(inFile.readBuffer) > maxLength then
        striRead := inFile.readBuffer[.. maxLength];
        inFile.readBuffer := inFile.readBuffer[succ(maxLength) ..];
      else
        striRead := inFile.readBuffer;
        inFile.readBuffer := "";
      end if;
      if maxLength > 0 and striRead = "" and eof(inFile.sock) then
        inFile.bufferChar := EOF;
      end if;
    end if;
    # writeln("gets --> " <& literal(striRead));
  end func;


(**
 *  Read a line from a tlsFile.
 *  The function accepts lines ending with '\n', "\r\n" or [[char#EOF|EOF]].
 *  The line ending characters are not copied into the string.
 *  That means that the '\r' of a "\r\n" sequence is silently removed.
 *  When the function is left inFile.bufferChar contains '\n' or
 *  [[char#EOF|EOF]].
 *  @return the line read.
 *  @exception MEMORY_ERROR Not enough memory to represent the result.
 *)
const func string: getln (inout tlsFile: inFile) is func
  result
    var string: stri is "";
  local
    var integer: nlPos is 0;
  begin
    nlPos := pos(inFile.readBuffer, '\n');
    while nlPos = 0 and not eof(inFile.sock) do
      inFile.readBuffer &:= getApplicationData(inFile);
      nlPos := pos(inFile.readBuffer, '\n');
    end while;
    if nlPos <> 0 then
      if nlPos <> 1 and inFile.readBuffer[pred(nlPos)] = '\r' then
        stri := inFile.readBuffer[.. nlPos - 2];
      else
        stri := inFile.readBuffer[.. pred(nlPos)];
      end if;
      inFile.readBuffer := inFile.readBuffer[succ(nlPos) ..];
      inFile.bufferChar := '\n';
    else
      stri := inFile.readBuffer;
      inFile.readBuffer := "";
      inFile.bufferChar := EOF;
    end if;
    # writeln("getln --> " <& literal(stri));
  end func;


const func string: getServerCertificate (in file: aFile, in integer: pos) is DYNAMIC;


const func string: getServerCertificate (in tlsFile: aFile, in integer: pos) is
  return aFile.parameters.serverCertificates.certList[pos];
