source upload

contrib/fundamentals/TLS/flcTLS.inc

@@ -0,0 +1,26 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLS.inc                                               }
+{   Description:      TLS library defines                                      }
+{   Last updated:     2020/05/19                                               }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE ..\flcInclude.inc}
+
+{$DEFINE TLS}
+
+{$IFDEF DEBUG}
+  {$DEFINE TLS_DEBUG}
+{$ENDIF}
+
+{$IFDEF DEBUG}
+{$IFDEF TEST}
+  {$DEFINE TLS_TEST}
+  {.DEFINE TLS_TEST_NO_RANDOM_HELLO}
+{$ENDIF}
+{$ENDIF}
+
+{$DEFINE TLS_ZLIB_DISABLE}
+

contrib/fundamentals/TLS/flcTLSAlert.pas

@@ -0,0 +1,210 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSAlert.pas                                          }
+{   File version:     5.04                                                     }
+{   Description:      TLS alert protocol                                       }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2010/11/30  0.02  Additional alerts from RFC 4366.                         }
+{   2018/07/17  5.03  Revised for Fundamentals 5.                              }
+{   2020/05/09  5.04  TLS 1.3 alerts.                                          }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSAlert;
+
+interface
+
+
+
+{                                                                              }
+{ Alert Protocol                                                               }
+{                                                                              }
+type
+  TTLSAlertLevel = (
+    tlsalWarning        = 1,
+    tlsalFatal          = 2,
+    tlsalAlertLevelMax  = 255
+  );
+
+  TTLSAlertDescription = (
+    tlsadClose_notify                    = 0,     // SSL 3
+    tlsadUnexpected_message              = 10,    // SSL 3
+    tlsadBad_record_mac                  = 20,    // SLL 3
+    tlsadDecryption_failed               = 21,    // TLS 1.0 / TLS 1.2 reserved
+    tlsadRecord_overflow                 = 22,    // TLS 1.0
+    tlsadDecompression_failure           = 30,    // SLL 3
+    tlsadHandshake_failure               = 40,    // SLL 3
+    tlsadNo_certificate                  = 41,    // SLL 3 / TLS 1.1 reserved / TLS 1.2 reserved
+    tlsadBad_certificate                 = 42,    // SLL 3
+    tlsadUnsupported_certificate         = 43,    // SLL 3
+    tlsadCertificate_revoked             = 44,    // SLL 3
+    tlsadCertificate_expired             = 45,    // SLL 3
+    tlsadCertificate_unknown             = 46,    // SLL 3
+    tlsadIllegal_parameter               = 47,    // SLL 3
+    tlsadUnknown_ca                      = 48,    // TLS 1.0
+    tlsadAccess_denied                   = 49,    // TLS 1.0
+    tlsadDecode_error                    = 50,    // TLS 1.0
+    tlsadDecrypt_error                   = 51,    // TLS 1.0
+    tlsadExport_restriction              = 60,    // TLS 1.0 / TLS 1.1 reserved / TLS 1.2 reserved
+    tlsadProtocol_version                = 70,    // TLS 1.0
+    tlsadInsufficient_security           = 71,    // TLS 1.0
+    tlsadInternal_error                  = 80,    // TLS 1.0
+    tlsadUser_canceled                   = 90,    // TLS 1.0
+    tlsadNo_renegotiation                = 100,   // TLS 1.0
+    tlsadMissing_extension               = 109,   // TLS 1.3
+    tlsadUnsupported_extention           = 110,   // TLS 1.2
+    tlsadCertificate_unobtainable        = 111,   // RFC 4366
+    tlsadUnrecognized_name               = 112,   // RFC 4366 / TLS 1.3
+    tlsadBad_certificate_status_response = 113,   // RFC 4366 / TLS 1.3
+    tlsadBad_certificate_hash_value      = 114,   // RFC 4366
+    tlsadUnknown_psk_identity            = 115,   // TLS 1.3
+    tlsadCertificate_required            = 116,   // TLS 1.3
+    tlsadNo_application_protocol         = 120,   { TLS 1.3 }
+    tlsadMax                             = 255
+  );
+
+function  TLSAlertLevelToStr(const Level: TTLSAlertLevel): String;
+function  TLSAlertDescriptionToStr(const Description: TTLSAlertDescription): String;
+
+type
+  TTLSAlert = packed record
+    level       : TTLSAlertLevel;
+    description : TTLSAlertDescription;
+  end;
+  PTLSAlert = ^TTLSAlert;
+
+const
+  TLSAlertSize = Sizeof(TTLSAlert);
+
+procedure InitTLSAlert(var Alert: TTLSAlert;
+          const Level: TTLSAlertLevel; const Description: TTLSAlertDescription);
+
+
+
+{                                                                              }
+{ Test cases                                                                   }
+{                                                                              }
+{$IFDEF TLS_TEST}
+procedure Test;
+{$ENDIF}
+
+
+
+implementation
+
+uses
+  { System }
+  SysUtils;
+
+
+
+{                                                                              }
+{ Alert Protocol                                                               }
+{                                                                              }
+function TLSAlertLevelToStr(const Level: TTLSAlertLevel): String;
+begin
+  case Level of
+    tlsalWarning : Result := 'Warning';
+    tlsalFatal   : Result := 'Fatal';
+  else
+    Result := '[Level#' + IntToStr(Ord(Level)) + ']';
+  end;
+end;
+
+function TLSAlertDescriptionToStr(const Description: TTLSAlertDescription): String;
+begin
+  case Description of
+    tlsadClose_notify                    : Result := 'Close notify';
+    tlsadUnexpected_message              : Result := 'Unexpected message';
+    tlsadBad_record_mac                  : Result := 'Bad record MAC';
+    tlsadDecryption_failed               : Result := 'Decryption failed';
+    tlsadRecord_overflow                 : Result := 'Record overflow';
+    tlsadDecompression_failure           : Result := 'Decompression failure';
+    tlsadHandshake_failure               : Result := 'Handshake failure';
+    tlsadNo_certificate                  : Result := 'No certificate';
+    tlsadBad_certificate                 : Result := 'Bad certificate';
+    tlsadUnsupported_certificate         : Result := 'Unsupported certificate';
+    tlsadCertificate_revoked             : Result := 'Certificate revoked';
+    tlsadCertificate_expired             : Result := 'Certificate expired';
+    tlsadCertificate_unknown             : Result := 'Certficiate unknown';
+    tlsadIllegal_parameter               : Result := 'Illegal parameter';
+    tlsadUnknown_ca                      : Result := 'Unknown CA';
+    tlsadAccess_denied                   : Result := 'Access denied';
+    tlsadDecode_error                    : Result := 'Decode error';
+    tlsadDecrypt_error                   : Result := 'Decrypt error';
+    tlsadExport_restriction              : Result := 'Export restriction';
+    tlsadProtocol_version                : Result := 'Protocol version';
+    tlsadInsufficient_security           : Result := 'Insufficient security';
+    tlsadInternal_error                  : Result := 'Internal error';
+    tlsadUser_canceled                   : Result := 'User cancelled';
+    tlsadNo_renegotiation                : Result := 'No renegotiation';
+    tlsadMissing_extension               : Result := 'Missing extention';
+    tlsadUnsupported_extention           : Result := 'Unsuported extention';
+    tlsadCertificate_unobtainable        : Result := 'Certificate unobtainable';
+    tlsadUnrecognized_name               : Result := 'Unrecognised name';
+    tlsadBad_certificate_status_response : Result := 'Bad certificate status response';
+    tlsadBad_certificate_hash_value      : Result := 'Bad certificate hash value';
+    tlsadUnknown_psk_identity            : Result := 'Unknown PSK identitiy';
+    tlsadCertificate_required            : Result := 'Certificate required';
+    tlsadNo_application_protocol         : Result := 'No application protocol';
+  else
+    Result := '[Alert#' + IntToStr(Ord(Description)) + ']';
+  end;
+end;
+
+procedure InitTLSAlert(
+          var Alert: TTLSAlert;
+          const Level: TTLSAlertLevel;
+          const Description: TTLSAlertDescription);
+begin
+  Alert.level := Level;
+  Alert.description := Description;
+end;
+
+
+
+{                                                                              }
+{ Test                                                                         }
+{                                                                              }
+{$IFDEF TLS_TEST}
+{$ASSERTIONS ON}
+procedure Test;
+begin
+  Assert(TLSAlertSize = 2);
+end;
+{$ENDIF}
+
+

contrib/fundamentals/TLS/flcTLSAlgorithmTypes.pas

@@ -0,0 +1,448 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSAlgorithmTypes.pas                                 }
+{   File version:     5.03                                                     }
+{   Description:      TLS Algorithm Types                                      }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2020/05/09  5.02  Create flcTLSAlgorithmTypes unit from flcTLSUtils unit.  }
+{   2020/05/11  5.03  NamedCurve and ECPointFormat enumerations.               }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSAlgorithmTypes;
+
+interface
+
+
+
+{                                                                              }
+{ CompressionMethod                                                            }
+{                                                                              }
+type
+  TTLSCompressionMethod = (
+    tlscmNull    = 0,    // Enumerations from handshake
+    tlscmDeflate = 1,
+    tlscmMax     = 255
+    );
+  PTLSCompressionMethod = ^TTLSCompressionMethod;
+
+  TTLSCompressionMethods = set of TTLSCompressionMethod;
+
+const
+  TLSCompressionMethodSize = Sizeof(TTLSCompressionMethod);
+
+
+
+{                                                                              }
+{ HashAlgorithm                                                                }
+{                                                                              }
+type
+  TTLSHashAlgorithm = (
+    tlshaNone   = 0,    // Enumerations from handshake
+    tlshaMD5    = 1,
+    tlshaSHA1   = 2,
+    tlshaSHA224 = 3,
+    tlshaSHA256 = 4,
+    tlshaSHA384 = 5,
+    tlshaSHA512 = 6,
+    tlshaMax    = 255
+    );
+  TTLSHashAlgorithms = set of TTLSHashAlgorithm;
+
+function HashAlgorithmToStr(const A: TTLSHashAlgorithm): String;
+
+
+
+{                                                                              }
+{ SignatureAlgorithm                                                           }
+{                                                                              }
+type
+  TTLSSignatureAlgorithm = (
+    tlssaAnonymous = 0,    // Enumerations from handshake
+    tlssaRSA       = 1,
+    tlssaDSA       = 2,
+    tlssaECDSA     = 3,
+    tlssaMax       = 255
+    );
+  TTLSSignatureAlgorithms = set of TTLSSignatureAlgorithm;
+
+
+
+{                                                                              }
+{ SignatureAndHashAlgorithm                                                    }
+{                                                                              }
+type
+  TTLSSignatureAndHashAlgorithm = packed record
+
+    Hash      : TTLSHashAlgorithm;
+
+    Signature : TTLSSignatureAlgorithm;
+  end;
+
+  PTLSSignatureAndHashAlgorithm = ^TTLSSignatureAndHashAlgorithm;
+
+  TTLSSignatureAndHashAlgorithmArray = array of TTLSSignatureAndHashAlgorithm;
+
+
+const
+
+  TLSSignatureAndHashAlgorithmSize = SizeOf(TTLSSignatureAndHashAlgorithm);
+
+
+
+
+{                                                                              }
+{ MACAlgorithm                                                                 }
+{ Used in TLS record.                                                          }
+{                                                                              }
+type
+  TTLSMACAlgorithm = (
+    tlsmaNone,
+    tlsmaNULL,
+    tlsmaHMAC_MD5,
+    tlsmaHMAC_SHA1,
+    tlsmaHMAC_SHA256,
+    tlsmaHMAC_SHA384,
+    tlsmaHMAC_SHA512
+
+    );
+
+
+  TTLSMacAlgorithmInfo = record
+
+    Name       : RawByteString;
+
+    DigestSize : Integer;
+
+    Supported  : Boolean; // Not used
+
+  end;
+
+  PTLSMacAlgorithmInfo = ^TTLSMacAlgorithmInfo;
+
+
+const
+
+  TLSMACAlgorithmInfo : array[TTLSMACAlgorithm] of TTLSMacAlgorithmInfo = (
+
+    ( // None
+
+     Name       : '';
+
+     DigestSize : 0;
+
+     Supported  : False;
+
+    ),
+
+    ( // NULL
+
+     Name       : 'NULL';
+
+     DigestSize : 0;
+
+     Supported  : True;
+
+    ),
+
+    ( // HMAC_MD5
+
+     Name       : 'HMAC-MD5';
+
+     DigestSize : 16;
+
+     Supported  : True;
+
+    ),
+
+    ( // HMAC_SHA1
+
+     Name       : 'HMAC-SHA1';
+
+     DigestSize : 20;
+
+     Supported  : True;
+
+    ),
+
+    ( // HMAC_SHA256
+
+     Name       : 'HMAC-SHA256';
+
+     DigestSize : 32;
+
+     Supported  : True;
+
+    ),
+
+    ( // HMAC_SHA384
+
+     Name       : 'HMAC-SHA384';
+
+     DigestSize : 48;
+
+     Supported  : False;
+
+    ),
+
+    ( // HMAC_SHA512
+
+     Name       : 'HMAC-SHA512';
+
+     DigestSize : 64;
+
+     Supported  : True;
+
+    )
+
+    );
+
+
+const
+
+  TLS_MAC_MAXDIGESTSIZE = 64;
+
+
+
+
+{                                                                              }
+{ KeyExchangeAlgorithm                                                         }
+{                                                                              }
+type
+  TTLSKeyExchangeAlgorithm = (
+    tlskeaNone,
+    tlskeaNULL,
+    tlskeaDHE_DSS,
+    tlskeaDHE_RSA,
+    tlskeaDH_Anon,
+    tlskeaRSA,
+    tlskeaDH_DSS,
+    tlskeaDH_RSA,
+    tlskeaECDHE_ECDSA,
+    tlskeaECDH_ECDSA,
+    tlskeaECDHE_RSA,
+    tlskeaECDH_RSA
+    );
+
+  TTLSKeyExchangeMethod = (
+    tlskemNone,
+    tlskemNULL,
+    tlskemDHE,
+    tlskemDH_Anon,
+    tlskemRSA,
+    tlskemDH,
+    tlskemPSK,
+    tlskemECDH,
+    tlskemECDHE
+    );
+
+  TTLSKeyExchangeAuthenticationType = (
+    tlskeatNone,
+    tlskeatAnon,
+    tlskeatDSS,
+    tlskeatRSA,
+    tlskeatPSK,
+    tlskeatECDSA
+    );
+
+  TTLSKeyExchangeAlgorithmInfo = record
+    Name      : RawByteString;
+    Method    : TTLSKeyExchangeMethod;
+    KeyType   : TTLSKeyExchangeAuthenticationType;
+    Supported : Boolean; // Not used
+  end;
+  PTLSKeyExchangeAlgorithmInfo = ^TTLSKeyExchangeAlgorithmInfo;
+
+const
+  TLSKeyExchangeAlgorithmInfo: array[TTLSKeyExchangeAlgorithm] of TTLSKeyExchangeAlgorithmInfo = (
+    ( // None
+     Name      : '';
+     Method    : tlskemNone;
+     KeyType   : tlskeatNone;
+     Supported : False;
+    ),
+    ( // NULL
+     Name      : 'NULL';
+     Method    : tlskemNULL;
+     KeyType   : tlskeatNone;
+     Supported : True;
+    ),
+    ( // DHE_DSS
+     Name      : 'DHE_DSS';
+     Method    : tlskemDHE;
+     KeyType   : tlskeatDSS;
+     Supported : False;
+    ),
+    ( // DHE_RSA
+     Name      : 'DHE_RSA';
+     Method    : tlskemDHE;
+     KeyType   : tlskeatRSA;
+     Supported : False;
+    ),
+    ( // DH_Anon
+     Name      : 'DH_Anon';
+     Method    : tlskemDH_Anon;
+     KeyType   : tlskeatNone;
+     Supported : False;
+    ),
+    ( // RSA
+     Name      : 'RSA';
+     Method    : tlskemRSA;
+     KeyType   : tlskeatRSA;
+     Supported : True;
+    ),
+    ( // DH_DSS
+     Name      : 'DH_DSS';
+     Method    : tlskemDH;
+     KeyType   : tlskeatDSS;
+     Supported : False;
+    ),
+    ( // DH_RSA
+     Name      : 'DH_RSA';
+     Method    : tlskemDH;
+     KeyType   : tlskeatRSA;
+     Supported : False;
+    ),
+    ( // ECDHE_ECDSA
+     Name      : 'ECDHE_ECDSA';
+     Method    : tlskemECDHE;
+     KeyType   : tlskeatECDSA;
+     Supported : False;
+    ),
+    ( // ECDH_ECDSA
+     Name      : 'ECDH_ECDSA';
+     Method    : tlskemECDH;
+     KeyType   : tlskeatECDSA;
+     Supported : False;
+    ),
+    ( // ECDHE_RSA
+     Name      : 'ECDHE_RSA';
+     Method    : tlskemECDHE;
+     KeyType   : tlskeatRSA;
+     Supported : False;
+    ),
+    ( // ECDH_RSA
+     Name      : 'ECDH_RSA';
+     Method    : tlskemECDH;
+     KeyType   : tlskeatRSA;
+     Supported : False;
+    )
+    );
+
+
+
+{                                                                              }
+{ ClientCertificateType                                                        }
+{                                                                              }
+type
+  TTLSClientCertificateType = (
+      tlscctRsa_sign                  = 1,
+      tlscctDss_sign                  = 2,
+      tlscctRsa_fixed_dh              = 3,
+      tlscctDss_fixed_dh              = 4,
+      tlscctRsa_ephemeral_dh_RESERVED = 5,
+      tlscctDss_ephemeral_dh_RESERVED = 6,
+      tlscctFortezza_dms_RESERVED     = 20,
+      tlscctEcdsa_sign                = 64,     // RFC 8422
+      tlscctRsa_fixed_ecdh            = 65,     // RFC 4492, deprecated in RFC 8422
+      tlscctEcdsa_fixed_ecdh          = 66,     // RFC 4492, deprecated in RFC 8422
+      tlscctMax                       = 255
+  );
+
+
+
+{                                                                              }
+{ ECCurveType                                                                  }
+{                                                                              }
+type
+  TTLSECCurveType = (
+    tlsectExplicit_prime = 1,     // RFC 4492, deprecated in RFC 8422
+    tlsectExplicit_char2 = 2,     // RFC 4492, deprecated in RFC 8422
+    tlsectNamed_curve    = 3,     // RFC 4492
+    tlsectMax            = 255
+    );
+
+
+
+{                                                                              }
+{ NamedCurve                                                                   }
+{                                                                              }
+type
+  TTLSNamedCurve = (
+    tlsncSect163k1 = 1,     // deprecated in RFC 8422
+    tlsncSect163r1 = 2,     // deprecated in RFC 8422
+    tlsncSect163r2 = 3,     // deprecated in RFC 8422
+    tlsncSect193r1 = 4,     // deprecated in RFC 8422
+    tlsncSect193r2 = 5,     // deprecated in RFC 8422
+    tlsncSect233k1 = 6,     // deprecated in RFC 8422
+    tlsncSect233r1 = 7,     // deprecated in RFC 8422
+    tlsncSect239k1 = 8,     // deprecated in RFC 8422
+    tlsncSect283k1 = 9,     // deprecated in RFC 8422
+    tlsncSect283r1 = 10,    // deprecated in RFC 8422
+    tlsncSect409k1 = 11,    // deprecated in RFC 8422
+    tlsncSect409r1 = 12,    // deprecated in RFC 8422
+    tlsncSect571k1 = 13,    // deprecated in RFC 8422
+    tlsncSect571r1 = 14,    // deprecated in RFC 8422
+    tlsncSecp160k1 = 15,    // deprecated in RFC 8422
+    tlsncSecp160r1 = 16,    // deprecated in RFC 8422
+    tlsncSecp160r2 = 17,    // deprecated in RFC 8422
+    tlsncSecp192k1 = 18,    // deprecated in RFC 8422
+    tlsncSecp192r1 = 19,    // deprecated in RFC 8422
+    tlsncSecp224k1 = 20,    // deprecated in RFC 8422
+    tlsncSecp224r1 = 21,    // deprecated in RFC 8422
+    tlsncSecp256k1 = 22,    // deprecated in RFC 8422
+    tlsncSecp256r1 = 23,
+    tlsncSecp384r1 = 24,
+    tlsncSecp521r1 = 25,
+    tlsncX25519    = 29,    // RFC 8422
+    tlsncX448      = 30,    // RFC 8422
+    tlsncArbitrary_explicit_prime_curves = $FF01,    // deprecated in RFC 8422
+    tlsncArbitrary_explicit_char2_curves = $FF02,    // deprecated in RFC 8422
+    tlsncMax = $FFFF
+    );
+
+
+
+{                                                                              }
+{ ECPointFormat                                                                }
+{                                                                              }
+type
+  TTLSECPointFormat = (
+    tlsepfUncompressed              = 0,
+    tlsepfAnsiX962_compressed_prime = 1,
+    tlsepfAnsiX962_compressed_char2 = 2,
+    tlsepfMax                       = 255
+    );

contrib/fundamentals/TLS/flcTLSBuffer.pas

@@ -0,0 +1,414 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSBuffer.pas                                         }
+{   File version:     5.02                                                     }
+{   Description:      TLS buffer                                               }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2010/11/26  0.01  Initial development.                                     }
+{   2018/07/17  5.02  Revised for Fundamentals 5.                              }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSBuffer;
+
+interface
+
+
+
+{                                                                              }
+{ TLS Buffer                                                                   }
+{                                                                              }
+type
+  TTLSBuffer = record
+    Ptr  : Pointer;
+    Size : Integer;
+    Head : Integer;
+    Used : Integer;
+  end;
+
+procedure TLSBufferInitialise(
+          var TLSBuf: TTLSBuffer;
+          const TLSBufSize: Integer = -1);
+procedure TLSBufferFinalise(var TLSBuf: TTLSBuffer);
+procedure TLSBufferPack(var TLSBuf: TTLSBuffer);
+procedure TLSBufferResize(
+          var TLSBuf: TTLSBuffer;
+          const TLSBufSize: Integer);
+procedure TLSBufferExpand(
+          var TLSBuf: TTLSBuffer;
+          const Size: Integer);
+function  TLSBufferAddPtr(
+          var TLSBuf: TTLSBuffer;
+          const Size: Integer): Pointer;
+procedure TLSBufferAddBuf(
+          var TLSBuf: TTLSBuffer;
+          const Buf; const Size: Integer);
+procedure TLSBufferShrink(var TLSBuf: TTLSBuffer);
+function  TLSBufferPeekPtr(
+          const TLSBuf: TTLSBuffer;
+          var BufPtr: Pointer; const Size: Integer): Integer;
+function  TLSBufferPeek(
+          var TLSBuf: TTLSBuffer;
+          var Buf; const Size: Integer): Integer;
+function  TLSBufferRemove(
+          var TLSBuf: TTLSBuffer;
+          var Buf; const Size: Integer): Integer;
+function  TLSBufferUsed(const TLSBuf: TTLSBuffer): Integer;
+function  TLSBufferPtr(const TLSBuf: TTLSBuffer): Pointer;
+procedure TLSBufferClear(var TLSBuf: TTLSBuffer);
+function  TLSBufferDiscard(
+          var TLSBuf: TTLSBuffer;
+          const Size: Integer): Integer; 
+
+
+
+implementation
+
+uses
+  { TLS }
+
+  flcTLSErrors;
+
+
+
+{                                                                              }
+{ TLS Buffer                                                                   }
+{                                                                              }
+const
+  TLS_CLIENT_DEFAULTBUFFERSIZE = 16384;
+
+// Initialise a TLS buffer
+procedure TLSBufferInitialise(
+          var TLSBuf: TTLSBuffer;
+          const TLSBufSize: Integer = -1);
+var L : Integer;
+begin
+  TLSBuf.Ptr := nil;
+  TLSBuf.Size := 0;
+  TLSBuf.Head := 0;
+  TLSBuf.Used := 0;
+  L := TLSBufSize;
+  if L < 0 then
+    L := TLS_CLIENT_DEFAULTBUFFERSIZE;
+  if L > 0 then
+    GetMem(TLSBuf.Ptr, L);
+  TLSBuf.Size := L;
+end;
+
+// Finalise a TLS buffer
+procedure TLSBufferFinalise(var TLSBuf: TTLSBuffer);
+var P : Pointer;
+begin
+  P := TLSBuf.Ptr;
+  if Assigned(P) then
+    begin
+      TLSBuf.Ptr := nil;
+      FreeMem(P);
+    end;
+  TLSBuf.Size := 0;
+end;
+
+// Pack a TLS buffer
+// Moves data to front of buffer
+// Post: TLSBuf.Head = 0
+procedure TLSBufferPack(var TLSBuf: TTLSBuffer);
+var P, Q : PByte;
+    U, H : Integer;
+begin
+  H := TLSBuf.Head;
+  if H <= 0 then
+    exit;
+  U := TLSBuf.Used;
+  if U <= 0 then
+    begin
+      TLSBuf.Head := 0;
+      exit;
+    end;
+  Assert(Assigned(TLSBuf.Ptr));
+  P := TLSBuf.Ptr;
+  Q := P;
+  Inc(P, H);
+  Move(P^, Q^, U);
+  TLSBuf.Head := 0;
+end;
+
+// Resize a TLS buffer
+// New buffer size must be large enough to hold existing data
+// Post: TLSBuf.Size = TLSBufSize
+procedure TLSBufferResize(
+          var TLSBuf: TTLSBuffer;
+          const TLSBufSize: Integer);
+var U, L : Integer;
+begin
+  L := TLSBufSize;
+  U := TLSBuf.Used;
+  // treat negative TLSBufSize parameter as zero
+  if L < 0 then
+    L := 0;
+  // check if shrinking buffer to less than used size
+  if U > L then
+    raise ETLSError.Create(TLSError_InvalidParameter);
+  // check if packing required to fit buffer
+  if U + TLSBuf.Head > L then
+    TLSBufferPack(TLSBuf);
+  Assert(U + TLSBuf.Head <= L);
+  // resize
+  ReallocMem(TLSBuf.Ptr, L);
+  TLSBuf.Size := L;
+end;
+
+// Expand a TLS buffer
+// Expands the size of the buffer to at least Size
+procedure TLSBufferExpand(
+          var TLSBuf: TTLSBuffer;
+          const Size: Integer);
+var S, N, I : Integer;
+begin
+  S := TLSBuf.Size;
+  N := Size;
+  // check if expansion not required
+  if N <= S then
+    exit;
+  // scale up new size proportional to current size
+  // increase by at least quarter of current size
+  // this reduces the number of resizes in growing buffers
+  I := S + (S div 4);
+  if N < I then
+    N := I;
+  // resize buffer
+  Assert(N >= Size);
+  TLSBufferResize(TLSBuf, N);
+end;
+
+// Returns a pointer to position in buffer to add new data of Size
+// Handles resizing and packing of buffer to fit new data
+function TLSBufferAddPtr(
+         var TLSBuf: TTLSBuffer;
+         const Size: Integer): Pointer; {$IFDEF UseInline}inline;{$ENDIF}
+var P : PByte;
+    U, L : Integer;
+begin
+  // return nil if nothing to add
+  if Size <= 0 then
+    begin
+      Result := nil;
+      exit;
+    end;
+  U := TLSBuf.Used;
+  L := U + Size;
+  // resize if necessary
+  if L > TLSBuf.Size then
+    TLSBufferExpand(TLSBuf, L);
+  // pack if necessary
+  if TLSBuf.Head + L > TLSBuf.Size then
+    TLSBufferPack(TLSBuf);
+  // buffer should now be large enough for new data
+  Assert(TLSBuf.Size > 0);
+  Assert(TLSBuf.Head + TLSBuf.Used + Size <= TLSBuf.Size);
+  // get buffer pointer
+  Assert(Assigned(TLSBuf.Ptr));
+  P := TLSBuf.Ptr;
+  Inc(P, TLSBuf.Head + U);
+  Result := P;
+end;
+
+// Adds new data from a buffer to a TLS buffer
+procedure TLSBufferAddBuf(
+          var TLSBuf: TTLSBuffer;
+          const Buf; const Size: Integer); {$IFDEF UseInline}inline;{$ENDIF}
+var P : PByte;
+begin
+  if Size <= 0 then
+    exit;
+  // get buffer pointer
+  P := TLSBufferAddPtr(TLSBuf, Size);
+  // move user buffer to buffer
+  Assert(Assigned(P));
+  Move(Buf, P^, Size);
+  Inc(TLSBuf.Used, Size);
+  Assert(TLSBuf.Head + TLSBuf.Used <= TLSBuf.Size);
+end;
+
+// Shrink the size of a TLS buffer to release all unused memory
+// Post: TLSBuf.Used = TLSBuf.Size and TLSBuf.Head = 0
+procedure TLSBufferShrink(var TLSBuf: TTLSBuffer);
+var S, U : Integer;
+begin
+  S := TLSBuf.Size;
+  if S <= 0 then
+    exit;
+  U := TLSBuf.Used;
+  if U = 0 then
+    begin
+      TLSBufferResize(TLSBuf, 0);
+      TLSBuf.Head := 0;
+      exit;
+    end;
+  if U = S then
+    exit;
+  TLSBufferPack(TLSBuf);        // move data to front of buffer
+  TLSBufferResize(TLSBuf, U);   // set size equal to used bytes
+  Assert(TLSBuf.Used = TLSBuf.Size);
+end;
+
+// Peek TLS buffer
+// Returns the number of bytes actually available to peek (up to requested size)
+function TLSBufferPeekPtr(
+         const TLSBuf: TTLSBuffer;
+         var BufPtr: Pointer; const Size: Integer): Integer; {$IFDEF UseInline}inline;{$ENDIF}
+var P : PByte;
+    L : Integer;
+begin
+  // handle peeking zero bytes
+  if Size <= 0 then
+    begin
+      BufPtr := nil;
+      Result := 0;
+      exit;
+    end;
+  // handle empty buffer
+  L := TLSBuf.Used;
+  if L <= 0 then
+    begin
+      BufPtr := nil;
+      Result := 0;
+      exit;
+    end;
+  // peek from buffer
+  if L > Size then
+    L := Size;
+  Assert(TLSBuf.Head + L <= TLSBuf.Size);
+  Assert(Assigned(TLSBuf.Ptr));
+  P := TLSBuf.Ptr;
+  Inc(P, TLSBuf.Head);
+  BufPtr := P;
+  Result := L;
+end;
+
+// Peek data from a TLS buffer
+// Returns the number of bytes actually available and copied into the buffer
+function TLSBufferPeek(
+         var TLSBuf: TTLSBuffer;
+         var Buf; const Size: Integer): Integer; {$IFDEF UseInline}inline;{$ENDIF}
+var P : Pointer;
+    L : Integer;
+begin
+  L := TLSBufferPeekPtr(TLSBuf, P, Size);
+  Move(P^, Buf, L);
+  Result := L;
+end;
+
+// Remove data from a TLS buffer
+// Returns the number of bytes actually available and copied into the user buffer
+function TLSBufferRemove(
+         var TLSBuf: TTLSBuffer;
+         var Buf; const Size: Integer): Integer; {$IFDEF UseInline}inline;{$ENDIF}
+var L, H, U : Integer;
+begin
+  // peek data from buffer
+  L := TLSBufferPeek(TLSBuf, Buf, Size);
+  if L = 0 then
+    begin
+      Result := 0;
+      exit;
+    end;
+  // remove from buffer
+  H := TLSBuf.Head;
+  U := TLSBuf.Used;
+  Inc(H, L);
+  Dec(U, L);
+  if U = 0 then
+    H := 0;
+  TLSBuf.Head := H;
+  TLSBuf.Used := U;
+  Result := L;
+end;
+
+// Returns number of bytes used in TLS buffer
+function TLSBufferUsed(const TLSBuf: TTLSBuffer): Integer; {$IFDEF UseInline}inline;{$ENDIF}
+begin
+  Result := TLSBuf.Used;
+end;
+
+// Returns pointer to TLS buffer head
+function TLSBufferPtr(const TLSBuf: TTLSBuffer): Pointer; {$IFDEF UseInline}inline;{$ENDIF}
+var P : PByte;
+begin
+  P := PByte(TLSBuf.Ptr);
+  Inc(P, TLSBuf.Head);
+  Result := P;
+end;
+
+// Clear the data from a TLS buffer
+procedure TLSBufferClear(var TLSBuf: TTLSBuffer);
+begin
+  TLSBuf.Used := 0;
+  TLSBuf.Head := 0;
+end;
+
+// Discard a number of bytes from the TLS buffer
+// Returns the number of bytes actually discarded from buffer
+function TLSBufferDiscard(
+         var TLSBuf: TTLSBuffer;
+         const Size: Integer): Integer; {$IFDEF UseInline}inline;{$ENDIF}
+var L, U : Integer;
+begin
+  // handle discarding zero bytes from buffer
+  L := Size;
+  if L <= 0 then
+    begin
+      Result := 0;
+      exit;
+    end;
+  // handle discarding the complete buffer
+  U := TLSBuf.Used;
+  if L >= U then
+    begin
+      TLSBuf.Used := 0;
+      TLSBuf.Head := 0;
+      Result := U;
+      exit;
+    end;
+  // discard partial buffer
+  Inc(TLSBuf.Head, L);
+  Dec(U, L);
+  TLSBuf.Used := U;
+  Result := L;
+end;
+
+
+
+end.
+

contrib/fundamentals/TLS/flcTLSCertificate.pas

@@ -0,0 +1,244 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSCertificate.pas                                    }
+{   File version:     5.02                                                     }
+{   Description:      TLS Certificate                                          }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2020/05/11  5.02  Create unit flcTLSCertificate from units                 }
+{                     flcTLSHandshake and flcTLSClient.                        }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSCertificate;
+
+interface
+
+uses
+  { Utils }
+
+  flcX509Certificate,
+
+  { Cipher }
+
+  flcCipherRSA;
+
+
+
+{                                                                              }
+{ Certificate                                                                  }
+{                                                                              }
+type
+  TTLSCertificateList = array of RawByteString;
+
+procedure TLSCertificateListAppend(var List: TTLSCertificateList; const A: RawByteString);
+
+function  EncodeTLSCertificate(
+          var Buffer; const Size: Integer;
+          const CertificateList: TTLSCertificateList): Integer;
+
+function  DecodeTLSCertificate(
+          const Buffer; const Size: Integer;
+          var CertificateList: TTLSCertificateList): Integer;
+
+procedure ParseX509Certificates(
+          const CertificateList: TTLSCertificateList;
+          var X509Certificates: TX509CertificateArray);
+
+function  GetCertificateRSAPublicKey(
+          const X509Certificates: TX509CertificateArray;
+          var RSAPublicKey: TRSAPublicKey): Boolean;
+
+
+
+implementation
+
+uses
+  { Utils }
+
+  flcASN1,
+
+  { TLS }
+
+  flcTLSErrors,
+  flcTLSOpaqueEncoding;
+
+
+
+{                                                                              }
+{ Certificate                                                                  }
+{   certificate_list  : <0..2^24-1> ASN.1Cert;                                 }
+{                                                                              }
+{ ASN.1Cert = <1..2^24-1> opaque;                                              }
+{                                                                              }
+procedure TLSCertificateListAppend(var List: TTLSCertificateList; const A: RawByteString);
+var L : Integer;
+begin
+  L := Length(List);
+  SetLength(List, L + 1);
+  List[L] := A;
+end;
+
+function EncodeTLSCertificate(
+         var Buffer; const Size: Integer;
+         const CertificateList: TTLSCertificateList): Integer;
+var P : PByte;
+    N, L, I, M, T : Integer;
+    C : RawByteString;
+begin
+  Assert(Size >= 0);
+  N := Size;
+  P := @Buffer;
+  // certificate_list
+  L := Length(CertificateList);
+  T := 0;
+  for I := 0 to L - 1 do
+    Inc(T, 3 + Length(CertificateList[I]));
+  EncodeTLSLen24(P^, N, T);
+  Dec(N, 3);
+  Inc(P, 3);
+  for I := 0 to L - 1 do
+    begin
+      // ASN.1Cert
+      C := CertificateList[I];
+      if C = '' then
+        raise ETLSError.Create(TLSError_InvalidCertificate);
+      M := EncodeTLSOpaque24(P^, N, C);
+      Dec(N, M);
+      Inc(P, M);
+    end;
+
+  Result := Size - N;
+end;
+
+function DecodeTLSCertificate(
+         const Buffer; const Size: Integer;
+         var CertificateList: TTLSCertificateList): Integer;
+var P : PByte;
+    N, L, M, F : Integer;
+    C : RawByteString;
+begin
+  Assert(Size >= 0);
+  N := Size;
+  P := @Buffer;
+  // certificate_list
+  DecodeTLSLen24(P^, N, L);
+  Dec(N, 3);
+  Inc(P, 3);
+  SetLength(CertificateList, 0);
+  F := 0;
+  while L > 0 do
+    begin
+      // ASN.1Cert
+      M := DecodeTLSOpaque24(P^, N, C);
+      Dec(N, M);
+      Inc(P, M);
+      Dec(L, M);
+      Inc(F);
+      SetLength(CertificateList, F);
+      CertificateList[F - 1] := C;
+    end;
+  Result := Size - N;
+end;
+
+procedure ParseX509Certificates(
+          const CertificateList: TTLSCertificateList;
+          var X509Certificates: TX509CertificateArray);
+var
+  L : Integer;
+  I : Integer;
+  C : RawByteString;
+begin
+  L := Length(CertificateList);
+  SetLength(X509Certificates, L);
+  for I := 0 to L - 1 do
+    begin
+      C := CertificateList[I];
+      InitX509Certificate(X509Certificates[I]);
+      if C <> '' then
+        try
+          ParseX509Certificate(C[1], Length(C), X509Certificates[I])
+        except
+          raise ETLSError.Create(TLSError_InvalidCertificate);
+        end;
+    end;
+end;
+
+function GetCertificateRSAPublicKey(
+         const X509Certificates: TX509CertificateArray;
+         var RSAPublicKey: TRSAPublicKey): Boolean;
+var
+  I, L, N1, N2 : Integer;
+  C : PX509Certificate;
+  S : RawByteString;
+  PKR : TX509RSAPublicKey;
+  R : Boolean;
+begin
+  // find RSA public key from certificates
+  R := False;
+  L := Length(X509Certificates);
+  for I := 0 to L - 1 do
+    begin
+      C := @X509Certificates[I];
+      if ASN1OIDEqual(C^.TBSCertificate.SubjectPublicKeyInfo.Algorithm.Algorithm, OID_RSA) then
+        begin
+          S := C^.TBSCertificate.SubjectPublicKeyInfo.SubjectPublicKey;
+          Assert(S <> '');
+          ParseX509RSAPublicKey(S[1], Length(S), PKR);
+          R := True;
+          break;
+        end;
+    end;
+  if not R then
+    begin
+      Result := False;
+      exit;
+    end;
+  N1 := NormaliseX509IntKeyBuf(PKR.Modulus);
+  N2 := NormaliseX509IntKeyBuf(PKR.PublicExponent);
+  if N2 > N1 then
+    N1 := N2;
+  // initialise RSA public key
+  RSAPublicKeyAssignBuf(RSAPublicKey, N1 * 8,
+      PKR.Modulus[1], Length(PKR.Modulus),
+      PKR.PublicExponent[1], Length(PKR.PublicExponent), True);
+  Result := True;
+end;
+
+
+
+
+end.
+

contrib/fundamentals/TLS/flcTLSCipher.pas

@@ -0,0 +1,335 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        cTLSCipher.pas                                           }
+{   File version:     5.04                                                     }
+{   Description:      TLS cipher                                               }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2018, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial version.                                         }
+{   2010/11/30  0.02  Revision.                                                }
+{   2010/12/16  0.03  AES support.                                             }
+{   2018/07/17  5.04  Revised for Fundamentals 5.                              }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSCipher;
+
+interface
+
+uses
+  { Cipher }
+
+  flcCipher,
+
+  { TLS }
+
+  flcTLSCipherSuite;
+
+
+
+{                                                                              }
+{ Cipher info                                                                  }
+{                                                                              }
+type
+  TTLSCipherSuiteCipherCipherInfo = record
+    CipherType : TCipherType;
+    CipherMode : TCipherMode;
+    Padding    : TCipherPadding;
+  end;
+  PTLSCipherSuiteCipherCipherInfo = ^TTLSCipherSuiteCipherCipherInfo;
+
+const
+  TLSCipherSuiteCipherCipherInfo : array[TTLSCipherSuiteCipher] of TTLSCipherSuiteCipherCipherInfo = (
+    ( // None
+     CipherType : ctNone;
+     CipherMode : cmECB;
+     Padding    : cpNone),
+    ( // NULL
+     CipherType : ctNone;
+     CipherMode : cmECB;
+     Padding    : cpNone),
+    ( // RC2_CBC_40
+     CipherType : ctRC2;
+     CipherMode : cmCBC;
+     Padding    : cpNone),
+    ( // RC4_40
+     CipherType : ctRC4;
+     CipherMode : cmECB;
+     Padding    : cpNone),
+    ( // RC4_56
+     CipherType : ctRC4;
+     CipherMode : cmECB;
+     Padding    : cpNone),
+    ( // RC4_128
+     CipherType : ctRC4;
+     CipherMode : cmECB;
+     Padding    : cpNone),
+    ( // IDEA_CBC
+     CipherType : ctNone;
+     CipherMode : cmCBC;
+     Padding    : cpNone),
+    ( // DES40_CBC
+     CipherType : ctDES;
+     CipherMode : cmCBC;
+     Padding    : cpNone),
+    ( // DES_CBC
+     CipherType : ctDES;
+     CipherMode : cmCBC;
+     Padding    : cpNone),
+    ( // 3DES_EDE_CBC
+     CipherType : ctTripleDES3EDE; //// TripleDESEDE or TripleDES3EDE ?
+     CipherMode : cmCBC;
+     Padding    : cpNone),
+    ( // AES_128_CBC
+     CipherType : ctAES;
+     CipherMode : cmCBC;
+     Padding    : cpNone),
+    ( // AES_256_CBC
+     CipherType : ctAES;
+     CipherMode : cmCBC;
+     Padding    : cpNone)
+  );
+
+
+
+{                                                                              }
+{ Cipher state                                                                 }
+{                                                                              }
+type
+  TTLSCipherOperation = (
+    tlscoNone,
+    tlscoEncrypt,
+    tlscoDecrypt);
+
+  TTLSCipherState = record
+    Operation     : TTLSCipherOperation;
+    TLSCipher     : TTLSCipherSuiteCipher;
+    TLSCipherInfo : TTLSCipherSuiteCipherInfo;
+    CipherInfo    : TTLSCipherSuiteCipherCipherInfo;
+    CipherState   : TCipherState;
+  end;
+
+
+
+{                                                                              }
+{ Cipher                                                                       }
+{                                                                              }
+procedure TLSCipherInitNone(
+          var CipherState: TTLSCipherState;
+          const Operation: TTLSCipherOperation);
+procedure TLSCipherInitNULL(
+          var CipherState: TTLSCipherState;
+          const Operation: TTLSCipherOperation);
+procedure TLSCipherInit(
+          var CipherState: TTLSCipherState;
+          const Operation: TTLSCipherOperation;
+          const TLSCipher: TTLSCipherSuiteCipher;
+          const KeyBuf;
+          const KeySize: Integer);
+
+procedure TLSCipherBuf(
+          var CipherState: TTLSCipherState;
+          const MessageBuf;
+          const MessageSize: Integer;
+          var   CipherBuf;
+          const CipherBufSize: Integer;
+          out   CipherSize: Integer;
+          const IVBufPtr: Pointer;
+          const IVBufSize: Integer);
+
+procedure TLSCipherFinalise(var CipherState: TTLSCipherState);
+
+
+
+{                                                                              }
+{ Test cases                                                                   }
+{                                                                              }
+{$IFDEF TLS_TEST}
+procedure Test;
+{$ENDIF}
+
+
+
+implementation
+
+uses
+  { Utils }
+
+  flcStdTypes,
+
+  { TLS }
+
+  flcTLSErrors;
+
+
+
+{                                                                              }
+{ Cipher                                                                       }
+{                                                                              }
+procedure TLSCipherInitNone(
+          var CipherState: TTLSCipherState;
+          const Operation: TTLSCipherOperation);
+begin
+  FillChar(CipherState, SizeOf(CipherState), 0);
+  CipherState.Operation     := Operation;
+  CipherState.TLSCipher     := tlscscNone;
+  CipherState.TLSCipherInfo := TLSCipherSuiteCipherInfo[tlscscNone];
+  CipherState.CipherInfo    := TLSCipherSuiteCipherCipherInfo[tlscscNone];
+end;
+
+procedure TLSCipherInitNULL(
+          var CipherState: TTLSCipherState;
+          const Operation: TTLSCipherOperation);
+begin
+  FillChar(CipherState, SizeOf(CipherState), 0);
+  CipherState.Operation     := Operation;
+  CipherState.TLSCipher     := tlscscNULL;
+  CipherState.TLSCipherInfo := TLSCipherSuiteCipherInfo[tlscscNULL];
+  CipherState.CipherInfo    := TLSCipherSuiteCipherCipherInfo[tlscscNULL];
+end;
+
+procedure TLSCipherInit(
+          var CipherState: TTLSCipherState;
+          const Operation: TTLSCipherOperation;
+          const TLSCipher: TTLSCipherSuiteCipher;
+          const KeyBuf;
+          const KeySize: Integer);
+begin
+  FillChar(CipherState, SizeOf(CipherState), 0);
+  CipherState.Operation     := Operation;
+  CipherState.TLSCipher     := TLSCipher;
+  CipherState.TLSCipherInfo := TLSCipherSuiteCipherInfo[TLSCipher];
+  CipherState.CipherInfo    := TLSCipherSuiteCipherCipherInfo[TLSCipher];
+  case Operation of
+    tlscoEncrypt :
+      EncryptInit(
+          CipherState.CipherState,
+          CipherState.CipherInfo.CipherType,
+          CipherState.CipherInfo.CipherMode,
+          CipherState.CipherInfo.Padding,
+          CipherState.TLSCipherInfo.KeyBits, @KeyBuf, KeySize);
+    tlscoDecrypt :
+      DecryptInit(
+          CipherState.CipherState,
+          CipherState.CipherInfo.CipherType,
+          CipherState.CipherInfo.CipherMode,
+          CipherState.CipherInfo.Padding,
+          CipherState.TLSCipherInfo.KeyBits, @KeyBuf, KeySize);
+  end;
+end;
+
+procedure TLSCipherBuf(
+          var CipherState: TTLSCipherState;
+          const MessageBuf;
+          const MessageSize: Integer;
+          var CipherBuf;
+          const CipherBufSize: Integer;
+          out CipherSize: Integer;
+          const IVBufPtr: Pointer;
+          const IVBufSize: Integer);
+begin
+  if CipherState.Operation = tlscoNone then
+    raise ETLSError.Create(TLSError_InvalidParameter); // cipher not initialised
+  if MessageSize < 0 then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+  if CipherBufSize < MessageSize then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+  if CipherState.TLSCipher in [tlscscNone, tlscscNULL] then
+    begin
+      Move(MessageBuf, CipherBuf, MessageSize);
+      CipherSize := MessageSize;
+    end
+  else
+  case CipherState.Operation of
+    tlscoEncrypt :
+      CipherSize := EncryptBuf(CipherState.CipherState,
+          @MessageBuf, MessageSize,
+          @CipherBuf, CipherBufSize,
+          IVBufPtr, IVBufSize);
+    tlscoDecrypt :
+      begin
+        Move(MessageBuf, CipherBuf, MessageSize);
+        CipherSize := DecryptBuf(CipherState.CipherState,
+            @CipherBuf, MessageSize,
+            IVBufPtr, IVBufSize);
+      end;
+  end;
+end;
+
+procedure TLSCipherFinalise(var CipherState: TTLSCipherState);
+begin
+  case CipherState.Operation of
+    tlscoEncrypt : EncryptFinalise(CipherState.CipherState);
+    tlscoDecrypt : DecryptFinalise(CipherState.CipherState);
+  end;
+end;
+
+
+
+{                                                                              }
+{ Test cases                                                                   }
+{                                                                              }
+{$IFDEF TLS_TEST}
+procedure Test;
+const
+  ClientWriteKey = RawByteString(#$10#$D0#$D6#$C2#$D9#$B7#$62#$CB#$2C#$74#$BF#$5F#$85#$3C#$6F#$E7);
+var
+  S, T : RawByteString;
+  C : TTLSCipherState;
+  B : RawByteString;
+  L : Integer;
+begin
+  //                                                                                              //
+  // Example from http://download.oracle.com/javase/1.5.0/docs/guide/security/jsse/ReadDebug.html //
+
+  //                                                                                              //
+
+  S := ClientWriteKey;
+  TLSCipherInit(C, tlscoEncrypt, tlscscRC4_128, S[1], Length(S));
+  T := RawByteString(
+      #$14#$00#$00#$0C#$F2#$62#$42#$AA#$7C#$7C#$CC#$E7#$49#$0F#$ED#$AC +
+      #$FA#$06#$3C#$9F#$8C#$41#$1D#$ED#$2B#$06#$D0#$5A#$ED#$31#$F2#$80);
+  SetLength(B, 1024);
+  L := 1024;
+  TLSCipherBuf(C, T[1], Length(T), B[1], L, L, nil, 0);
+  SetLength(B, L);
+  Assert(B = RawByteString(
+      #$15#$8C#$25#$BA#$4E#$73#$F5#$27#$79#$49#$B1 +
+      #$E9#$F5#$7E#$C8#$48#$A7#$D3#$A6#$9B#$BD#$6F#$8E#$A5#$8E#$2B#$B7 +
+      #$EE#$DC#$BD#$F4#$D7));
+end;
+{$ENDIF}
+
+
+

contrib/fundamentals/TLS/flcTLSCompress.pas

@@ -0,0 +1,175 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSCompress.pas                                       }
+{   File version:     5.03                                                     }
+{   Description:      TLS compression                                          }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2010/11/30  0.02  Revision.                                                }
+{   2018/07/17  5.03  Revised for Fundamentals 5.                              }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+{$IFDEF TLS_ZLIB_DISABLE}
+  {$UNDEF TLS_COMPRESS_ZLIB}
+{$ELSE}
+  {$DEFINE TLS_COMPRESS_ZLIB}
+{$ENDIF}
+
+unit flcTLSCompress;
+
+interface
+
+uses
+  { TLS }
+
+  flcTLSConsts,
+  flcTLSErrors,
+  flcTLSAlgorithmTypes;
+
+
+
+{                                                                              }
+{ Fragment compression                                                         }
+{                                                                              }
+procedure TLSCompressFragment(
+          const CompressionMethod: TTLSCompressionMethod;
+          const PlainTextBuf; const PlainTextSize: Integer;
+          var CompressedBuf; const CompressedBufSize: Integer;
+          var CompressedSize: Integer);
+
+procedure TLSDecompressFragment(
+          const CompressionMethod: TTLSCompressionMethod;
+          const CompressedBuf; const CompressedSize: Integer;
+          var PlainTextBuf; const PlainTextBufSize: Integer;
+          var PlainTextSize: Integer);
+
+
+
+implementation
+
+{$IFDEF TLS_COMPRESS_ZLIB}
+uses
+  { Utils }
+  flcZLib;
+{$ENDIF}
+
+
+
+{                                                                              }
+{ Fragment compression                                                         }
+{                                                                              }
+procedure TLSCompressFragment(
+          const CompressionMethod: TTLSCompressionMethod;
+          const PlainTextBuf; const PlainTextSize: Integer;
+          var CompressedBuf; const CompressedBufSize: Integer;
+          var CompressedSize: Integer);
+{$IFDEF TLS_COMPRESS_ZLIB}
+var OutBuf : Pointer;
+    OutSize : Integer;
+{$ENDIF}
+begin
+  if (PlainTextSize <= 0) or
+     (PlainTextSize > TLS_PLAINTEXT_FRAGMENT_MAXSIZE) then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+  case CompressionMethod of
+    tlscmNull :
+      begin
+        if CompressedBufSize < PlainTextSize then
+          raise ETLSError.Create(TLSError_InvalidBuffer);
+        Move(PlainTextBuf, CompressedBuf, PlainTextSize);
+        CompressedSize := PlainTextSize;
+      end;
+    {$IFDEF TLS_COMPRESS_ZLIB}
+    tlscmDeflate :
+      begin
+        ZLibCompressBuf(@PlainTextBuf, PlainTextSize, OutBuf, OutSize, zclDefault);
+        if CompressedBufSize < OutSize then
+          raise ETLSError.Create(TLSError_InvalidBuffer);
+        if OutSize > TLS_COMPRESSED_FRAGMENT_MAXSIZE then
+          raise ETLSError.Create(TLSError_InvalidBuffer); // compressed fragment larger than maximum allowed size
+        Move(OutBuf^, CompressedBuf, OutSize);
+        FreeMem(OutBuf);
+        CompressedSize := OutSize;
+      end;
+    {$ENDIF}
+  else
+    raise ETLSError.Create(TLSError_InvalidParameter, 'Invalid compression method');
+  end;
+end;
+
+procedure TLSDecompressFragment(
+          const CompressionMethod: TTLSCompressionMethod;
+          const CompressedBuf; const CompressedSize: Integer;
+          var PlainTextBuf; const PlainTextBufSize: Integer;
+          var PlainTextSize: Integer);
+{$IFDEF TLS_COMPRESS_ZLIB}
+var OutBuf : Pointer;
+    OutSize : Integer;
+{$ENDIF}
+begin
+  if (CompressedSize < 0) or
+     (CompressedSize > TLS_COMPRESSED_FRAGMENT_MAXSIZE) then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+  case CompressionMethod of
+    tlscmNull :
+      begin
+        if PlainTextBufSize < CompressedSize then
+          raise ETLSError.Create(TLSError_InvalidBuffer);
+        Move(CompressedBuf, PlainTextBuf, CompressedSize);
+        PlainTextSize := CompressedSize;
+      end;
+    {$IFDEF TLS_COMPRESS_ZLIB}
+    tlscmDeflate :
+      begin
+        ZLibDecompressBuf(@CompressedBuf, CompressedSize, OutBuf, OutSize);
+        if PlainTextBufSize < OutSize then
+          raise ETLSError.Create(TLSError_InvalidBuffer);
+        if OutSize > TLS_PLAINTEXT_FRAGMENT_MAXSIZE then
+          raise ETLSError.Create(TLSError_InvalidBuffer); // uncompressed fragment larger than maximum allowed size
+        Move(OutBuf^, PlainTextBuf, OutSize);
+        FreeMem(OutBuf);
+        PlainTextSize := OutSize;
+      end;
+    {$ENDIF}
+  else
+    raise ETLSError.Create(TLSError_InvalidParameter, 'Invalid compression method');
+  end;
+end;
+
+
+
+end.
+

contrib/fundamentals/TLS/flcTLSConsts.pas

@@ -0,0 +1,69 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSConsts.pas                                         }
+{   File version:     5.02                                                     }
+{   Description:      TLS Constants                                            }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2020/05/09  5.02  Create flcTLSConsts unit from flcTLSUtils unit.          }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSConsts;
+
+interface
+
+
+
+{                                                                              }
+{ Fundamentals TLS library                                                     }
+{                                                                              }
+const
+  FundamentalsTLSLibraryVersion = '1.00';
+
+
+
+{                                                                              }
+{ TLS Limits                                                                   }
+{                                                                              }
+const
+  TLS_PLAINTEXT_FRAGMENT_MAXSIZE  = 16384 - 1;    // 2^14 - 1
+  TLS_COMPRESSED_FRAGMENT_MAXSIZE = 16384 + 1024; // 2^14 + 1024
+
+
+
+implementation
+
+end.

contrib/fundamentals/TLS/flcTLSErrors.pas

@@ -0,0 +1,201 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSErrors.pas                                         }
+{   File version:     5.03                                                     }
+{   Description:      TLS Errors                                               }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2020/05/09  5.02  Create flcTLSErrors unit from flcTLSUtils unit.          }
+{   2020/05/11  5.03  ETLSError CreateAlert constructor.                       }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSErrors;
+
+interface
+
+uses
+  { System }
+
+  SysUtils,
+
+  { TLS }
+
+  flcTLSAlert;
+
+
+
+{                                                                              }
+{ Errors                                                                       }
+{                                                                              }
+const
+  TLSError_None               = 0;
+  TLSError_InvalidBuffer      = 1;
+  TLSError_InvalidParameter   = 2;
+  TLSError_InvalidCertificate = 3;
+  TLSError_InvalidState       = 4;
+  TLSError_DecodeError        = 5;
+  TLSError_BadProtocol        = 6;
+
+function TLSErrorMessage(const TLSError: Integer): String;
+
+type
+  ETLSError = class(Exception)
+  private
+    FTLSError         : Integer;
+    FAlertDescription : TTLSAlertDescription;
+
+    function  InitAlert(
+              const ATLSError: Integer;
+              const AAlertDescription: TTLSAlertDescription;
+              const AMsg: String = ''): String;
+
+  public
+    constructor Create(
+                const ATLSError: Integer;
+                const AMsg: String = '');
+
+    constructor CreateAlert(
+                const ATLSError: Integer;
+                const AAlertDescription: TTLSAlertDescription;
+                const AMsg: String = '');
+
+    constructor CreateAlertBufferDecode;
+    constructor CreateAlertBufferEncode;
+
+    constructor CreateAlertUnexpectedMessage;
+
+    constructor CreateAlertBadProtocolVersion;
+
+    property TLSError: Integer read FTLSError;
+    property AlertDescription: TTLSAlertDescription read FAlertDescription;
+  end;
+
+
+
+implementation
+
+
+
+{                                                                              }
+{ Errors                                                                       }
+{                                                                              }
+const
+  SErr_InvalidBuffer      = 'Invalid buffer';
+  SErr_InvalidCertificate = 'Invalid certificate';
+  SErr_InvalidParameter   = 'Invalid parameter';
+  SErr_InvalidState       = 'Invalid state';
+  SErr_DecodeError        = 'Decode error';
+  SErr_BadProtocol        = 'Bad protocol';
+
+function TLSErrorMessage(const TLSError: Integer): String;
+begin
+  case TLSError of
+    TLSError_None               : Result := '';
+    TLSError_InvalidBuffer      : Result := SErr_InvalidBuffer;
+    TLSError_InvalidParameter   : Result := SErr_InvalidParameter;
+    TLSError_InvalidCertificate : Result := SErr_InvalidCertificate;
+    TLSError_InvalidState       : Result := SErr_InvalidState;
+    TLSError_DecodeError        : Result := SErr_DecodeError;
+    TLSError_BadProtocol        : Result := SErr_BadProtocol;
+  else
+    Result := '[TLSError#' + IntToStr(TLSError) + ']';
+  end;
+end;
+
+constructor ETLSError.Create(
+            const ATLSError: Integer;
+            const AMsg: String);
+var S : String;
+begin
+  FTLSError := ATLSError;
+  if AMsg = '' then
+    S := TLSErrorMessage(ATLSError)
+  else
+    S := AMsg;
+  FAlertDescription := tlsadMax;
+  inherited Create(S);
+end;
+
+constructor ETLSError.CreateAlert(
+            const ATLSError: Integer;
+            const AAlertDescription: TTLSAlertDescription;
+            const AMsg: String);
+begin
+  inherited Create(InitAlert(ATLSError, AAlertDescription, AMsg));
+end;
+
+function ETLSError.InitAlert(
+         const ATLSError: Integer;
+         const AAlertDescription: TTLSAlertDescription;
+         const AMsg: String): String;
+var
+  S : String;
+begin
+  FTLSError := ATLSError;
+  FAlertDescription := AAlertDescription;
+
+  if AMsg = '' then
+    S := TLSErrorMessage(ATLSError) + ':' + TLSAlertDescriptionToStr(AAlertDescription)
+  else
+    S := AMsg;
+
+  Result := S;
+end;
+
+constructor ETLSError.CreateAlertBufferDecode;
+begin
+  inherited Create(InitAlert(TLSError_InvalidBuffer, tlsadDecode_error));
+end;
+
+constructor ETLSError.CreateAlertBufferEncode;
+begin
+  inherited Create(InitAlert(TLSError_InvalidBuffer, tlsadInternal_error));
+end;
+
+constructor ETLSError.CreateAlertUnexpectedMessage;
+begin
+  inherited Create(InitAlert(TLSError_BadProtocol, tlsadUnexpected_message));
+end;
+
+constructor ETLSError.CreateAlertBadProtocolVersion;
+begin
+  inherited Create(InitAlert(TLSError_BadProtocol, tlsadProtocol_version));
+end;
+
+
+
+end.
+

contrib/fundamentals/TLS/flcTLSHandshakeExtension.pas

@@ -0,0 +1,152 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSHandshakeExtension.pas                             }
+{   File version:     5.03                                                     }
+{   Description:      TLS handshake extension                                  }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2020/05/11  5.02  ExtensionType.                                           }
+{                     SignatureAlgorithms ClientHello extension.               }
+{   2020/05/19  5.03  Create flcTLSHandshakeExtension unit from                }
+{                     flcTLSHandshake unit.                                    }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSHandshakeExtension;
+
+interface
+
+uses
+  { TLS }
+
+  flcTLSAlgorithmTypes;
+
+
+
+{                                                                              }
+{ ExtensionType                                                                }
+{                                                                              }
+type
+  TTLSExtensionType = (
+    tlsetServer_name                            = 0,     // RFC 6066
+    tlsetMax_fragment_length                    = 1,     // RFC 6066
+    tlsetStatus_request                         = 5,     // RFC 6066
+    tlsetSupported_groups                       = 10,    // RFC 8422, 7919
+    tlsetSignature_algorithms                   = 13,    // RFC 8446 - TLS 1.2
+    tlsetUse_srtp                               = 14,    // RFC 5764
+    tlsetHeartbeat                              = 15,    // RFC 6520
+    tlsetApplication_layer_protocol_negotiation = 16,    // RFC 7301
+    tlsetSigned_certificate_timestamp           = 18,    // RFC 6962
+    tlsetClient_certificate_type                = 19,    // RFC 7250
+    tlsetServer_certificate_type                = 20,    // RFC 7250
+    tlsetPadding                                = 21,    // RFC 7685
+    tlsetPre_shared_key                         = 41,    // RFC 8446
+    tlsetEarly_data                             = 42,    // RFC 8446
+    tlsetSupported_versions                     = 43,    // RFC 8446
+    tlsetCookie                                 = 44,    // RFC 8446
+    tlsetPsk_key_exchange_modes                 = 45,    // RFC 8446
+    tlsetCertificate_authorities                = 47,    // RFC 8446
+    tlsetOid_filters                            = 48,    // RFC 8446
+    tlsetPost_handshake_auth                    = 49,    // RFC 8446
+    tlsetSignature_algorithms_cert              = 50,    // RFC 8446
+    tlsetKey_share                              = 51,    // RFC 8446
+    tlsetMax                                    = 65535
+    );
+
+
+
+{                                                                              }
+{ SignatureAlgorithms                                                          }
+{                                                                              }
+function EncodeTLSExtension_SignatureAlgorithms(
+         var Buffer; const Size: Integer;
+         const SignAndHashAlgos: TTLSSignatureAndHashAlgorithmArray): Integer;
+
+
+
+implementation
+
+uses
+  { TLS }
+
+  flcTLSErrors,
+  flcTLSOpaqueEncoding;
+
+
+
+{                                                                              }
+{ SignatureAlgorithms                                                          }
+{                                                                              }
+function EncodeTLSExtension_SignatureAlgorithms(
+         var Buffer; const Size: Integer;
+         const SignAndHashAlgos: TTLSSignatureAndHashAlgorithmArray): Integer;
+var P     : PByte;
+    L, N  : Integer;
+    C, I  : Integer;
+begin
+  N := Size;
+  P := @Buffer;
+
+  Dec(N, 2);
+  if N < 0 then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+  EncodeTLSWord16(P^, N, Ord(TTLSExtensionType.tlsetSignature_algorithms));
+  Inc(P, 2);
+
+  C := Length(SignAndHashAlgos);
+  Assert(C > 0);
+  L := C * TLSSignatureAndHashAlgorithmSize;
+  EncodeTLSLen16(P^, N, L);
+  Inc(P, 2);
+  Dec(N, 2);
+
+  Dec(N, L);
+  if N < 0 then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+
+  for I := 0 to C - 1 do
+    begin
+      P^ := Ord(SignAndHashAlgos[I].Hash);
+      Inc(P);
+      P^ := Ord(SignAndHashAlgos[I].Signature);
+      Inc(P);
+    end;
+
+  Result := Size - N;
+end;
+
+
+
+end.

contrib/fundamentals/TLS/flcTLSKeyExchangeParams.pas

@@ -0,0 +1,885 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSKeyExchangeParams.pas                              }
+{   File version:     5.04                                                     }
+{   Description:      TLS Key Exchange Parameters                              }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{   References:                                                                }
+{                                                                              }
+{     RFC 4492 - Elliptic Curve Cryptography (ECC) Cipher Suites for           }
+{     Transport Layer Security (TLS)                                           }
+{     https://tools.ietf.org/html/rfc4492                                      }
+{                                                                              }
+{     RFC 8422 - Elliptic Curve Cryptography (ECC) Cipher Suites for           }
+{     Transport Layer Security (TLS) Versions 1.2 and Earlier                  }
+{     https://tools.ietf.org/html/rfc8422                                      }
+{                                                                              }
+{     https://ldapwiki.com/wiki/Key-Exchange                                   }
+{     https://crypto.stackexchange.com/questions/26354/whats-the-structure-of-server-key-exchange-message-during-tls-handshake }
+{     https://security.stackexchange.com/questions/8343/what-key-exchange-mechanism-should-be-used-in-tls }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2020/05/09  5.02  Create flcTLSKeyExchangeParams unit from                 }
+{                     flcTLSUtils unit.                                        }
+{   2020/05/11  5.03  TLSDigitallySigned, SignTLSServerKeyExchangeDH_RSA.      }
+{   2020/05/19  5.04  Sign/Verify RSA authentication signature for DHE_RSA.    }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSKeyExchangeParams;
+
+interface
+
+uses
+  { System }
+
+  SysUtils,
+
+  { Utils }
+
+  flcStdTypes,
+
+  { Cipher }
+
+  flcCipherRSA,
+
+  { TLS }
+
+  flcTLSAlgorithmTypes;
+
+
+
+{                                                                              }
+{ ServerDHParams                                                               }
+{ Ephemeral DH parameters                                                      }
+{                                                                              }
+type
+  TTLSServerDHParams = record
+    dh_p  : RawByteString;
+    dh_g  : RawByteString;
+    dh_Ys : RawByteString;
+  end;
+
+procedure AssignTLSServerDHParams(var ServerDHParams: TTLSServerDHParams;
+          const p, g, Ys: RawByteString);
+
+function  EncodeTLSServerDHParams(
+          var Buffer; const Size: Integer;
+          const ServerDHParams: TTLSServerDHParams): Integer;
+
+function  DecodeTLSServerDHParams(
+          const Buffer; const Size: Integer;
+          var ServerDHParams: TTLSServerDHParams): Integer;
+
+
+
+{                                                                              }
+{ ServerRSAParams                                                              }
+{                                                                              }
+type
+  TTLSServerRSAParams = record
+    rsa_modulus  : RawByteString;
+    rsa_exponent : RawByteString;
+  end;
+
+procedure AssignTLSServerRSAParams(var ServerRSAParams: TTLSServerRSAParams;
+          const modulus, exponent: RawByteString);
+
+function  EncodeTLSServerRSAParams(
+          var Buffer; const Size: Integer;
+          const ServerRSAParams: TTLSServerRSAParams): Integer;
+
+function  DecodeTLSServerRSAParams(
+          const Buffer; const Size: Integer;
+          var ServerRSAParams: TTLSServerRSAParams): Integer;
+
+
+{                                                                              }
+{ ServerECDHParams                                                             }
+{                                                                              }
+
+
+
+
+{                                                                              }
+{ ServerParamsHashBuf                                                          }
+{                                                                              }
+type
+  TTLSClientServerRandom = array[0..31] of Byte;
+  PTLSClientServerRandom = ^TTLSClientServerRandom;
+
+function EncodeTLSServerDHParamsHashBuf(
+         var Buffer; const Size: Integer;
+         const client_random: TTLSClientServerRandom;
+         const server_random: TTLSClientServerRandom;
+         const Params: TTLSServerDHParams): Integer;
+
+
+
+{                                                                              }
+{ SignedStruct                                                                 }
+{                                                                              }
+type
+  TTLSRSASignedStruct = packed record
+    md5_hash : array[0..15] of Byte;
+    sha_hash : array[0..19] of Byte;
+  end;
+
+  TTLSDSASignedStruct = packed record
+    sha_hash : array[0..19] of Byte;
+  end;
+
+
+
+{                                                                              }
+{ DigitallySigned                                                              }
+{                                                                              }
+{     SignatureAndHashAlgorithm algorithm;                                     }
+{     opaque signature<0..2^16-1>;                                             }
+{                                                                              }
+type
+  TTLSDigitallySigned = record
+    Algorithm : TTLSSignatureAndHashAlgorithm;
+    Signature : RawByteString;
+  end;
+
+function  EncodeTLSDigitallySigned(
+          var Buffer; const Size: Integer;
+          const Signed: TTLSDigitallySigned): Integer;
+
+function  DecodeTLSDigitallySigned(
+          const Buffer; const Size: Integer;
+          var Signed: TTLSDigitallySigned): Integer;
+
+
+
+{                                                                              }
+{ ServerKeyExchange                                                            }
+{                                                                              }
+type
+  TTLSServerKeyExchange = record
+    DHParams     : TTLSServerDHParams;
+    RSAParams    : TTLSServerRSAParams;
+    SignedParams : TTLSDigitallySigned;
+  end;
+
+procedure InitTLSServerKeyExchange(var ServerKeyExchange: TTLSServerKeyExchange);
+
+procedure AssignTLSServerKeyExchangeDHParams(
+          var ServerKeyExchange: TTLSServerKeyExchange;
+          const p, g, Ys: RawByteString);
+
+function  EncodeTLSServerKeyExchange(
+          var Buffer; const Size: Integer;
+          const KeyExchangeAlgorithm: TTLSKeyExchangeAlgorithm;
+          const ServerKeyExchange: TTLSServerKeyExchange): Integer;
+
+function  DecodeTLSServerKeyExchange(
+          const Buffer; const Size: Integer;
+          const KeyExchangeAlgorithm: TTLSKeyExchangeAlgorithm;
+          var ServerKeyExchange: TTLSServerKeyExchange): Integer;
+
+procedure SignTLSServerKeyExchangeDH_RSA(
+          var ServerKeyExchange: TTLSServerKeyExchange;
+          const client_random : TTLSClientServerRandom;
+          const server_random : TTLSClientServerRandom;
+          const RSAPrivateKey: TRSAPrivateKey);
+
+function  VerifyTLSServerKeyExchangeDH_RSA(
+          const ServerKeyExchange: TTLSServerKeyExchange;
+          const client_random : TTLSClientServerRandom;
+          const server_random : TTLSClientServerRandom;
+          const RSAPublicKey: TRSAPublicKey): Boolean;
+
+
+
+{                                                                              }
+{ ClientDiffieHellmanPublic                                                    }
+{                                                                              }
+type
+  TTLSClientDiffieHellmanPublic = record
+    PublicValueEncodingExplicit : Boolean;
+    dh_Yc : RawByteString;
+  end;
+
+function EncodeTLSClientDiffieHellmanPublic(
+         var Buffer; const Size: Integer;
+         const ClientDiffieHellmanPublic: TTLSClientDiffieHellmanPublic): Integer;
+
+function DecodeTLSClientDiffieHellmanPublic(
+         const Buffer; const Size: Integer;
+         const PublicValueEncodingExplicit: Boolean;
+         var ClientDiffieHellmanPublic: TTLSClientDiffieHellmanPublic): Integer;
+
+
+
+{                                                                              }
+{ ClientKeyExchange                                                            }
+{                                                                              }
+type
+  TTLSClientKeyExchange = record
+    EncryptedPreMasterSecret  : RawByteString;
+    ClientDiffieHellmanPublic : TTLSClientDiffieHellmanPublic;
+  end;
+
+function  EncodeTLSClientKeyExchange(
+          var Buffer; const Size: Integer;
+          const KeyExchangeAlgorithm: TTLSKeyExchangeAlgorithm;
+          const ClientKeyExchange: TTLSClientKeyExchange): Integer;
+
+function  DecodeTLSClientKeyExchange(
+          const Buffer; const Size: Integer;
+          const KeyExchangeAlgorithm: TTLSKeyExchangeAlgorithm;
+          const PublicValueEncodingExplicit: Boolean;
+          var ClientKeyExchange: TTLSClientKeyExchange): Integer;
+
+
+
+implementation
+
+uses
+  { Utils }
+
+  flcHash,
+  flcHugeInt,
+
+  { TLS }
+
+  flcTLSAlert,
+  flcTLSErrors,
+  flcTLSOpaqueEncoding;
+
+
+
+{                                                                              }
+{ ServerDHParams                                                               }
+{ Ephemeral DH parameters                                                      }
+{                                                                              }
+{   struct                                                                     }
+{     dh_p  : opaque <1..2^16-1>;                                              }
+{     dh_g  : opaque <1..2^16-1>;                                              }
+{     dh_Ys : opaque <1..2^16-1>;                                              }
+{                                                                              }
+procedure AssignTLSServerDHParams(var ServerDHParams: TTLSServerDHParams;
+          const p, g, Ys: RawByteString);
+begin
+  ServerDHParams.dh_p := p;
+  ServerDHParams.dh_g := g;
+  ServerDHParams.dh_Ys := Ys;
+end;
+
+function EncodeTLSServerDHParams(
+         var Buffer; const Size: Integer;
+         const ServerDHParams: TTLSServerDHParams): Integer;
+var P : PByte;
+    N, L : Integer;
+begin
+  Assert(Size >= 0);
+
+  if (ServerDHParams.dh_p = '') or
+     (ServerDHParams.dh_g = '') or
+     (ServerDHParams.dh_Ys = '') then
+    raise ETLSError.Create(TLSError_InvalidParameter);
+
+  N := Size;
+  P := @Buffer;
+  // dh_p
+  L := EncodeTLSOpaque16(P^, N, ServerDHParams.dh_p);
+  Dec(N, L);
+  Inc(P, L);
+  // dh_g
+  L := EncodeTLSOpaque16(P^, N, ServerDHParams.dh_g);
+  Dec(N, L);
+  Inc(P, L);
+  // dh_Ys
+  L := EncodeTLSOpaque16(P^, N, ServerDHParams.dh_Ys);
+  Dec(N, L);
+  Result := Size - N;
+end;
+
+function DecodeTLSServerDHParams(
+         const Buffer; const Size: Integer;
+         var ServerDHParams: TTLSServerDHParams): Integer;
+var P : PByte;
+    N, L : Integer;
+begin
+  Assert(Size >= 0);
+  N := Size;
+  P := @Buffer;
+  // dh_p
+  L := DecodeTLSOpaque16(P^, N, ServerDHParams.dh_p);
+  Dec(N, L);
+  Inc(P, L);
+  // dh_g
+  L := DecodeTLSOpaque16(P^, N, ServerDHParams.dh_g);
+  Dec(N, L);
+  Inc(P, L);
+  // dh_Ys
+  L := DecodeTLSOpaque16(P^, N, ServerDHParams.dh_Ys);
+  Dec(N, L);
+  Result := Size - N;
+end;
+
+
+
+{                                                                              }
+{ ServerRSAParams                                                              }
+{                                                                              }
+{   struct                                                                     }
+{     rsa_modulus  : opaque <1..2^16-1>;                                       }
+{     rsa_exponent : opaque <1..2^16-1>;                                       }
+{                                                                              }
+procedure AssignTLSServerRSAParams(var ServerRSAParams: TTLSServerRSAParams;
+          const modulus, exponent: RawByteString);
+begin
+  ServerRSAParams.rsa_modulus := modulus;
+  ServerRSAParams.rsa_exponent := exponent;
+end;
+
+function EncodeTLSServerRSAParams(
+         var Buffer; const Size: Integer;
+         const ServerRSAParams: TTLSServerRSAParams): Integer;
+var P : PByte;
+    N, L : Integer;
+begin
+  Assert(Size >= 0);
+  if (ServerRSAParams.rsa_modulus = '') or
+     (ServerRSAParams.rsa_exponent = '') then
+    raise ETLSError.Create(TLSError_InvalidParameter);
+  N := Size;
+  P := @Buffer;
+  // rsa_modulus
+  L := EncodeTLSOpaque16(P^, N, ServerRSAParams.rsa_modulus);
+  Dec(N, L);
+  Inc(P, L);
+  // rsa_exponent
+  L := EncodeTLSOpaque16(P^, N, ServerRSAParams.rsa_exponent);
+  Dec(N, L);
+  Result := Size - N;
+end;
+
+function DecodeTLSServerRSAParams(
+         const Buffer; const Size: Integer;
+         var ServerRSAParams: TTLSServerRSAParams): Integer;
+var P : PByte;
+    N, L : Integer;
+begin
+  Assert(Size >= 0);
+  N := Size;
+  P := @Buffer;
+  // rsa_modulus
+  L := DecodeTLSOpaque16(P^, N, ServerRSAParams.rsa_modulus);
+  Dec(N, L);
+  Inc(P, L);
+  // rsa_exponent
+  L := DecodeTLSOpaque16(P^, N, ServerRSAParams.rsa_exponent);
+  Dec(N, L);
+  Result := Size - N;
+end;
+
+
+
+
+{                                                                              }
+{ ECParameters                                                                 }
+{                                                                              }
+type
+  TTLSECParameters = record
+    CurveType  : TTLSECCurveType;
+    NamedCurve : TTLSNamedCurve;
+  end;
+
+
+(*
+            ECCurveType    curve_type;
+            select (curve_type) {
+                case explicit_prime:
+                    opaque      prime_p <1..2^8-1>;
+                    ECCurve     curve;
+                    ECPoint     base;
+                    opaque      order <1..2^8-1>;
+                    opaque      cofactor <1..2^8-1>;
+                case explicit_char2:
+                    uint16      m;
+                    ECBasisType basis;
+                    select (basis) {
+                        case ec_trinomial:
+                            opaque  k <1..2^8-1>;
+                        case ec_pentanomial:
+                            opaque  k1 <1..2^8-1>;
+                            opaque  k2 <1..2^8-1>;
+                            opaque  k3 <1..2^8-1>;
+                    };
+                    ECCurve     curve;
+                    ECPoint     base;
+                    opaque      order <1..2^8-1>;
+                    opaque      cofactor <1..2^8-1>;
+                case named_curve:
+                    NamedCurve namedcurve;
+            };
+        }
+*)
+
+
+{                                                                              }
+{ ECPoint                                                                      }
+{                                                                              }
+{               opaque point <1..2^8-1>;                                       }
+{                                                                              }
+type
+  TTLSECPoint = array of Byte;
+
+
+
+{                                                                              }
+{ ServerECDHParams                                                             }
+{                                                                              }
+{            ECParameters    curve_params;                                     }
+{            ECPoint         public;                                           }
+{                                                                              }
+type
+  TTLSServerECDHParams = record
+    CurveParams : TTLSECParameters;
+    PublicKey   : TTLSECPoint;
+  end;
+
+
+
+
+{                                                                              }
+{ ServerParamsHashBuf                                                          }
+{                                                                              }
+function EncodeTLSServerDHParamsHashBuf(
+         var Buffer; const Size: Integer;
+         const client_random: TTLSClientServerRandom;
+         const server_random: TTLSClientServerRandom;
+         const Params: TTLSServerDHParams): Integer;
+var P : PByte;
+    N, L : Integer;
+begin
+  N := Size;
+  P := @Buffer;
+  Dec(N, 64);
+  if N < 0 then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+  Move(client_random, P^, 32);
+  Inc(P, 32);
+  Move(server_random, P^, 32);
+  Inc(P, 32);
+  L := EncodeTLSServerDHParams(P^, N, Params);
+  Dec(N, L);
+  Result := Size - N;
+end;
+
+
+
+{                                                                              }
+{ DigitallySigned                                                              }
+{                                                                              }
+(*   struct {                                                                 *)
+(*       SignatureAndHashAlgorithm algorithm;                                 *)
+(*       opaque signature<0..2^16-1>;                                         *)
+(*    } DigitallySigned;                                                      *)
+{                                                                              }
+function EncodeTLSDigitallySigned(
+         var Buffer; const Size: Integer;
+         const Signed: TTLSDigitallySigned): Integer;
+var P : PByte;
+    N, L : Integer;
+begin
+  Assert(Signed.Algorithm.Hash <> tlshaNone);
+  Assert(Signed.Algorithm.Signature <> tlssaAnonymous);
+  Assert(Length(Signed.Signature) > 0);
+
+  N := Size;
+  P := @Buffer;
+  Dec(N, 2);
+  if N < 0 then
+    raise ETLSError.CreateAlertBufferEncode;
+  P^ := Ord(Signed.Algorithm.Hash);
+  Inc(P);
+  P^ := Ord(Signed.Algorithm.Signature);
+  Inc(P);
+  L := EncodeTLSOpaque16(P^, N, Signed.Signature);
+  Dec(N, L);
+  Result := Size - N;
+end;
+
+function DecodeTLSDigitallySigned(
+         const Buffer; const Size: Integer;
+         var Signed: TTLSDigitallySigned): Integer;
+var P : PByte;
+    N, L : Integer;
+begin
+  N := Size;
+  P := @Buffer;
+  Dec(N, 2);
+  if N < 0 then
+    raise ETLSError.CreateAlertBufferDecode;
+  Signed.Algorithm.Hash := TTLSHashAlgorithm(P^);
+  Inc(P);
+  Signed.Algorithm.Signature := TTLSSignatureAlgorithm(P^);
+  Inc(P);
+  L := DecodeTLSOpaque16(P^, N, Signed.Signature);
+  Dec(N, L);
+  Result := Size - N;
+end;
+
+
+
+{                                                                              }
+{ Server Key Exchange                                                          }
+{                                                                              }
+{   select (KeyExchangeAlgorithm)                                              }
+{     case dh_anon: params : ServerDHParams;                                   }
+{     case dhe_dss:                                                            }
+{     case dhe_rsa: params : ServerDHParams;                                   }
+{                   signed_params : digitally-signed struct (                  }
+{                     client_random : opaque [32];                             }
+{                     server_random : opaque [32];                             }
+{                     params : ServerDHParams ;                                }
+{                     );                                                       }
+{     case rsa:                                                                }
+{     case dh_dss:                                                             }
+{     case dh_rsa: struct ();                                                  }
+{     case ec_diffie_hellman:                                                  }
+{              ServerECDHParams    params;                                     }
+{              Signature           signed_params;                              }
+{                                                                              }
+procedure InitTLSServerKeyExchange(var ServerKeyExchange: TTLSServerKeyExchange);
+begin
+  FillChar(ServerKeyExchange, SizeOf(ServerKeyExchange), 0);
+end;
+
+procedure AssignTLSServerKeyExchangeDHParams(
+          var ServerKeyExchange: TTLSServerKeyExchange;
+          const p, g, Ys: RawByteString);
+begin
+  AssignTLSServerDHParams(ServerKeyExchange.DHParams, p, g, Ys);
+end;
+
+function EncodeTLSServerKeyExchange(
+         var Buffer; const Size: Integer;
+         const KeyExchangeAlgorithm: TTLSKeyExchangeAlgorithm;
+         const ServerKeyExchange: TTLSServerKeyExchange): Integer;
+var P : PByte;
+    N, L : Integer;
+begin
+  Assert(KeyExchangeAlgorithm <> tlskeaNone);
+
+  N := Size;
+  P := @Buffer;
+  case KeyExchangeAlgorithm of
+    tlskeaDH_Anon :
+      begin
+        L := EncodeTLSServerDHParams(P^, N, ServerKeyExchange.DHParams);
+        Dec(N, L);
+      end;
+    tlskeaDHE_DSS,
+    tlskeaDHE_RSA :
+      begin
+        L := EncodeTLSServerDHParams(P^, N, ServerKeyExchange.DHParams);
+        Dec(N, L);
+        Inc(P, L);
+        L := EncodeTLSDigitallySigned(P^, N, ServerKeyExchange.SignedParams);
+        Dec(N, L);
+      end;
+    tlskeaECDHE_ECDSA,
+    tlskeaECDHE_RSA : ;
+    tlskeaRSA,
+    tlskeaDH_DSS,
+    tlskeaDH_RSA : ;
+  end;
+  Result := Size - N;
+end;
+
+function DecodeTLSServerKeyExchange(
+         const Buffer; const Size: Integer;
+         const KeyExchangeAlgorithm: TTLSKeyExchangeAlgorithm;
+         var ServerKeyExchange: TTLSServerKeyExchange): Integer;
+var P : PByte;
+    N, L : Integer;
+begin
+  N := Size;
+  P := @Buffer;
+  case KeyExchangeAlgorithm of
+    tlskeaDH_Anon :
+      begin
+        L := DecodeTLSServerDHParams(P^, N, ServerKeyExchange.DHParams);
+        Dec(N, L);
+      end;
+    tlskeaDHE_DSS,
+    tlskeaDHE_RSA :
+      begin
+        L := DecodeTLSServerDHParams(P^, N, ServerKeyExchange.DHParams);
+        Dec(N, L);
+        Inc(P, L);
+        L := DecodeTLSDigitallySigned(P^, N, ServerKeyExchange.SignedParams);
+        Dec(N, L);
+      end;
+    tlskeaRSA,
+    tlskeaDH_DSS,
+    tlskeaDH_RSA : ;
+  end;
+  Result := Size - N;
+end;
+
+procedure SignTLSServerKeyExchangeDH_RSA(
+          var ServerKeyExchange: TTLSServerKeyExchange;
+          const client_random : TTLSClientServerRandom;
+          const server_random : TTLSClientServerRandom;
+          const RSAPrivateKey: TRSAPrivateKey);
+const
+  MaxHashBufSize = 32768;
+var
+  HashBuf : array[0..MaxHashBufSize - 1] of Byte;
+  L : Integer;
+  //HashMd5 : T128BitDigest;
+  //HashSha : T160BitDigest;
+  //SignedStruct : TTLSRSASignedStruct;
+  //SignHash : T256BitDigest;
+  SignatureBuf : RawByteString;
+begin
+  Writeln('Sign:');
+
+  Assert(Length(ServerKeyExchange.DHParams.dh_p) > 0);
+  Assert(Length(ServerKeyExchange.DHParams.dh_g) > 0);
+  Assert(Length(ServerKeyExchange.DHParams.dh_Ys) > 0);
+  Assert(RSAPrivateKey.KeyBits > 0);
+
+  L := EncodeTLSServerDHParamsHashBuf(
+      HashBuf, SizeOf(HashBuf),
+      client_random,
+      server_random,
+      ServerKeyExchange.DHParams);
+
+      {
+  HashMd5 := CalcMD5(HashBuf, L);
+  HashSha := CalcSHA1(HashBuf, L);
+  Move(HashMd5, SignedStruct.md5_hash, SizeOf(SignedStruct.md5_hash));
+  Move(HashSha, SignedStruct.sha_hash, SizeOf(SignedStruct.sha_hash));
+  SignHash := CalcSHA256(SignedStruct, SizeOf(SignedStruct));
+  Writeln('SignHash:', DigestToHexU(SignHash, Sizeof(SignHash)));
+  Writeln('PrivateKey:', HugeWordToHex(RSAPrivateKey.Exponent), '  ', HugeWordToHex(RSAPrivateKey.Modulus));
+}
+
+  SetLength(SignatureBuf, RSAPrivateKey.KeyBits div 8);
+
+  RSASignMessage(rsastEMSA_PKCS1, rsahfSHA256, RSAPrivateKey,
+      HashBuf, L,
+      Pointer(SignatureBuf)^, Length(SignatureBuf));
+
+  ServerKeyExchange.SignedParams.Algorithm.Hash := tlshaSHA256;
+  ServerKeyExchange.SignedParams.Algorithm.Signature := tlssaRSA;
+  ServerKeyExchange.SignedParams.Signature := SignatureBuf;
+end;
+
+function VerifyTLSServerKeyExchangeDH_RSA(
+         const ServerKeyExchange: TTLSServerKeyExchange;
+         const client_random : TTLSClientServerRandom;
+         const server_random : TTLSClientServerRandom;
+         const RSAPublicKey: TRSAPublicKey): Boolean;
+const
+  MaxHashBufSize = 32768;
+var
+  HashBuf : array[0..MaxHashBufSize - 1] of Byte;
+  L : Integer;
+//  HashMd5 : T128BitDigest;
+//  HashSha : T160BitDigest;
+//  SignedStruct : TTLSRSASignedStruct;
+//  SignHash : T256BitDigest;
+  SignatureBuf : RawByteString;
+begin
+  Assert(Length(ServerKeyExchange.DHParams.dh_p) > 0);
+  Assert(Length(ServerKeyExchange.DHParams.dh_g) > 0);
+  Assert(Length(ServerKeyExchange.DHParams.dh_Ys) > 0);
+  Assert(RSAPublicKey.KeyBits > 0);
+
+  //// After validated, encode hash buf using received Params buf, it might
+  //// have params in a different order.
+  L := EncodeTLSServerDHParamsHashBuf(HashBuf, SizeOf(HashBuf),
+      client_random,
+      server_random,
+      ServerKeyExchange.DHParams);
+
+  SignatureBuf := ServerKeyExchange.SignedParams.Signature;
+
+  (*
+  HashMd5 := CalcMD5(HashBuf, L);
+  HashSha := CalcSHA1(HashBuf, L);
+  Move(HashMd5, SignedStruct.md5_hash, SizeOf(SignedStruct.md5_hash));
+  Move(HashSha, SignedStruct.sha_hash, SizeOf(SignedStruct.sha_hash));
+  SignHash := CalcSHA256(SignedStruct, SizeOf(SignedStruct));
+  Writeln('SignHash:', DigestToHexU(SignHash, Sizeof(SignHash)));
+  Writeln('Signature:', DigestToHexU(Pointer(SignatureBuf)^, Length(SignatureBuf)));
+  Writeln('PublicKey:', HugeWordToHex(RSAPublicKey.Exponent), '  ', HugeWordToHex(RSAPublicKey.Modulus));
+  *)
+
+  Result :=
+      RSACheckSignature(rsastEMSA_PKCS1, RSAPublicKey,
+          HashBuf, L,
+          Pointer(SignatureBuf)^, Length(SignatureBuf));
+end;
+
+
+
+{                                                                              }
+{ ClientDiffieHellmanPublic                                                    }
+{   select (PublicValueEncoding)                                               }
+{       case implicit: struct ();                                              }
+{       case explicit: opaque dh_Yc<1..2^16-1>;                                }
+{                                                                              }
+function EncodeTLSClientDiffieHellmanPublic(
+         var Buffer; const Size: Integer;
+         const ClientDiffieHellmanPublic: TTLSClientDiffieHellmanPublic): Integer;
+var P : PByte;
+    N, L : Integer;
+begin
+  N := Size;
+  P := @Buffer;
+  if ClientDiffieHellmanPublic.PublicValueEncodingExplicit then
+    begin
+      if ClientDiffieHellmanPublic.dh_Yc = '' then
+        raise ETLSError.Create(TLSError_InvalidParameter);
+      L := EncodeTLSOpaque16(P^, N, ClientDiffieHellmanPublic.dh_Yc);
+      Dec(N, L);
+    end;
+  Result := Size - N;
+end;
+
+function DecodeTLSClientDiffieHellmanPublic(
+         const Buffer; const Size: Integer;
+         const PublicValueEncodingExplicit: Boolean;
+         var ClientDiffieHellmanPublic: TTLSClientDiffieHellmanPublic): Integer;
+var P : PByte;
+    N, L : Integer;
+begin
+  N := Size;
+  P := @Buffer;
+  if PublicValueEncodingExplicit then
+    begin
+      L := DecodeTLSOpaque16(P^, N, ClientDiffieHellmanPublic.dh_Yc);
+      Dec(N, L);
+    end;
+  Result := Size - N;
+end;
+
+(*
+    struct {
+               ECPoint ecdh_Yc;
+           } ClientECDiffieHellmanPublic;
+*)
+
+
+{                                                                              }
+{ ClientKeyExchange                                                            }
+{                                                                              }
+{   select (KeyExchangeAlgorithm)                                              }
+{       case rsa     : EncryptedPreMasterSecret;                               }
+{       case dhe_dss :                                                         }
+{       case dhe_rsa :                                                         }
+{       case dh_dss  :                                                         }
+{       case dh_rsa  :                                                         }
+{       case dh_anon : ClientDiffieHellmanPublic;                              }
+{                                                                              }
+function EncodeTLSClientKeyExchange(
+         var Buffer; const Size: Integer;
+         const KeyExchangeAlgorithm: TTLSKeyExchangeAlgorithm;
+         const ClientKeyExchange: TTLSClientKeyExchange): Integer;
+var P : PByte;
+    N, L : Integer;
+begin
+  N := Size;
+  P := @Buffer;
+  case KeyExchangeAlgorithm of
+    tlskeaRSA :
+      begin
+        L := Length(ClientKeyExchange.EncryptedPreMasterSecret);
+        if L = 0 then
+          raise ETLSError.Create(TLSError_InvalidParameter);
+        Move(ClientKeyExchange.EncryptedPreMasterSecret[1], P^, L);
+        Dec(N, L);
+      end;
+    tlskeaDHE_DSS,
+    tlskeaDHE_RSA,
+    tlskeaDH_DSS,
+    tlskeaDH_RSA,
+    tlskeaDH_Anon :
+      begin
+        L := EncodeTLSClientDiffieHellmanPublic(P^, N, ClientKeyExchange.ClientDiffieHellmanPublic);
+        Dec(N, L);
+      end;
+  end;
+  Result := Size - N;
+end;
+
+function DecodeTLSClientKeyExchange(
+         const Buffer; const Size: Integer;
+         const KeyExchangeAlgorithm: TTLSKeyExchangeAlgorithm;
+         const PublicValueEncodingExplicit: Boolean;
+         var ClientKeyExchange: TTLSClientKeyExchange): Integer;
+var P : PByte;
+    N, L, C : Integer;
+begin
+  N := Size;
+  P := @Buffer;
+  case KeyExchangeAlgorithm of
+    tlskeaRSA :
+      begin
+        L := DecodeTLSLen16(P^, N, C);
+        Dec(N, L);
+        Inc(P, L);
+        Assert(N = C);
+        SetLength(ClientKeyExchange.EncryptedPreMasterSecret, C);
+        Move(P^, ClientKeyExchange.EncryptedPreMasterSecret[1], C);
+        Dec(N, C);
+      end;
+    tlskeaDHE_DSS,
+    tlskeaDHE_RSA,
+    tlskeaDH_DSS,
+    tlskeaDH_RSA,
+    tlskeaDH_Anon :
+      begin
+        L := DecodeTLSClientDiffieHellmanPublic(P^, N, PublicValueEncodingExplicit, ClientKeyExchange.ClientDiffieHellmanPublic);
+        Dec(N, L);
+      end;
+  end;
+  Result := Size - N;
+end;
+
+
+
+end.
+

contrib/fundamentals/TLS/flcTLSKeys.pas

@@ -0,0 +1,427 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSKeys.pas                                           }
+{   File version:     5.02                                                     }
+{   Description:      TLS Keys                                                 }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2020/05/09  5.02  Create flcTLSKeys unit from flcTLSUtils unit.            }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSKeys;
+
+interface
+
+uses
+  { Utils }
+
+  flcStdTypes,
+
+  { TLS }
+
+  flcTLSProtocolVersion;
+
+
+
+{                                                                              }
+{ Key block                                                                    }
+{                                                                              }
+function  tls10KeyBlock(const MasterSecret, ServerRandom, ClientRandom: RawByteString; const Size: Integer): RawByteString;
+function  tls12SHA256KeyBlock(const MasterSecret, ServerRandom, ClientRandom: RawByteString; const Size: Integer): RawByteString;
+function  tls12SHA512KeyBlock(const MasterSecret, ServerRandom, ClientRandom: RawByteString; const Size: Integer): RawByteString;
+
+function  TLSKeyBlock(const ProtocolVersion: TTLSProtocolVersion;
+          const MasterSecret, ServerRandom, ClientRandom: RawByteString; const Size: Integer): RawByteString;
+
+
+
+{                                                                              }
+{ Master secret                                                                }
+{                                                                              }
+function  tls10MasterSecret(const PreMasterSecret, ClientRandom, ServerRandom: RawByteString): RawByteString;
+function  tls12SHA256MasterSecret(const PreMasterSecret, ClientRandom, ServerRandom: RawByteString): RawByteString;
+function  tls12SHA512MasterSecret(const PreMasterSecret, ClientRandom, ServerRandom: RawByteString): RawByteString;
+
+function  TLSMasterSecret(const ProtocolVersion: TTLSProtocolVersion;
+
+          const PreMasterSecret, ClientRandom, ServerRandom: RawByteString): RawByteString;
+
+
+
+
+{                                                                              }
+{ TLS Keys                                                                     }
+{                                                                              }
+type
+  TTLSKeys = record
+    KeyBlock     : RawByteString;
+    ClientMACKey : RawByteString;
+    ServerMACKey : RawByteString;
+    ClientEncKey : RawByteString;
+    ServerEncKey : RawByteString;
+    ClientIV     : RawByteString;
+    ServerIV     : RawByteString;
+  end;
+
+procedure GenerateTLSKeys(
+          const ProtocolVersion: TTLSProtocolVersion;
+          const MACKeyBits, CipherKeyBits, IVBits: Integer;
+          const MasterSecret, ServerRandom, ClientRandom: RawByteString;
+          var TLSKeys: TTLSKeys);
+
+procedure GenerateFinalTLSKeys(
+          const ProtocolVersion: TTLSProtocolVersion;
+          const IsExportable: Boolean;
+          const ExpandedKeyBits: Integer;
+          const ServerRandom, ClientRandom: RawByteString;
+          var TLSKeys: TTLSKeys);
+
+
+
+{                                                                              }
+{ Test                                                                         }
+{                                                                              }
+{$IFDEF TLS_TEST}
+
+procedure Test;
+
+{$ENDIF}
+
+
+
+
+implementation
+
+uses
+  { Utils }
+
+  flcHash,
+  flcStrings,
+
+  { TLS }
+
+  flcTLSErrors,
+  flcTLSPRF;
+
+
+
+{                                                                              }
+{ Key block                                                                    }
+{                                                                              }
+{ SSL 3.0:                                                                     }
+{ key_block =                                                                  }
+{      MD5(master_secret + SHA('A' + master_secret +                           }
+{                              ServerHello.random + ClientHello.random)) +     }
+{      MD5(master_secret + SHA('BB' + master_secret +                          }
+{                              ServerHello.random + ClientHello.random)) +     }
+{      MD5(master_secret + SHA('CCC' + master_secret +                         }
+{                              ServerHello.random + ClientHello.random)) +     }
+{                              [...];                                          }
+{                                                                              }
+{ TLS 1.0 / 1.1 / 1.2:                                                         }
+{ key_block = PRF(SecurityParameters.master_secret,                            }
+{                 "key expansion",                                             }
+{                 SecurityParameters.server_random +                           }
+{                 SecurityParameters.client_random);                           }
+{                                                                              }
+function ssl30KeyBlockP(const Prefix, MasterSecret, ServerRandom, ClientRandom: RawByteString): RawByteString;
+begin
+  Result :=
+      MD5DigestToStrA(
+          CalcMD5(MasterSecret +
+              SHA1DigestToStrA(
+                  CalcSHA1(Prefix + MasterSecret + ServerRandom + ClientRandom))));
+end;
+
+function ssl30KeyBlockPF(const MasterSecret, ServerRandom, ClientRandom: RawByteString; const Size: Integer): RawByteString;
+var Salt : RawByteString;
+    I : Integer;
+begin
+  Result := '';
+  I := 1;
+  while Length(Result) < Size do
+    begin
+      if I > 26 then
+        raise ETLSError.Create(TLSError_InvalidParameter);
+      Salt := DupCharB(ByteChar(Ord('A') + I - 1), I);
+      Result := Result +
+          ssl30KeyBlockP(Salt, MasterSecret, ServerRandom, ClientRandom);
+      Inc(I);
+    end;
+  SetLength(Result, Size);
+end;
+
+function ssl30KeyBlock(const MasterSecret, ServerRandom, ClientRandom: RawByteString; const Size: Integer): RawByteString;
+begin
+  Result := ssl30KeyBlockPF(MasterSecret, ServerRandom, ClientRandom, Size);
+end;
+
+const
+  LabelKeyExpansion = 'key expansion';
+
+function tls10KeyBlock(const MasterSecret, ServerRandom, ClientRandom: RawByteString; const Size: Integer): RawByteString;
+var S : RawByteString;
+begin
+  S := ServerRandom + ClientRandom;
+  Result := tls10PRF(MasterSecret, LabelKeyExpansion, S, Size);
+end;
+
+function tls12SHA256KeyBlock(const MasterSecret, ServerRandom, ClientRandom: RawByteString; const Size: Integer): RawByteString;
+var S : RawByteString;
+begin
+  S := ServerRandom + ClientRandom;
+  Result := tls12PRF_SHA256(MasterSecret, LabelKeyExpansion, S, Size);
+end;
+
+function tls12SHA512KeyBlock(const MasterSecret, ServerRandom, ClientRandom: RawByteString; const Size: Integer): RawByteString;
+var S : RawByteString;
+begin
+  S := ServerRandom + ClientRandom;
+  Result := tls12PRF_SHA512(MasterSecret, LabelKeyExpansion, S, Size);
+end;
+
+function TLSKeyBlock(const ProtocolVersion: TTLSProtocolVersion;
+         const MasterSecret, ServerRandom, ClientRandom: RawByteString; const Size: Integer): RawByteString;
+begin
+  if IsTLS12OrLater(ProtocolVersion) then
+    Result := tls12SHA256KeyBlock(MasterSecret, ServerRandom, ClientRandom, Size) else
+  if IsTLS10OrLater(ProtocolVersion) then
+    Result := tls10KeyBlock(MasterSecret, ServerRandom, ClientRandom, Size) else
+  if IsSSL3(ProtocolVersion) then
+    Result := ssl30KeyBlock(MasterSecret, ServerRandom, ClientRandom, Size)
+  else
+    raise ETLSError.Create(TLSError_InvalidParameter);
+end;
+
+
+
+{                                                                              }
+{ Master secret                                                                }
+{                                                                              }
+{ SSL 3:                                                                       }
+{ master_secret =                                                              }
+{      MD5(pre_master_secret + SHA('A' + pre_master_secret +                   }
+{          ClientHello.random + ServerHello.random)) +                         }
+{      MD5(pre_master_secret + SHA('BB' + pre_master_secret +                  }
+{          ClientHello.random + ServerHello.random)) +                         }
+{      MD5(pre_master_secret + SHA('CCC' + pre_master_secret +                 }
+{          ClientHello.random + ServerHello.random));                          }
+{                                                                              }
+{ TLS 1.0 1.1 1.2:                                                             }
+{ master_secret = PRF(pre_master_secret,                                       }
+{                     "master secret",                                         }
+{                     ClientHello.random + ServerHello.random)                 }
+{                                                                              }
+{ The master secret is always exactly 48 bytes in length. The length of        }
+{ the premaster secret will vary depending on key exchange method.             }
+{                                                                              }
+const
+  LabelMasterSecret = 'master secret';
+  MasterSecretSize = 48;
+
+function ssl30MasterSecretP(const Prefix, PreMasterSecret, ClientRandom, ServerRandom: RawByteString): RawByteString;
+begin
+  Result :=
+      MD5DigestToStrA(
+          CalcMD5(PreMasterSecret +
+              SHA1DigestToStrA(
+                  CalcSHA1(Prefix + PreMasterSecret + ClientRandom + ServerRandom))));
+end;
+
+function ssl30MasterSecret(const PreMasterSecret, ClientRandom, ServerRandom: RawByteString): RawByteString;
+begin
+  Result :=
+      ssl30MasterSecretP('A', PreMasterSecret, ClientRandom, ServerRandom) +
+      ssl30MasterSecretP('BB', PreMasterSecret, ClientRandom, ServerRandom) +
+      ssl30MasterSecretP('CCC', PreMasterSecret, ClientRandom, ServerRandom);
+end;
+
+function tls10MasterSecret(const PreMasterSecret, ClientRandom, ServerRandom: RawByteString): RawByteString;
+var S : RawByteString;
+begin
+  S := ClientRandom + ServerRandom;
+  Result := tls10PRF(PreMasterSecret, LabelMasterSecret, S, MasterSecretSize);
+end;
+
+function tls12SHA256MasterSecret(const PreMasterSecret, ClientRandom, ServerRandom: RawByteString): RawByteString;
+var S : RawByteString;
+begin
+  S := ClientRandom + ServerRandom;
+  Result := tls12PRF_SHA256(PreMasterSecret, LabelMasterSecret, S, MasterSecretSize);
+end;
+
+function tls12SHA512MasterSecret(const PreMasterSecret, ClientRandom, ServerRandom: RawByteString): RawByteString;
+var S : RawByteString;
+begin
+  S := ClientRandom + ServerRandom;
+  Result := tls12PRF_SHA512(PreMasterSecret, LabelMasterSecret, S, MasterSecretSize);
+end;
+
+function TLSMasterSecret(const ProtocolVersion: TTLSProtocolVersion;
+         const PreMasterSecret, ClientRandom, ServerRandom: RawByteString): RawByteString;
+
+begin
+
+  if IsTLS12OrLater(ProtocolVersion) then
+
+    Result := tls12SHA256MasterSecret(PreMasterSecret, ClientRandom, ServerRandom) else
+
+  if IsTLS10OrLater(ProtocolVersion) then
+
+    Result := tls10MasterSecret(PreMasterSecret, ClientRandom, ServerRandom) else
+
+  if IsSSL3(ProtocolVersion) then
+
+    Result := ssl30MasterSecret(PreMasterSecret, ClientRandom, ServerRandom)
+
+  else
+
+    raise ETLSError.Create(TLSError_InvalidParameter);
+
+end;
+
+
+
+
+{                                                                              }
+{ TLS Keys                                                                     }
+{                                                                              }
+procedure GenerateTLSKeys(
+          const ProtocolVersion: TTLSProtocolVersion;
+          const MACKeyBits, CipherKeyBits, IVBits: Integer;
+          const MasterSecret, ServerRandom, ClientRandom: RawByteString;
+          var TLSKeys: TTLSKeys);
+var L, I, N : Integer;
+    S : RawByteString;
+begin
+  Assert(MACKeyBits mod 8 = 0);
+  Assert(CipherKeyBits mod 8 = 0);
+  Assert(IVBits mod 8 = 0);
+
+  L := MACKeyBits * 2 + CipherKeyBits * 2 + IVBits * 2;
+  L := L div 8;
+  S := TLSKeyBlock(ProtocolVersion, MasterSecret, ServerRandom, ClientRandom, L);
+  TLSKeys.KeyBlock := S;
+  I := 1;
+  N := MACKeyBits div 8;
+  TLSKeys.ClientMACKey := Copy(S, I, N);
+  TLSKeys.ServerMACKey := Copy(S, I + N, N);
+  Inc(I, N * 2);
+  N := CipherKeyBits div 8;
+  TLSKeys.ClientEncKey := Copy(S, I, N);
+  TLSKeys.ServerEncKey := Copy(S, I + N, N);
+  Inc(I, N * 2);
+  N := IVBits div 8;
+  TLSKeys.ClientIV := Copy(S, I, N);
+  TLSKeys.ServerIV := Copy(S, I + N, N);
+end;
+
+{ TLS 1.0:                                                                     }
+{ final_client_write_key = PRF(SecurityParameters.client_write_key,            }
+{   "client write key",                                                        }
+{   SecurityParameters.client_random + SecurityParameters.server_random);      }
+{ final_server_write_key = PRF(SecurityParameters.server_write_key,            }
+{   "server write key",                                                        }
+{   SecurityParameters.client_random + SecurityParameters.server_random);      }
+{ iv_block = PRF("", "IV block",                                               }
+{   SecurityParameters.client_random + SecurityParameters.server_random);      }
+const
+  LabelClientWriteKey = 'client write key';
+  LabelServerWriteKey = 'server write key';
+  LabelIVBlock        = 'IV block';
+
+procedure GenerateFinalTLSKeys(
+          const ProtocolVersion: TTLSProtocolVersion;
+          const IsExportable: Boolean;
+          const ExpandedKeyBits: Integer;
+          const ServerRandom, ClientRandom: RawByteString;
+          var TLSKeys: TTLSKeys);
+var S : RawByteString;
+    L : Integer;
+    V : RawByteString;
+begin
+  if IsTLS11OrLater(ProtocolVersion) then
+    exit;
+  if not IsExportable then
+    exit;
+  if IsSSL2(ProtocolVersion) or IsSSL3(ProtocolVersion) then
+    raise ETLSError.Create(TLSError_InvalidParameter, 'Unsupported version');
+  S := ClientRandom + ServerRandom;
+  Assert(ExpandedKeyBits mod 8 = 0);
+  L := ExpandedKeyBits div 8;
+  TLSKeys.ClientEncKey := tls10PRF(TLSKeys.ClientEncKey, LabelClientWriteKey, S, L);
+  TLSKeys.ServerEncKey := tls10PRF(TLSKeys.ServerEncKey, LabelServerWriteKey, S, L);
+  L := Length(TLSKeys.ClientIV);
+  if L > 0 then
+    begin
+      V := tls10PRF('', LabelIVBlock, S, L * 2);
+      TLSKeys.ClientIV := Copy(V, 1, L);
+      TLSKeys.ServerIV := Copy(V, L + 1, L);
+    end;
+end;
+
+
+
+{                                                                              }
+{ Test                                                                         }
+{                                                                              }
+{$IFDEF TLS_TEST}
+{$ASSERTIONS ON}
+const
+  PreMasterSecret = RawByteString(
+      #$03#$01#$84#$54#$F5#$D6#$EB#$F5#$A8#$08#$BA#$FA#$7A#$22#$61#$2D +
+      #$75#$DC#$40#$E8#$98#$F9#$0E#$B2#$87#$80#$B8#$1A#$8F#$68#$25#$B8 +
+      #$51#$D0#$54#$45#$61#$8A#$50#$C9#$BB#$0E#$39#$53#$45#$78#$BE#$79);
+  ClientRandom = RawByteString(
+      #$40#$FC#$30#$AE#$2D#$63#$84#$BB#$C5#$4B#$27#$FD#$58#$21#$CA#$90 +
+      #$05#$F6#$A7#$7B#$37#$BB#$72#$E1#$FC#$1D#$1B#$6A#$F5#$1C#$C8#$9F);
+  ServerRandom = RawByteString(
+      #$40#$FC#$31#$10#$79#$AB#$17#$66#$FA#$8B#$3F#$AA#$FD#$5E#$48#$23 +
+      #$FA#$90#$31#$D8#$3C#$B9#$A3#$2C#$8C#$F5#$E9#$81#$9B#$A2#$63#$6C);
+  MasterSecret = RawByteString(
+      #$B0#$00#$22#$34#$59#$03#$16#$B7#$7A#$6C#$56#$9B#$89#$D2#$7A#$CC +
+      #$F3#$85#$55#$59#$3A#$14#$76#$3D#$54#$BF#$EB#$3F#$E0#$2F#$B1#$4B +
+      #$79#$8C#$75#$A9#$78#$55#$6C#$8E#$A2#$14#$60#$B7#$45#$EB#$77#$B2);
+  MACWriteKey = RawByteString(
+      #$85#$F0#$56#$F8#$07#$1D#$B1#$89#$89#$D0#$E1#$33#$3C#$CA#$63#$F9);
+
+procedure TestKeyBlock;
+
+var S : RawByteString;
+
+begin
+
+  //                                                                                              //

contrib/fundamentals/TLS/flcTLSOpaqueEncoding.pas

@@ -0,0 +1,229 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSOpaqueEncoding.pas                                 }
+{   File version:     5.02                                                     }
+{   Description:      TLS Opaque Encoding                                      }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2020/05/09  5.02  Create flcTLSOpaqueEncoding unit from flcTLSUtils unit.  }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSOpaqueEncoding;
+
+interface
+
+
+
+function EncodeTLSWord16(var Buffer; const Size: Integer; const AVal: Integer): Integer;
+function DecodeTLSWord16(const Buffer; const Size: Integer; var AVal: Integer): Integer;
+
+function EncodeTLSLen16(var Buffer; const Size: Integer; const ALen: Integer): Integer;
+function EncodeTLSLen24(var Buffer; const Size: Integer; const ALen: Integer): Integer;
+
+function DecodeTLSLen16(const Buffer; const Size: Integer; var ALen: Integer): Integer;
+function DecodeTLSLen24(const Buffer; const Size: Integer; var ALen: Integer): Integer;
+
+function EncodeTLSOpaque16(var Buffer; const Size: Integer; const A: RawByteString): Integer;
+function EncodeTLSOpaque24(var Buffer; const Size: Integer; const A: RawByteString): Integer;
+
+function DecodeTLSOpaque16(const Buffer; const Size: Integer; var A: RawByteString): Integer;
+function DecodeTLSOpaque24(const Buffer; const Size: Integer; var A: RawByteString): Integer;
+
+
+
+implementation
+
+
+uses
+  { TLS }
+
+  flcTLSAlert,
+  flcTLSErrors;
+
+
+
+function EncodeTLSWord16(var Buffer; const Size: Integer; const AVal: Integer): Integer;
+var
+  P : PByte;
+begin
+  Assert(AVal >= 0);
+  Assert(AVal <= $FFFF);
+
+  if Size < 2 then
+    raise ETLSError.CreateAlertBufferEncode;
+  P := @Buffer;
+  P^ := (AVal and $FF00) shr 8;
+  Inc(P);
+  P^ := (AVal and $00FF);
+  Result := 2;
+end;
+
+function DecodeTLSWord16(const Buffer; const Size: Integer; var AVal: Integer): Integer;
+var
+  P : PByte;
+begin
+  if Size < 2 then
+    raise ETLSError.CreateAlertBufferDecode;
+  P := @Buffer;
+  AVal := P^ shl 8;
+  Inc(P);
+  Inc(AVal, P^);
+  Result := 2;
+end;
+
+function EncodeTLSLen16(var Buffer; const Size: Integer; const ALen: Integer): Integer;
+begin
+  Result := EncodeTLSWord16(Buffer, Size, ALen);
+end;
+
+function EncodeTLSLen24(var Buffer; const Size: Integer; const ALen: Integer): Integer;
+var
+  P : PByte;
+begin
+  Assert(ALen >= 0);
+  Assert(ALen <= $FFFFFF);
+
+  if Size < 3 then
+    raise ETLSError.CreateAlertBufferEncode;
+  P := @Buffer;
+  P^ := (ALen and $FF0000) shr 16;
+  Inc(P);
+  P^ := (ALen and $00FF00) shr 8;
+  Inc(P);
+  P^ := (ALen and $0000FF);
+  Result := 3;
+end;
+
+function DecodeTLSLen16(const Buffer; const Size: Integer; var ALen: Integer): Integer;
+begin
+  Result := DecodeTLSWord16(Buffer, Size, ALen);
+end;
+
+function DecodeTLSLen24(const Buffer; const Size: Integer; var ALen: Integer): Integer;
+var
+  P : PByte;
+begin
+  if Size < 3 then
+    raise ETLSError.CreateAlertBufferDecode;
+  P := @Buffer;
+  ALen := P^ shl 16;
+  Inc(P);
+  Inc(ALen, P^ shl 8);
+  Inc(P);
+  Inc(ALen, P^);
+  Result := 3;
+end;
+
+function EncodeTLSOpaque16(var Buffer; const Size: Integer; const A: RawByteString): Integer;
+var
+  P : PByte;
+  N, L : Integer;
+begin
+  N := Size;
+  P := @Buffer;
+  L := Length(A);
+  EncodeTLSLen16(P^, N, L);
+  Inc(P, 2);
+  Dec(N, 2);
+  Dec(N, L);
+  if N < 0 then
+    raise ETLSError.CreateAlertBufferEncode;
+  if L > 0 then
+    Move(Pointer(A)^, P^, L);
+  Result := Size - N;
+end;
+
+function EncodeTLSOpaque24(var Buffer; const Size: Integer; const A: RawByteString): Integer;
+var
+  P : PByte;
+  N, L : Integer;
+begin
+  N := Size;
+  P := @Buffer;
+  L := Length(A);
+  EncodeTLSLen24(P^, N, L);
+  Inc(P, 3);
+  Dec(N, 3);
+  Dec(N, L);
+  if N < 0 then
+    raise ETLSError.CreateAlertBufferEncode;
+  if L > 0 then
+    Move(Pointer(A)^, P^, L);
+  Result := Size - N;
+end;
+
+function DecodeTLSOpaque16(const Buffer; const Size: Integer; var A: RawByteString): Integer;
+var
+  P : PByte;
+  N, L : Integer;
+begin
+  N := Size;
+  P := @Buffer;
+  DecodeTLSLen16(P^, N, L);
+  Inc(P, 2);
+  Dec(N, 2);
+  Dec(N, L);
+  if N < 0 then
+    raise ETLSError.CreateAlertBufferDecode;
+  SetLength(A, L);
+  if L > 0 then
+    Move(P^, Pointer(A)^, L);
+  Result := Size - N;
+end;
+
+function DecodeTLSOpaque24(const Buffer; const Size: Integer; var A: RawByteString): Integer;
+var
+  P : PByte;
+  N, L : Integer;
+begin
+  N := Size;
+  P := @Buffer;
+  DecodeTLSLen24(P^, N, L);
+  Inc(P, 3);
+  Dec(N, 3);
+  Dec(N, L);
+  if N < 0 then
+    raise ETLSError.CreateAlertBufferDecode;
+  SetLength(A, L);
+  if L > 0 then
+    Move(P^, Pointer(A)^, L);
+  Result := Size - N;
+end;
+
+
+
+end.
+

contrib/fundamentals/TLS/flcTLSPRF.pas

@@ -0,0 +1,315 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSPRF.pas                                            }
+{   File version:     5.02                                                     }
+{   Description:      TLS PRF (Pseudo Random Function)                         }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2020/05/09  5.02  Create flcTLSPRF unit from flcTLSUtils unit.             }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSPRF;
+
+interface
+
+uses
+  { Utils }
+
+  flcStdTypes,
+
+  { TLS }
+
+  flcTLSProtocolVersion;
+
+
+
+{                                                                              }
+{ PRFAlgorithm                                                                 }
+
+{                                                                              }
+
+type
+
+  TTLSPRFAlgorithm = (
+
+    tlspaSHA256
+
+    );
+
+
+
+
+{                                                                              }
+
+{ PRF (Pseudo-Random Function)                                                 }
+{                                                                              }
+function  tlsP_MD5(const Secret, Seed: RawByteString; const Size: Integer): RawByteString;
+function  tlsP_SHA1(const Secret, Seed: RawByteString; const Size: Integer): RawByteString;
+function  tlsP_SHA256(const Secret, Seed: RawByteString; const Size: Integer): RawByteString;
+function  tlsP_SHA512(const Secret, Seed: RawByteString; const Size: Integer): RawByteString;
+
+function  tls10PRF(const Secret, ALabel, Seed: RawByteString; const Size: Integer): RawByteString;
+function  tls12PRF_SHA256(const Secret, ALabel, Seed: RawByteString; const Size: Integer): RawByteString;
+function  tls12PRF_SHA512(const Secret, ALabel, Seed: RawByteString; const Size: Integer): RawByteString;
+
+function  TLSPRF(const ProtocolVersion: TTLSProtocolVersion;
+          const Secret, ALabel, Seed: RawByteString; const Size: Integer): RawByteString;
+
+
+
+{                                                                              }
+{ Test                                                                         }
+{                                                                              }
+{$IFDEF TLS_TEST}
+procedure Test;
+{$ENDIF}
+
+
+
+implementation
+
+uses
+  { Utils }
+
+  flcHash,
+
+  { TLS }
+
+  flcTLSErrors;
+
+
+
+{                                                                              }
+{ P_hash                                                                       }
+
+{ P_hash(secret, seed) = HMAC_hash(secret, A(1) + seed) +                      }
+{                        HMAC_hash(secret, A(2) + seed) +                      }
+{                        HMAC_hash(secret, A(3) + seed) + ...                  }
+{ Where + indicates concatenation.                                             }
+{ A() is defined as:                                                           }
+{     A(0) = seed                                                              }
+{     A(i) = HMAC_hash(secret, A(i-1))                                         }
+{                                                                              }
+function tlsP_MD5(const Secret, Seed: RawByteString; const Size: Integer): RawByteString;
+var A, P : RawByteString;
+    L : Integer;
+begin
+  P := '';
+  L := 0;
+  A := Seed;
+  repeat
+    A := MD5DigestToStrA(CalcHMAC_MD5(Secret, A));
+    P := P + MD5DigestToStrA(CalcHMAC_MD5(Secret, A + Seed));
+    Inc(L, 16);
+  until L >= Size;
+  if L > Size then
+    SetLength(P, Size);
+  Result := P;
+end;
+
+function tlsP_SHA1(const Secret, Seed: RawByteString; const Size: Integer): RawByteString;
+var A, P : RawByteString;
+    L : Integer;
+begin
+  P := '';
+  L := 0;
+  A := Seed;
+  repeat
+    A := SHA1DigestToStrA(CalcHMAC_SHA1(Secret, A));
+    P := P + SHA1DigestToStrA(CalcHMAC_SHA1(Secret, A + Seed));
+    Inc(L, 20);
+  until L >= Size;
+  if L > Size then
+    SetLength(P, Size);
+  Result := P;
+end;
+
+function tlsP_SHA256(const Secret, Seed: RawByteString; const Size: Integer): RawByteString;
+var A, P : RawByteString;
+    L : Integer;
+begin
+  P := '';
+  L := 0;
+  A := Seed;
+  repeat
+    A := SHA256DigestToStrA(CalcHMAC_SHA256(Secret, A));
+    P := P + SHA256DigestToStrA(CalcHMAC_SHA256(Secret, A + Seed));
+    Inc(L, 32);
+  until L >= Size;
+  if L > Size then
+    SetLength(P, Size);
+  Result := P;
+end;
+
+function tlsP_SHA512(const Secret, Seed: RawByteString; const Size: Integer): RawByteString;
+var A, P : RawByteString;
+    L : Integer;
+begin
+  P := '';
+  L := 0;
+  A := Seed;
+  repeat
+    A := SHA512DigestToStrA(CalcHMAC_SHA512(Secret, A));
+    P := P + SHA512DigestToStrA(CalcHMAC_SHA512(Secret, A + Seed));
+    Inc(L, 64);
+  until L >= Size;
+  if L > Size then
+    SetLength(P, Size);
+  Result := P;
+end;
+
+
+
+{                                                                              }
+{ PRF                                                                          }
+{ TLS 1.0:                                                                     }
+{ PRF(secret, label, seed) = P_MD5(S1, label + seed) XOR                       }
+{                            P_SHA-1(S2, label + seed);                        }
+{ S1 and S2 are the two halves of the secret and each is the same length.      }
+{ S1 is taken from the first half of the secret, S2 from the second half.      }
+{ Their length is created by rounding up the length of the overall secret      }
+{ divided by two; thus, if the original secret is an odd number of bytes       }
+{ long, the last byte of S1 will be the same as the first byte of S2.          }
+{                                                                              }
+{ TLS 1.2:                                                                     }
+{ PRF(secret, label, seed) = P_<hash>(secret, label + seed)                    }
+{ P_SHA-256                                                                    }
+{                                                                              }
+procedure tls10PRFSplitSecret(const Secret: RawByteString; var S1, S2: RawByteString);
+var L, N : Integer;
+begin
+  N := Length(Secret);
+  L := N;
+  if L mod 2 = 1 then
+    Inc(L);
+  L := L div 2;
+  S1 := Copy(Secret, 1, L);
+  S2 := Copy(Secret, N - L + 1, L);
+end;
+
+function tls10PRF(const Secret, ALabel, Seed: RawByteString; const Size: Integer): RawByteString;
+var S1, S2 : RawByteString;
+    P1, P2 : RawByteString;
+    R      : RawByteString;
+    I      : Integer;
+begin
+  tls10PRFSplitSecret(Secret, S1, S2);
+  P1 := tlsP_MD5(S1, ALabel + Seed, Size);
+  P2 := tlsP_SHA1(S2, ALabel + Seed, Size);
+  SetLength(R, Size);
+  for I := 1 to Size do
+    R[I] := AnsiChar(Byte(P1[I]) xor Byte(P2[I]));
+  Result := R;
+end;
+
+function tls12PRF_SHA256(const Secret, ALabel, Seed: RawByteString; const Size: Integer): RawByteString;
+begin
+  Result := tlsP_SHA256(Secret, ALabel + Seed, Size);
+end;
+
+function tls12PRF_SHA512(const Secret, ALabel, Seed: RawByteString; const Size: Integer): RawByteString;
+begin
+  Result := tlsP_SHA512(Secret, ALabel + Seed, Size);
+end;
+
+function TLSPRF(const ProtocolVersion: TTLSProtocolVersion;
+         const Secret, ALabel, Seed: RawByteString; const Size: Integer): RawByteString;
+begin
+  if IsTLS12OrLater(ProtocolVersion) then
+    Result := tls12PRF_SHA256(Secret, ALabel, Seed, Size) else
+  if IsTLS10OrLater(ProtocolVersion) then
+    Result := tls10PRF(Secret, ALabel, Seed, Size)
+  else
+    raise ETLSError.Create(TLSError_InvalidParameter);
+end;
+
+
+
+{                                                                              }
+{ Test                                                                         }
+{                                                                              }
+{$IFDEF TLS_TEST}
+{$ASSERTIONS ON}
+procedure Test;
+begin
+  //                                                                                   //
+  // Test vectors from http://www6.ietf.org/mail-archive/web/tls/current/msg03416.html //
+  //                                                                                   //
+  Assert(tls12PRF_SHA256(
+      RawByteString(#$9b#$be#$43#$6b#$a9#$40#$f0#$17#$b1#$76#$52#$84#$9a#$71#$db#$35),
+      'test label',
+      RawByteString(#$a0#$ba#$9f#$93#$6c#$da#$31#$18#$27#$a6#$f7#$96#$ff#$d5#$19#$8c), 100) =
+      #$e3#$f2#$29#$ba#$72#$7b#$e1#$7b +
+      #$8d#$12#$26#$20#$55#$7c#$d4#$53 +
+      #$c2#$aa#$b2#$1d#$07#$c3#$d4#$95 +
+      #$32#$9b#$52#$d4#$e6#$1e#$db#$5a +
+      #$6b#$30#$17#$91#$e9#$0d#$35#$c9 +
+      #$c9#$a4#$6b#$4e#$14#$ba#$f9#$af +
+      #$0f#$a0#$22#$f7#$07#$7d#$ef#$17 +
+      #$ab#$fd#$37#$97#$c0#$56#$4b#$ab +
+      #$4f#$bc#$91#$66#$6e#$9d#$ef#$9b +
+      #$97#$fc#$e3#$4f#$79#$67#$89#$ba +
+      #$a4#$80#$82#$d1#$22#$ee#$42#$c5 +
+      #$a7#$2e#$5a#$51#$10#$ff#$f7#$01 +
+      #$87#$34#$7b#$66);
+  Assert(tls12PRF_SHA512(
+      RawByteString(#$b0#$32#$35#$23#$c1#$85#$35#$99#$58#$4d#$88#$56#$8b#$bb#$05#$eb),
+      'test label',
+      RawByteString(#$d4#$64#$0e#$12#$e4#$bc#$db#$fb#$43#$7f#$03#$e6#$ae#$41#$8e#$e5), 196) =
+      #$12#$61#$f5#$88#$c7#$98#$c5#$c2 +
+      #$01#$ff#$03#$6e#$7a#$9c#$b5#$ed +
+      #$cd#$7f#$e3#$f9#$4c#$66#$9a#$12 +
+      #$2a#$46#$38#$d7#$d5#$08#$b2#$83 +
+      #$04#$2d#$f6#$78#$98#$75#$c7#$14 +
+      #$7e#$90#$6d#$86#$8b#$c7#$5c#$45 +
+      #$e2#$0e#$b4#$0c#$1c#$f4#$a1#$71 +
+      #$3b#$27#$37#$1f#$68#$43#$25#$92 +
+      #$f7#$dc#$8e#$a8#$ef#$22#$3e#$12 +
+      #$ea#$85#$07#$84#$13#$11#$bf#$68 +
+      #$65#$3d#$0c#$fc#$40#$56#$d8#$11 +
+      #$f0#$25#$c4#$5d#$df#$a6#$e6#$fe +
+      #$c7#$02#$f0#$54#$b4#$09#$d6#$f2 +
+      #$8d#$d0#$a3#$23#$3e#$49#$8d#$a4 +
+      #$1a#$3e#$75#$c5#$63#$0e#$ed#$be +
+      #$22#$fe#$25#$4e#$33#$a1#$b0#$e9 +
+      #$f6#$b9#$82#$66#$75#$be#$c7#$d0 +
+      #$1a#$84#$56#$58#$dc#$9c#$39#$75 +
+      #$45#$40#$1d#$40#$b9#$f4#$6c#$7a +
+      #$40#$0e#$e1#$b8#$f8#$1c#$a0#$a6 +
+      #$0d#$1a#$39#$7a#$10#$28#$bf#$f5 +
+      #$d2#$ef#$50#$66#$12#$68#$42#$fb +
+      #$8d#$a4#$19#$76#$32#$bd#$b5#$4f +
+      #$f6#$63#$3f#$86#$bb#$c8#$36#$e6 +

contrib/fundamentals/TLS/flcTLSProtocolVersion.pas

@@ -0,0 +1,259 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSProtocolVersion.pas                                }
+{   File version:     5.02                                                     }
+{   Description:      TLS Protocol Version                                     }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2020/05/09  5.02  Create flcTLSProtocolVersion unit from flcTLSUtils unit. }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSProtocolVersion;
+
+interface
+
+
+
+{                                                                              }
+{ ProtocolVersion                                                              }
+{                                                                              }
+type
+  TTLSProtocolVersion = packed record
+    major, minor : Byte;
+  end;
+  PTLSProtocolVersion = ^TTLSProtocolVersion;
+
+const
+  TLSProtocolVersionSize = Sizeof(TTLSProtocolVersion);
+
+  SSLProtocolVersion20 : TTLSProtocolVersion = (major: 0; minor: 2);
+  SSLProtocolVersion30 : TTLSProtocolVersion = (major: 3; minor: 0);
+  TLSProtocolVersion10 : TTLSProtocolVersion = (major: 3; minor: 1);
+  TLSProtocolVersion11 : TTLSProtocolVersion = (major: 3; minor: 2);
+  TLSProtocolVersion12 : TTLSProtocolVersion = (major: 3; minor: 3);
+  TLSProtocolVersion13 : TTLSProtocolVersion = (major: 3; minor: 4);
+
+procedure InitSSLProtocolVersion30(var A: TTLSProtocolVersion);
+procedure InitTLSProtocolVersion10(var A: TTLSProtocolVersion);
+procedure InitTLSProtocolVersion11(var A: TTLSProtocolVersion);
+procedure InitTLSProtocolVersion12(var A: TTLSProtocolVersion);
+function  IsTLSProtocolVersion(const A, B: TTLSProtocolVersion): Boolean;
+function  IsSSL2(const A: TTLSProtocolVersion): Boolean;
+function  IsSSL3(const A: TTLSProtocolVersion): Boolean;
+function  IsTLS10(const A: TTLSProtocolVersion): Boolean;
+function  IsTLS11(const A: TTLSProtocolVersion): Boolean;
+function  IsTLS12(const A: TTLSProtocolVersion): Boolean;
+function  IsTLS13(const A: TTLSProtocolVersion): Boolean;
+function  IsTLS10OrLater(const A: TTLSProtocolVersion): Boolean;
+function  IsTLS11OrLater(const A: TTLSProtocolVersion): Boolean;
+function  IsTLS12OrLater(const A: TTLSProtocolVersion): Boolean;
+function  IsPostTLS12(const A: TTLSProtocolVersion): Boolean;
+function  IsKnownTLSVersion(const A: TTLSProtocolVersion): Boolean;   ////
+function  TLSProtocolVersionToStr(const A: TTLSProtocolVersion): String;
+function  TLSProtocolVersionName(const A: TTLSProtocolVersion): String;
+
+
+
+{                                                                              }
+{ Tests                                                                        }
+{                                                                              }
+{$IFDEF TLS_TEST}
+procedure Test;
+{$ENDIF}
+
+
+
+
+implementation
+
+uses
+  { System }
+
+  SysUtils;
+
+
+
+{                                                                              }
+{ ProtocolVersion                                                              }
+{                                                                              }
+procedure InitSSLProtocolVersion30(var A: TTLSProtocolVersion);
+begin
+  A := SSLProtocolVersion30;
+end;
+
+procedure InitTLSProtocolVersion10(var A: TTLSProtocolVersion);
+begin
+  A := TLSProtocolVersion10;
+end;
+
+procedure InitTLSProtocolVersion11(var A: TTLSProtocolVersion);
+begin
+  A := TLSProtocolVersion11;
+end;
+
+procedure InitTLSProtocolVersion12(var A: TTLSProtocolVersion);
+begin
+  A := TLSProtocolVersion12;
+end;
+
+function IsTLSProtocolVersion(const A, B: TTLSProtocolVersion): Boolean;
+begin
+  Result :=
+      (A.major = B.major) and
+      (A.minor = B.minor);
+end;
+
+function IsSSL2(const A: TTLSProtocolVersion): Boolean;
+begin
+  Result := IsTLSProtocolVersion(A, SSLProtocolVersion20);
+end;
+
+function IsSSL3(const A: TTLSProtocolVersion): Boolean;
+begin
+  Result := IsTLSProtocolVersion(A, SSLProtocolVersion30);
+end;
+
+function IsTLS10(const A: TTLSProtocolVersion): Boolean;
+begin
+  Result := IsTLSProtocolVersion(A, TLSProtocolVersion10);
+end;
+
+function IsTLS11(const A: TTLSProtocolVersion): Boolean;
+begin
+  Result := IsTLSProtocolVersion(A, TLSProtocolVersion11);
+end;
+
+function IsTLS12(const A: TTLSProtocolVersion): Boolean;
+begin
+  Result := IsTLSProtocolVersion(A, TLSProtocolVersion12);
+end;
+
+function IsTLS13(const A: TTLSProtocolVersion): Boolean;
+begin
+  Result := IsTLSProtocolVersion(A, TLSProtocolVersion13);
+end;
+
+function IsTLS10OrLater(const A: TTLSProtocolVersion): Boolean;
+begin
+  Result :=
+      ((A.major =  TLSProtocolVersion10.major) and
+       (A.minor >= TLSProtocolVersion10.minor))
+      or
+       (A.major >  TLSProtocolVersion10.major);
+end;
+
+function IsTLS11OrLater(const A: TTLSProtocolVersion): Boolean;
+begin
+  Result :=
+      ((A.major =  TLSProtocolVersion11.major) and
+       (A.minor >= TLSProtocolVersion11.minor))
+      or
+       (A.major >  TLSProtocolVersion11.major);
+end;
+
+function IsTLS12OrLater(const A: TTLSProtocolVersion): Boolean;
+begin
+  Result :=
+      ((A.major =  TLSProtocolVersion12.major) and
+       (A.minor >= TLSProtocolVersion12.minor))
+      or
+       (A.major >  TLSProtocolVersion12.major);
+end;
+
+function IsPostTLS12(const A: TTLSProtocolVersion): Boolean;
+begin
+  Result :=
+      ((A.major = TLSProtocolVersion12.major) and
+       (A.minor > TLSProtocolVersion12.minor))
+      or
+       (A.major > TLSProtocolVersion12.major);
+end;
+
+function IsKnownTLSVersion(const A: TTLSProtocolVersion): Boolean;
+begin
+  Result := IsTLS12(A) or IsTLS11(A) or IsTLS10(A) or IsSSL3(A);
+end;
+
+function TLSProtocolVersionToStr(const A: TTLSProtocolVersion): String;
+begin
+  Result := IntToStr(A.major) + '.' + IntToStr(A.minor);
+end;
+
+function TLSProtocolVersionName(const A: TTLSProtocolVersion): String;
+begin
+  if IsSSL2(A) then
+    Result := 'SSL2' else
+  if IsSSL3(A) then
+    Result := 'SSL3' else
+  if IsTLS10(A) then
+    Result := 'TLS1.0' else
+  if IsTLS11(A) then
+    Result := 'TLS1.1' else
+  if IsTLS12(A) then
+    Result := 'TLS1.2'
+  else
+  if IsTLS13(A) then
+    Result := 'TLS1.3'
+  else
+    Result := '[TLS' + TLSProtocolVersionToStr(A) + ']';
+end;
+
+
+
+{                                                                              }
+{ Tests                                                                        }
+{                                                                              }
+{$IFDEF TLS_TEST}
+{$ASSERTIONS ON}
+procedure Test;
+begin
+
+  Assert(TLSProtocolVersionSize = 2);
+
+
+  Assert(IsTLS12OrLater(TLSProtocolVersion12));
+
+  Assert(not IsTLS12OrLater(TLSProtocolVersion10));
+
+
+  Assert(TLSProtocolVersionToStr(TLSProtocolVersion12) = '3.3');
+
+
+  Assert(TLSProtocolVersionName(SSLProtocolVersion20) = 'SSL2');
+
+  Assert(TLSProtocolVersionName(SSLProtocolVersion30) = 'SSL3');
+
+  Assert(TLSProtocolVersionName(TLSProtocolVersion10) = 'TLS1.0');

contrib/fundamentals/TLS/flcTLSRandom.pas

@@ -0,0 +1,132 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSRandom.pas                                         }
+{   File version:     5.02                                                     }
+{   Description:      TLS Random                                               }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2020/05/09  5.02  Create flcTLSRandom unit from flcTLSUtils unit.          }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSRandom;
+
+interface
+
+uses
+  { Utils }
+
+  flcStdTypes;
+
+
+
+{                                                                              }
+{ Random                                                                       }
+{                                                                              }
+type
+  TTLSRandom = packed record
+    gmt_unix_time : Word32;
+    random_bytes  : array[0..27] of Byte;
+  end;
+  PTLSRandom = ^TTLSRandom;
+
+const
+  TLSRandomSize = Sizeof(TTLSRandom);
+
+procedure InitTLSRandom(var Random: TTLSRandom);
+function  TLSRandomToStr(const Random: TTLSRandom): RawByteString;
+
+
+
+{                                                                              }
+{ Test                                                                         }
+{                                                                              }
+{$IFDEF TLS_TEST}
+procedure Test;
+{$ENDIF}
+
+
+
+implementation
+
+uses
+  { System }
+
+  SysUtils,
+
+  { Cipher }
+
+  flcCipherRandom;
+
+
+
+{                                                                              }
+{ Random                                                                       }
+{   gmt_unix_time     The current time and date in standard UNIX               }
+{                     32-bit format according to the sender's                  }
+{                     internal clock.  Clocks are not required to be           }
+{                     set correctly by the basic SSL Protocol; higher          }
+{                     level or application protocols may define                }
+{                     additional requirements.                                 }
+{   random_bytes      28 bytes generated by a secure random number             }
+{                     generator.                                               }
+{                                                                              }
+procedure InitTLSRandom(var Random: TTLSRandom);
+begin
+  Random.gmt_unix_time := Word32(DateTimeToFileDate(Now));
+  SecureRandomBuf(Random.random_bytes, SizeOf(Random.random_bytes));
+end;
+
+
+function TLSRandomToStr(const Random: TTLSRandom): RawByteString;
+
+begin
+
+  SetLength(Result, TLSRandomSize);
+
+  Move(Random, Result[1], TLSRandomSize);
+
+end;
+
+
+
+
+{                                                                              }
+{ Test                                                                         }
+{                                                                              }
+{$IFDEF TLS_TEST}
+{$ASSERTIONS ON}
+procedure Test;
+begin

contrib/fundamentals/TLS/flcTLSRecord.pas

@@ -0,0 +1,968 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSRecord.pas                                         }
+{   File version:     5.08                                                     }
+{   Description:      TLS records                                              }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2010/11/30  0.02  Stream cipher.                                           }
+{   2010/12/01  0.03  Block cipher for TLS 1.0.                                }
+{   2010/12/02  0.04  Block cipher for TLS 1.1 and TLS 1.2.                    }
+{   2010/12/17  0.05  Fixes for TLS 1.1 and TLS 1.2 block ciphers.             }
+{   2011/10/11  0.06  Fixes for TLS 1.1 block cipher encoding.                 }
+{   2011/10/12  0.07  MAC validation on decoding.                              }
+{   2018/07/17  5.08  Revised for Fundamentals 5.                              }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSRecord;
+
+interface
+
+uses
+  { TLS }
+
+  flcTLSProtocolVersion,
+  flcTLSAlgorithmTypes,
+  flcTLSCipherSuite,
+  flcTLSCipher;
+
+
+
+{                                                                              }
+{ ContentType                                                                  }
+{                                                                              }
+type
+  TTLSContentType = (
+    tlsctInvalid            = 0,
+    tlsctChange_cipher_spec = 20,
+    tlsctAlert              = 21,
+    tlsctHandshake          = 22,
+    tlsctApplication_data   = 23,
+    tlsctHeartbeat          = 24,   // RFC 6520
+    tlsctMax                = 255
+  );
+  PTLSContentType = ^TTLSContentType;
+
+const
+  TLSContentTypeSize = Sizeof(TTLSContentType);
+
+function TLSContentTypeToStr(const A: TTLSContentType): String;
+function IsKnownTLSContentType(const A: TTLSContentType): Boolean;
+
+
+
+{                                                                              }
+{ TLS Record Header                                                            }
+{                                                                              }
+type
+  TTLSRecordHeader = packed record
+    _type   : TTLSContentType;
+    version : TTLSProtocolVersion;
+    length  : Word;
+  end;
+  PTLSRecordHeader = ^TTLSRecordHeader;
+
+const
+  TLSRecordHeaderSize = Sizeof(TTLSRecordHeader);
+
+procedure InitTLSRecordHeader(var RecordHeader: TTLSRecordHeader;
+          const ContentType: TTLSContentType;
+          const Version: TTLSProtocolVersion;
+          const Length: Word);
+procedure DecodeTLSRecordHeader(const RecordHeader: TTLSRecordHeader;
+          var ContentType: TTLSContentType;
+          var Version: TTLSProtocolVersion;
+          var Length: Word);
+
+
+
+{                                                                              }
+{ Record payload MAC                                                           }
+{                                                                              }
+function  PrepareTLSRecordPayloadMACBuffer(
+          var Buffer; const Size: Integer;
+          const ProtocolVersion: TTLSProtocolVersion;
+          const MACSize: Integer;
+          const SequenceNumber: Int64;
+          const TLSCompressedHdr;
+          const TLSCompressedBuf; const TLSCompressedBufSize: Integer): Integer;
+
+function  GenerateTLSRecordPayloadMAC(
+          const MACAlgorithm: TTLSMACAlgorithm;
+          const Key; const KeySize: Integer;
+          const Buf; const BufSize: Integer;
+          var Digest; const DigestSize: Integer): Integer;
+
+function  GenerateRecordPayloadMAC(
+          const ProtocolVersion: TTLSProtocolVersion;
+          const CipherSuiteDetails: TTLSCipherSuiteDetails;
+          const Key; const KeySize: Integer;
+          const SequenceNumber: Int64;
+          const TLSCompressedHdr: PTLSRecordHeader;
+          const TLSCompressedBuf; const TLSCompressedBufSize: Integer;
+          var Digest; const DigestSize: Integer): Integer;
+
+          
+
+{                                                                              }
+{ Record                                                                       }
+{                                                                              }
+function  EncodeTLSRecord(
+          var Buffer; const Size: Integer;
+          const ProtocolVersion: TTLSProtocolVersion;
+          const ContentType: TTLSContentType;
+          const ContentBuffer; const ContentSize: Integer;
+          const CompressionMethod: TTLSCompressionMethod;
+          const CipherSuiteDetails: TTLSCipherSuiteDetails;
+          const SequenceNumber: Int64;
+          const MACKey; const MACKeySize: Integer;
+          var CipherState: TTLSCipherState;
+          const IVBufPtr: Pointer; const IVBufSize: Integer): Integer;
+
+procedure DecodeTLSRecord(
+          const RecHeader: PTLSRecordHeader;
+          const Buffer; const Size: Integer;
+          const ProtocolVersion: TTLSProtocolVersion;
+          const CompressionMethod: TTLSCompressionMethod;
+          const CipherSuiteDetails: TTLSCipherSuiteDetails;
+          const SequenceNumber: Int64;
+          const MACKey; const MACKeySize: Integer;
+          var CipherState: TTLSCipherState;
+          const IVBufPtr: Pointer; const IVBufSize: Integer;
+          var ContentBuffer; const ContentBufferSize: Integer;
+          out ContentSize: Integer);
+
+
+
+{                                                                              }
+{ Test cases                                                                   }
+{                                                                              }
+{$IFDEF TLS_TEST}
+procedure Test;
+{$ENDIF}
+
+
+
+implementation
+
+uses
+  { System }
+
+  SysUtils,
+
+  { Utils }
+
+  flcStdTypes,
+  flcHash,
+
+  { Cipher }
+
+  flcCipherRandom,
+
+  { TLS }
+
+  flcTLSConsts,
+  flcTLSErrors,
+  flcTLSCompress;
+
+
+
+{                                                                              }
+{ ContentType                                                                  }
+{                                                                              }
+function TLSContentTypeToStr(const A: TTLSContentType): String;
+begin
+  case A of
+    tlsctInvalid            : Result := 'Invalid';
+    tlsctChange_cipher_spec : Result := 'Change_cipher_spec';
+    tlsctAlert              : Result := 'Alert';
+    tlsctHandshake          : Result := 'Handshake';
+    tlsctApplication_data   : Result := 'Application_data';
+    tlsctHeartbeat          : Result := 'Heartbeat';
+  else
+    Result := '[TLSContentType#' + IntToStr(Ord(A)) + ']';
+  end;
+end;
+
+function IsKnownTLSContentType(const A: TTLSContentType): Boolean;
+begin
+  Result := A in [
+      tlsctChange_cipher_spec,
+      tlsctAlert,
+      tlsctHandshake,
+      tlsctApplication_data,
+      tlsctHeartbeat];
+end;
+
+
+
+{                                                                              }
+{ TLS Record Header                                                            }
+{                                                                              }
+{ SSL3 / TLS 1.0 / TLS 1.1 / TLS 1.2:                                          }
+{   ContentType     type                                                       }
+{   ProtocolVersion version                                                    }
+{   uint16          length                                                     }
+{                                                                              }
+procedure InitTLSRecordHeader(var RecordHeader: TTLSRecordHeader;
+          const ContentType: TTLSContentType;
+          const Version: TTLSProtocolVersion;
+          const Length: Word);
+begin
+  RecordHeader._type   := ContentType;
+  RecordHeader.version := Version;
+  RecordHeader.length  :=
+      ((Length and $FF) shl 8) or
+       (Length shr 8);
+end;
+
+procedure DecodeTLSRecordHeader(const RecordHeader: TTLSRecordHeader;
+          var ContentType: TTLSContentType;
+          var Version: TTLSProtocolVersion;
+          var Length: Word);
+begin
+  ContentType := RecordHeader._type;
+  Version     := RecordHeader.version ;
+  Length      :=
+      ((RecordHeader.length and $FF) shl 8) or
+       (RecordHeader.length shr 8);
+end;
+
+
+
+{                                                                              }
+{ Record payload MAC                                                           }
+{                                                                              }
+{ SSL 3:                                                                       }
+{   hash(MAC_write_secret + pad_2 +                                            }
+{        hash(MAC_write_secret + pad_1 +                                       }
+{             seq_num +                                                        }
+{             SSLCompressed.type +                                             }
+{             SSLCompressed.length +                                           }
+{             SSLCompressed.fragment));                                        }
+{   pad_1 = The character 0x36 repeated 48 times for MD5 or 40 times for SHA.  }
+{   pad_2 = The character 0x5c repeated 48 times for MD5 or 40 times for SHA.  }
+{                                                                              }
+{ TLS 1.0 / TLS 1.1 / TLS 1.2:                                                 }
+{   HMAC_hash(MAC_write_key, seq_num +                                         }
+{                      TLSCompressed.type +                                    }
+{                      TLSCompressed.version +                                 }
+{                      TLSCompressed.length +                                  }
+{                      TLSCompressed.fragment);                                }
+{                                                                              }
+procedure EncodeSequenceNumber(
+          const SequenceNumber: Int64;
+          const Buf; const BufSize: Integer);
+var P : PByte;
+    B : array[0..7] of Byte;
+    I : Integer;
+begin
+  if BufSize < 8 then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+  P := @Buf;
+  Move(SequenceNumber, B, 8);
+  for I := 0 to 7 do
+    begin
+      P^ := B[7 - I];
+      Inc(P);
+    end;
+end;
+
+function CalculateSSLHash(
+         const Hash: TTLSCipherSuiteHash;
+         const Buf; const BufSize: Integer;
+         var Digest; const DigestSize: Integer): Integer;
+var L : Integer;
+begin
+  L := TLSCipherSuiteHashInfo[Hash].HashSize div 8;
+  if DigestSize < L then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+  case Hash of
+    tlscshMD5 : P128BitDigest(@Digest)^ := CalcMD5(Buf, BufSize);
+    tlscshSHA : P160BitDigest(@Digest)^ := CalcSHA1(Buf, BufSize);
+  else
+    raise ETLSError.Create(TLSError_InvalidParameter);
+  end;
+  Result := L;
+end;
+
+const
+  SSL_MACBufSize = (TLS_PLAINTEXT_FRAGMENT_MAXSIZE + 1024) * 2;
+
+function GenerateSSLRecordPayloadMAC(
+         const Hash: TTLSCipherSuiteHash;
+         const Key; const KeySize: Integer;
+         const SequenceNumber: Int64;
+         const TLSCompressedHdr: PTLSRecordHeader;
+         const TLSCompressedBuf; const TLSCompressedBufSize: Integer;
+         var Digest; const DigestSize: Integer): Integer;
+var PadN : Integer;
+    Buf1 : array[0..SSL_MACBufSize - 1] of Byte;
+    Len1 : Integer;
+    Buf2 : array[0..SSL_MACBufSize - 1] of Byte;
+    Len2 : Integer;
+    Hash1 : array[0..TLS_MAC_MAXDIGESTSIZE - 1] of Byte;
+    Hash1Len : Integer;
+    Hash2 : array[0..TLS_MAC_MAXDIGESTSIZE - 1] of Byte;
+    Hash2Len : Integer;
+    P : PByte;
+begin
+  case Hash of
+    tlscshMD5 : PadN := 48;
+    tlscshSHA : PadN := 40;
+  else
+    raise ETLSError.Create(TLSError_InvalidParameter);
+  end;
+  // hash(MAC_write_secret + pad_1 + seq_num + SSLCompressed.type + SSLCompressed.length + SSLCompressed.fragment)
+  P := @Buf1;
+  Len1 := 0;
+  Move(Key, P^, KeySize);
+  Inc(P, KeySize);
+  Inc(Len1, KeySize);
+  FillChar(P^, PadN, #$36);
+  Inc(P, PadN);
+  Inc(Len1, PadN);
+  EncodeSequenceNumber(SequenceNumber, P^, SSL_MACBufSize - Len1);
+  Inc(P, 8);
+  Inc(Len1, 8);
+  Move(TLSCompressedHdr^._type, P^, 1);
+  Inc(P);
+  Inc(Len1);
+  Move(TLSCompressedHdr^.length, P^, 2);
+  Inc(P, 2);
+  Inc(Len1, 2);
+  Move(TLSCompressedBuf, P^, TLSCompressedBufSize);
+  Inc(Len1, TLSCompressedBufSize);
+  Hash1Len := CalculateSSLHash(Hash, Buf1, Len1, Hash1, SizeOf(Hash1));
+  // hash(MAC_write_secret + pad_2 + hash1)
+  P := @Buf2;
+  Len2 := 0;
+  Move(Key, P^, KeySize);
+  Inc(P, KeySize);
+  Inc(Len2, KeySize);
+  FillChar(P^, PadN, #$5C);
+  Inc(P, PadN);
+  Inc(Len2, PadN);
+  Move(Hash1, P^, Hash1Len);
+  Inc(Len2, Hash1Len);
+  Hash2Len := CalculateSSLHash(Hash, Buf2, Len2, Hash2, SizeOf(Hash2));
+  // result
+  if DigestSize < Hash2Len then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+  Move(Hash2, Digest, Hash2Len);
+  Result := Hash2Len;
+end;
+
+function PrepareTLSRecordPayloadMACBuffer(
+         var Buffer; const Size: Integer;
+         const ProtocolVersion: TTLSProtocolVersion;
+         const MACSize: Integer;
+         const SequenceNumber: Int64;
+         const TLSCompressedHdr;
+         const TLSCompressedBuf; const TLSCompressedBufSize: Integer): Integer;
+var P : PByte;
+    N : Integer;
+begin
+  if not IsTLS10OrLater(ProtocolVersion) then
+    raise ETLSError.Create(TLSError_InvalidParameter);
+  N := Size;
+  Dec(N, 8);
+  Dec(N, TLSRecordHeaderSize);
+  Dec(N, TLSCompressedBufSize);
+  if N < 0 then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+  P := @Buffer;
+  EncodeSequenceNumber(SequenceNumber, P^, Size);
+  Inc(P, 8);
+  Move(TLSCompressedHdr, P^, TLSRecordHeaderSize);
+  Inc(P, TLSRecordHeaderSize);
+  Move(TLSCompressedBuf, P^, TLSCompressedBufSize);
+  Result := Size - N;
+end;
+
+function GenerateTLSRecordPayloadMAC(
+         const MACAlgorithm: TTLSMACAlgorithm;
+         const Key; const KeySize: Integer;
+         const Buf; const BufSize: Integer;
+         var Digest; const DigestSize: Integer): Integer;
+var L : Integer;
+begin
+  L := TLSMACAlgorithmInfo[MACAlgorithm].DigestSize;
+  if DigestSize < L then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+  case MACAlgorithm of
+    tlsmaHMAC_MD5    : P128BitDigest(@Digest)^ := CalcHMAC_MD5(@Key, KeySize, Buf, BufSize);
+    tlsmaHMAC_SHA1   : P160BitDigest(@Digest)^ := CalcHMAC_SHA1(@Key, KeySize, Buf, BufSize);
+    tlsmaHMAC_SHA256 : P256BitDigest(@Digest)^ := CalcHMAC_SHA256(@Key, KeySize, Buf, BufSize);
+    tlsmaHMAC_SHA512 : P512BitDigest(@Digest)^ := CalcHMAC_SHA512(@Key, KeySize, Buf, BufSize);
+  else
+    raise ETLSError.Create(TLSError_InvalidParameter, 'Invalid MAC algorithm[' + IntToStr(Ord(MACAlgorithm)) + ']');
+  end;
+  Result := L;
+end;
+
+const
+  // size of temporary buffers used in record encoding and decoding
+  // this should be large enough to hold any plain, compressed or encrypted record
+  TLS_RecordBufSize = (TLS_PLAINTEXT_FRAGMENT_MAXSIZE + 1024) * 2;
+
+function GenerateRecordPayloadMAC(
+         const ProtocolVersion: TTLSProtocolVersion;
+         const CipherSuiteDetails: TTLSCipherSuiteDetails;
+         const Key; const KeySize: Integer;
+         const SequenceNumber: Int64;
+         const TLSCompressedHdr: PTLSRecordHeader;
+         const TLSCompressedBuf; const TLSCompressedBufSize: Integer;
+         var Digest; const DigestSize: Integer): Integer;
+var MACSize    : Integer;
+    MACAlgo    : TTLSMACAlgorithm;
+    BufMAC     : array[0..TLS_RecordBufSize - 1] of Byte;
+    BufMACSize : Integer;
+begin
+  if IsSSL3(ProtocolVersion) then
+    begin
+      Result := GenerateSSLRecordPayloadMAC(
+          CipherSuiteDetails.CipherSuiteInfo^.Hash,
+          Key, KeySize,
+          SequenceNumber,
+          TLSCompressedHdr,
+          TLSCompressedBuf, TLSCompressedBufSize,
+          Digest, DigestSize);
+    end
+  else
+  if IsTLS10OrLater(ProtocolVersion) then
+    begin
+      MACSize := CipherSuiteDetails.HashInfo^.HashSize div 8;
+      MACAlgo := TLSCipherSuiteHashInfo[CipherSuiteDetails.CipherSuiteInfo^.Hash].MACAlgorithm;
+      BufMACSize := PrepareTLSRecordPayloadMACBuffer(
+          BufMAC, SizeOf(BufMAC),
+          ProtocolVersion,
+          MACSize,
+          SequenceNumber,
+          TLSCompressedHdr^,
+          TLSCompressedBuf, TLSCompressedBufSize);
+      Result := GenerateTLSRecordPayloadMAC(
+          MACAlgo,
+          Key, KeySize,
+          BufMAC, BufMACSize,
+          Digest, DigestSize);
+      SecureClear(BufMAC, BufMACSize);
+    end
+  else
+    raise ETLSError.Create(TLSError_InvalidParameter);
+end;
+
+
+
+{                                                                              }
+{ Record                                                                       }
+{                                                                              }
+{ SSL 3:                                                                       }
+{ GenericStreamCipher                                                          }
+{      stream-ciphered struct                                                  }
+{          opaque content[SSLCompressed.length];                               }
+{          opaque MAC[CipherSpec.hash_size];                                   }
+{                                                                              }
+{ TLS 1.0 / 1.1 / 1.2:                                                         }
+{ GenericStreamCipher                                                          }
+{      stream-ciphered struct                                                  }
+{          opaque content[TLSCompressed.length];                               }
+{          opaque MAC[SecurityParameters.mac_length];                          }
+{                                                                              }
+{ SSL 3:                                                                       }
+{ GenericBlockCipher                                                           }
+{      block-ciphered struct                                                   }
+{          opaque content[SSLCompressed.length];                               }
+{          opaque MAC[CipherSpec.hash_size];                                   }
+{          uint8 padding[GenericBlockCipher.padding_length];                   }
+{          uint8 padding_length;                                               }
+{                                                                              }
+{ TLS 1.0:                                                                     }
+{ GenericBlockCipher                                                           }
+{      block-ciphered struct                                                   }
+{          opaque content[TLSCompressed.length];                               }
+{          opaque MAC[CipherSpec.hash_size];                                   }
+{          uint8 padding[GenericBlockCipher.padding_length];                   }
+{          uint8 padding_length;                                               }
+{                                                                              }
+{ TLS 1.1:                                                                     }
+{ GenericBlockCipher                                                           }
+{      block-ciphered struct                                                   }
+{          opaque IV[CipherSpec.block_length];                                 }
+{          opaque content[TLSCompressed.length];                               }
+{          opaque MAC[CipherSpec.hash_size];                                   }
+{          uint8 padding[GenericBlockCipher.padding_length];                   }
+{          uint8 padding_length;                                               }
+{                                                                              }
+{ TLS 1.2:                                                                     }
+{ GenericBlockCipher                                                           }
+{      opaque IV[SecurityParameters.record_iv_length];                         }
+{      block-ciphered struct                                                   }
+{          opaque content[TLSCompressed.length];                               }
+{          opaque MAC[SecurityParameters.mac_length];                          }
+{          uint8 padding[GenericBlockCipher.padding_length];                   }
+{          uint8 padding_length;                                               }
+{                                                                              }
+
+// Returns number of padding bytes encoded
+function EncodeTLSGenericBlockCipherPadding(
+         var Buffer; const BufferSize: Integer;
+         const GenericBlockSize: Integer;
+         const CipherBlockSize: Integer): Integer;
+var L, I, N : Integer;
+    P : PByte;
+begin
+  if (CipherBlockSize <= 0) or (CipherBlockSize > 256) then
+    raise ETLSError.Create(TLSError_InvalidParameter);
+
+  L := (GenericBlockSize + 1) mod CipherBlockSize;
+  if L > 0 then
+    L := CipherBlockSize - L;
+  Assert(L <= $FF);
+  Assert((GenericBlockSize + L + 1) mod CipherBlockSize = 0);
+  
+  N := L + 1;
+  if BufferSize < N then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+  P := @Buffer;
+  for I := 1 to L do
+    begin
+      P^ := L;
+      Inc(P);
+    end;
+  P^ := L;
+  Result := N;
+end;
+
+// Returns number of padding bytes at end of padded buffer
+// Validates padding bytes
+function DecodeTLSGenericBlockCipherPadding(const Buffer; const Size: Integer): Integer;
+var P : PByte;
+    C : Byte;
+    L, I : Integer;
+begin
+  P := @Buffer;
+  Inc(P, Size - 1);
+  C := P^;
+  L := C + 1;
+  if Size < L then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+  for I := 0 to C - 1 do
+    begin
+      Dec(P);
+      if P^ <> C then
+        raise ETLSError.Create(TLSError_DecodeError);
+    end;
+  Result := C + 1;
+end;
+
+// TLS 1.0: get IV from last cipher block
+procedure tls10UpdateIV(
+          const Buffer; const Size: Integer;
+          var IVBuffer; const IVBufferSize: Integer);
+var P : PByte;
+begin
+  if (IVBufferSize <= 0) or (Size < IVBufferSize) then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+  P := @Buffer;
+  Inc(P, Size - IVBufferSize);
+  Move(P^, IVBuffer, IVBufferSize);
+end;
+
+// TLS 1.1 1.2: generate random IV
+procedure tls11UpdateIV(var IVBuffer; const IVBufferSize: Integer);
+begin
+  if IVBufferSize <= 0 then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+  SecureRandomBuf(IVBuffer, IVBufferSize);
+end;
+
+// Encode a TLS record and update IV
+// Returns size of encoded TLS record (including header)
+function EncodeTLSRecord(
+         var Buffer; const Size: Integer;
+         const ProtocolVersion: TTLSProtocolVersion;
+         const ContentType: TTLSContentType;
+         const ContentBuffer; const ContentSize: Integer;
+         const CompressionMethod: TTLSCompressionMethod;
+         const CipherSuiteDetails: TTLSCipherSuiteDetails;
+         const SequenceNumber: Int64;
+         const MACKey; const MACKeySize: Integer;
+         var CipherState: TTLSCipherState;
+         const IVBufPtr: Pointer; const IVBufSize: Integer): Integer;
+var BufP          : PByte;
+    BufLeft       : Integer;
+    HasCipher     : Boolean;
+    IsBlockCipher : Boolean;
+    UseIV         : Boolean;
+    IVSize        : Integer;
+    RecHeader     : PTLSRecordHeader;
+    RecContent    : Pointer;
+    RecMAC        : Pointer;
+    RecCipher     : Pointer;
+    ComprSize     : Integer;
+    MACSize       : Integer;
+    CipherSize    : Integer;
+    BlockSize     : Integer;
+    BufCipher     : array[0..TLS_RecordBufSize - 1] of Byte;
+    CipheredSize  : Integer;
+    FinalSize     : Integer;
+begin
+  if ContentSize > TLS_PLAINTEXT_FRAGMENT_MAXSIZE then
+    raise ETLSError.Create(TLSError_InvalidParameter);
+
+  // initialise parameters
+  HasCipher := CipherSuiteDetails.CipherSuite <> tlscsNone;
+  IsBlockCipher :=
+      HasCipher and
+      (CipherSuiteDetails.CipherInfo^.CipherType = tlscsctBlock);
+  UseIV :=
+      IsBlockCipher and
+      (CipherSuiteDetails.CipherInfo^.IVSize > 0);
+  if UseIV then
+    IVSize := CipherSuiteDetails.CipherInfo^.IVSize
+  else
+    IVSize := 0;
+  if UseIV and (IVBufSize < IVSize) then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+
+  // encode to Buffer
+  BufP := @Buffer;
+  BufLeft := Size;
+
+  // header
+  Dec(BufLeft, TLSRecordHeaderSize);
+  if BufLeft < 0 then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+  RecHeader := Pointer(BufP);
+  Inc(BufP, TLSRecordHeaderSize);
+
+  // TLS 1.1/1.2: generate random IV
+  if UseIV then
+    if IsTLS11OrLater(ProtocolVersion) then
+      tls11UpdateIV(IVBufPtr^, IVBufSize);
+
+  // TLS 1.1/1.2: encode IV field
+  if UseIV then
+    if IsTLS11OrLater(ProtocolVersion) then
+      begin
+        Dec(BufLeft, IVSize);
+        if BufLeft < 0 then
+          raise ETLSError.Create(TLSError_InvalidBuffer);
+        Move(IVBufPtr^, BufP^, IVSize);
+        Inc(BufP, IVSize);
+      end;
+
+  // compress content
+  RecContent := BufP;
+  TLSCompressFragment(CompressionMethod,
+      ContentBuffer, ContentSize,
+      BufP^, BufLeft,
+      ComprSize);
+  Inc(BufP, ComprSize);
+  Dec(BufLeft, ComprSize);
+
+  // update header with compressed details
+  InitTLSRecordHeader(RecHeader^, ContentType, ProtocolVersion, ComprSize);
+
+  if HasCipher then
+    begin
+      // calculate MAC
+      RecMAC := BufP;
+      MACSize := CipherSuiteDetails.HashInfo^.HashSize div 8;
+      GenerateRecordPayloadMAC(
+          ProtocolVersion,
+          CipherSuiteDetails,
+          MACKey, MACKeySize,
+          SequenceNumber,
+          RecHeader,
+          RecContent^, ComprSize,
+          RecMAC^, BufLeft);
+      Inc(BufP, MACSize);
+      Dec(BufLeft, MACSize);
+
+      // cipher size
+      CipherSize := ComprSize + MACSize;
+
+      // block cipher padding
+      if IsBlockCipher then
+        begin
+          BlockSize := CipherSuiteDetails.CipherInfo^.BlockSize;
+          Inc(CipherSize,
+              EncodeTLSGenericBlockCipherPadding(BufP^, BufLeft, CipherSize, BlockSize));
+        end;
+
+      // Encrypts content (excluding IV)
+      RecCipher := RecContent;
+      TLSCipherBuf(CipherState,
+          RecCipher^, CipherSize,
+          BufCipher, SizeOf(BufCipher),
+          CipheredSize,
+          IVBufPtr, IVSize);
+      Move(BufCipher, RecCipher^, CipheredSize);
+
+      // update IV
+      if UseIV then
+        if IsTLS10(ProtocolVersion) or IsSSL3(ProtocolVersion) then
+          tls10UpdateIV(RecContent^, CipheredSize, IVBufPtr^, IVBufSize);
+
+      // final size
+      FinalSize := CipheredSize;
+      if UseIV then
+        if IsTLS11OrLater(ProtocolVersion) then
+          Inc(FinalSize, IVSize);
+
+      // update header with final encrypted details
+      InitTLSRecordHeader(RecHeader^, ContentType, ProtocolVersion, FinalSize);
+    end
+  else
+    FinalSize := ComprSize;
+
+  Result := TLSRecordHeaderSize + FinalSize;
+end;
+
+// Decode a TLS record into ContentBuffer and returns size of decoded content in ContentSize
+// Updates IV for next record
+// Buffer points to first byte afer record header
+procedure DecodeTLSRecord(
+          const RecHeader: PTLSRecordHeader;
+          const Buffer; const Size: Integer;
+          const ProtocolVersion: TTLSProtocolVersion;
+          const CompressionMethod: TTLSCompressionMethod;
+          const CipherSuiteDetails: TTLSCipherSuiteDetails;
+          const SequenceNumber: Int64;
+          const MACKey; const MACKeySize: Integer;
+          var CipherState: TTLSCipherState;
+          const IVBufPtr: Pointer; const IVBufSize: Integer;
+          var ContentBuffer; const ContentBufferSize: Integer;
+          out ContentSize: Integer);
+var BufP          : PByte;
+    BufPLeft      : Integer;
+    BufQ          : PByte;
+    BufQLeft      : Integer;
+    HasCipher     : Boolean;
+    IsBlockCipher : Boolean;
+    UseIV         : Boolean;
+    IVSize        : Integer;
+    BufCipher     : array[0..TLS_RecordBufSize - 1] of Byte;
+    CipherSize    : Integer;
+    RecContent    : Pointer;
+    ComprSize     : Integer;
+    BufPlain      : array[0..TLS_RecordBufSize - 1] of Byte;
+    PlainSize     : Integer;
+    NextIV        : array[0..TLS_CIPHERSUITE_MaxIVSize - 1] of Byte;
+    MACSize       : Integer;
+    PadSize       : Integer;
+    CalcMAC       : array[0..TLS_MAC_MAXDIGESTSIZE - 1] of Byte;
+    RecMAC        : Pointer;
+    MACOk         : Boolean;
+    MACIdx        : Integer;
+    ComprHdr      : TTLSRecordHeader;
+    P, Q          : PByte;
+begin
+  // initialise parameters
+  HasCipher := CipherSuiteDetails.CipherSuite <> tlscsNone;
+  IsBlockCipher :=
+      HasCipher and
+      (CipherSuiteDetails.CipherInfo^.CipherType = tlscsctBlock);
+  UseIV :=
+      IsBlockCipher and
+      (CipherSuiteDetails.CipherInfo^.IVSize > 0);
+  if UseIV then
+    IVSize := CipherSuiteDetails.CipherInfo^.IVSize
+  else
+    IVSize := 0;
+  Assert(IVSize <= TLS_CIPHERSUITE_MaxIVSize);
+  if UseIV and (IVBufSize < IVSize) then
+    raise ETLSError.Create(TLSError_InvalidBuffer);
+
+  if HasCipher then
+    begin
+      // decode Buffer
+      BufP := @Buffer;
+      BufPLeft := Size;
+
+      // TLS 1.2: get IV field from unencrypted buffer
+      if UseIV then
+        if IsTLS12OrLater(ProtocolVersion) then
+          begin
+            Move(BufP^, IVBufPtr^, IVSize);
+            Inc(BufP, IVSize);
+            Dec(BufPLeft, IVSize);
+          end;
+
+      // TLS 1.0: get IV from encrypted block
+      if UseIV then
+        if IsTLS10(ProtocolVersion) then
+          tls10UpdateIV(BufP^, BufPLeft, NextIV, IVSize);
+
+      // TLS 1.1: IV is first encrypted block
+
+      // decrypt from Buffer to BufCipher
+      TLSCipherBuf(CipherState,
+          BufP^, BufPLeft,
+          BufCipher, SizeOf(BufCipher),
+          CipherSize,
+          IVBufPtr, IVSize);
+
+      // decode decrypted Buffer
+      BufQ := @BufCipher;
+      BufQLeft := CipherSize;
+
+      // TLS 1.1: skip over IV field
+      if UseIV then
+        if IsTLS11(ProtocolVersion) then
+          begin
+            Move(BufQ^, IVBufPtr^, IVSize);
+            Inc(BufQ, IVSize);
+            Dec(BufQLeft, IVSize);
+          end;
+
+      // TLS 1.0: update IV
+      if UseIV then
+        if IsTLS10(ProtocolVersion) then
+          Move(NextIV, IVBufPtr^, IVSize);
+
+      // decode padding
+      if IsBlockCipher then
+        begin
+          PadSize := DecodeTLSGenericBlockCipherPadding(BufQ^, BufQLeft);
+          Dec(BufQLeft, PadSize);
+        end;
+
+      // update size for MAC
+      MACSize := CipherSuiteDetails.HashInfo^.HashSize div 8;
+      Dec(BufQLeft, MACSize);
+
+      // compressed content
+      RecContent := BufQ;
+      ComprSize := BufQLeft;
+
+      // Calculate MAC
+      InitTLSRecordHeader(ComprHdr, RecHeader^._type, RecHeader^.version, ComprSize);
+      GenerateRecordPayloadMAC(
+          ProtocolVersion,
+          CipherSuiteDetails,
+          MACKey, MACKeySize,
+          SequenceNumber,
+          @ComprHdr,
+          RecContent^, ComprSize,
+          CalcMAC, MACSize);
+
+      // get MAC
+      Inc(BufQ, ComprSize);
+      RecMAC := BufQ;
+
+      // validate MAC
+      P := @CalcMAC;
+      Q := RecMAC;
+      MACOk := True;
+      for MACIdx := 0 to MACSize - 1 do
+        if P^ <> Q^ then
+          begin
+            MACOk := False;
+            break;
+          end
+        else
+          begin
+            Inc(P);
+            Inc(Q);
+          end;
+      if not MACOk then
+        raise ETLSError.Create(TLSError_DecodeError);
+    end
+  else
+    begin
+      Move(Buffer, BufCipher, Size);
+      RecContent := @BufCipher;
+      ComprSize := Size;
+    end;
+
+  // decompress from BufCipher to BufPlain
+  TLSDecompressFragment(
+      CompressionMethod,
+      RecContent^, ComprSize,
+      BufPlain, SizeOf(BufPlain),
+      PlainSize);
+
+  // plain text
+  Move(BufPlain, ContentBuffer, PlainSize);
+  ContentSize := PlainSize;
+end;
+
+
+
+{                                                                              }
+{ Test cases                                                                   }
+{                                                                              }
+//// TBytes
+{$IFDEF TLS_TEST}
+{$ASSERTIONS ON}
+procedure SelfTestPayloadMAC;
+const
+  MACWriteKey = RawByteString(#$85#$F0#$56#$F8#$07#$1D#$B1#$89#$89#$D0#$E1#$33#$3C#$CA#$63#$F9);
+
+var S, T, D : RawByteString;
+    L : Integer;
+begin
+
+  //                                                                                              //
+
+  // Example from http://download.oracle.com/javase/1.5.0/docs/guide/security/jsse/ReadDebug.html //
+
+  //                                                                                              //
+
+  T := MACWriteKey;
+
+  D := RawByteString(
+      #$00#$00#$00#$00#$00#$00#$00#$00 +                                  // seq_num
+      #$16#$03#$01#$00#$10 +                                              // compressed hdr
+      #$14#$00#$00#$0C#$F2#$62#$42#$AA#$7C#$7C#$CC#$E7#$49#$0F#$ED#$AC);  // handshake msg
+  SetLength(S, 256);
+  L := GenerateTLSRecordPayloadMAC(tlsmaHMAC_MD5, T[1], Length(T), D[1], Length(D), S[1], Length(S));
+  Assert(L = 16);
+  SetLength(S, L);
+  Assert(S = #$FA#$06#$3C#$9F#$8C#$41#$1D#$ED#$2B#$06#$D0#$5A#$ED#$31#$F2#$80);
+end;
+
+procedure Test;
+begin
+  Assert(TLSContentTypeSize = 1);
+  Assert(TLSRecordHeaderSize = 5);
+  SelfTestPayloadMAC;
+end;
+{$ENDIF}
+

contrib/fundamentals/TLS/flcTLSSessionID.pas

@@ -0,0 +1,140 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSSessionID.pas                                      }
+{   File version:     5.02                                                     }
+{   Description:      TLS Session ID                                           }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2020/05/09  5.02  Create flcTLSSessionID unit from flcTLSUtils unit.       }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSSessionID;
+
+interface
+
+
+
+{                                                                              }
+{ SessionID                                                                    }
+{                                                                              }
+const
+  TLSSessionIDMaxLen = 32;
+
+type
+  TTLSSessionID = record
+    Len : Byte;
+    Data : array[0..TLSSessionIDMaxLen - 1] of Byte;
+  end;
+
+procedure InitTLSSessionID(var SessionID: TTLSSessionID; const A: RawByteString);
+function  EncodeTLSSessionID(var Buffer; const Size: Integer; const SessionID: TTLSSessionID): Integer;
+function  DecodeTLSSessionID(const Buffer; const Size: Integer; var SessionID: TTLSSessionID): Integer;
+
+
+
+implementation
+
+uses
+  { TLS }
+
+  flcTLSErrors;
+
+
+
+{                                                                              }
+{ SessionID                                                                    }
+
+{   length    : Byte;                                                          }
+{   SessionID : <0..32>;                                                       }
+{                                                                              }
+procedure InitTLSSessionID(var SessionID: TTLSSessionID; const A: RawByteString);
+var
+  L : Integer;
+begin
+  L := Length(A);
+  if L > TLSSessionIDMaxLen then
+    raise ETLSError.Create(TLSError_InvalidParameter, 'Invalid SessionID length');
+  SessionID.Len := Byte(L);
+  FillChar(SessionID.Data[0], TLSSessionIDMaxLen, 0);
+  if L > 0 then
+    Move(A[1], SessionID.Data[0], L);
+end;
+
+function EncodeTLSSessionID(var Buffer; const Size: Integer; const SessionID: TTLSSessionID): Integer;
+var L : Byte;
+    N : Integer;
+    P : PByte;
+begin
+  L := SessionID.Len;
+  N := L + 1;
+  if Size < N then
+    raise ETLSError.CreateAlertBufferEncode;
+  P := @Buffer;
+  P^ := L;
+  Inc(P);
+  if L > 0 then
+    Move(SessionID.Data[0], P^, L);
+  Result := N;
+end;
+
+function DecodeTLSSessionID(const Buffer; const Size: Integer; var SessionID: TTLSSessionID): Integer;
+var L : Byte;
+    P : PByte;
+begin
+  if Size < 1 then
+    raise ETLSError.CreateAlertBufferDecode;
+  P := @Buffer;
+  L := P^;
+  if L = 0 then
+    begin
+      SessionID.Len := 0;
+      Result := 1;
+    end
+  else
+    begin
+      if Size < 1 + L then
+        raise ETLSError.CreateAlertBufferDecode;
+      if L > TLSSessionIDMaxLen then
+        raise ETLSError.CreateAlertBufferDecode; // invalid length
+      SessionID.Len := L;
+      Inc(P);
+      Move(P^, SessionID.Data[0], L);
+      Result := 1 + L;
+    end;
+end;
+
+
+

contrib/fundamentals/TLS/flcTLSTestCertificates.pas

@@ -0,0 +1,303 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSTestCertificates.pas                               }
+{   File version:     5.05                                                     }
+{   Description:      TLS Test Certificates                                    }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2020/05/11  5.01  Initial certificates: RSA768, RSA2048, ECDSA-Secp256k1,  }
+{                     DSA512, DSA2048 and RSA-STunnel.                         }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSTestCertificates;
+
+interface
+
+
+
+{$IFDEF TLS_TEST}
+const
+  // rsa768-example.com-1
+  RSA768_ExampleCom_1_PrivateKeyRSAPEM =
+    'MIIB5QIBADANBgkqhkiG9w0BAQEFAASCAc8wggHLAgEAAmEAoO3RSQnutJfvT56L' +
+    '85saXYZQi5zCzt5YUb75z3T/WsN1oaWt7NR1Bd1+xBxdmHOSRfSm0CsBw/gkt9YI' +
+    'Vyjl6IbclBbhgIGzS3bkoVCvbG6SKtxGJPJcf9BOV8J9DqqXAgMBAAECYQCJz14b' +
+    'h+/soveCXSlH8ZjAYlbzV8jTUkCbsElIyM4rsZo4VSL93mpgHW+DDS9xb/WFPtdk' +
+    'CadzB+mnK8/Hul0OteOFFT5gn9vRzlFPS6WzPTeoeaKtqrwX8RyU+xLgREECMQDQ' +
+    '+yAK8LF/v9yJ55A7Tfcq9XDr+eEjZ2DkaytvRX4HlMV9uCccCkISxxdBIbZMeIcC' +
+    'MQDFIv8ikcJ5VjYaEr83Jof5bcH7qHeHV1WY2017cV/7ISVxwPL7rACKer+RWhnv' +
+    'kXECMHzYiZv/jwqypB3+qLvFKBQR7RQMg+OSrt/G5nvjGBePWSxyB2tI9ZAiQFI4' +
+    'wZ+NoQIwBhaWmpK11tl6wkNh9GoUOPfSzdreFif0VMwxEGbn9/GGHoU++9bMDXrM' +
+    '/8gwlN2BAjEAsBKVdwN9HHE6uu8YoSxudy5Tcwa+bj8yxLiS6EwRs5WwzvaLv88p' +
+    'ES7nd5PO2txL';
+
+  RSA768_ExampleCom_1_CertificatePEM =
+    'MIICtzCCAkGgAwIBAgIUZQggmdgFQ6iq5DQGqcgDcL7jj4EwDQYJKoZIhvcNAQEL' +
+    'BQAwgY8xCzAJBgNVBAYTAkFVMRMwEQYDVQQIDApTb21lLVN0YXRlMREwDwYDVQQH' +
+    'DAhMb2NhbGl0eTEhMB8GA1UECgwYSW50ZXJuZXQgV2lkZ2l0cyBQdHkgTHRkMRQw' +
+    'EgYDVQQDDAtleGFtcGxlLmNvbTEfMB0GCSqGSIb3DQEJARYQaW5mb0BleGFtcGxl' +
+    'LmNvbTAeFw0yMDA1MTExODI5NTlaFw0zMDA1MDkxODI5NTlaMIGPMQswCQYDVQQG' +
+    'EwJBVTETMBEGA1UECAwKU29tZS1TdGF0ZTERMA8GA1UEBwwITG9jYWxpdHkxITAf' +
+    'BgNVBAoMGEludGVybmV0IFdpZGdpdHMgUHR5IEx0ZDEUMBIGA1UEAwwLZXhhbXBs' +
+    'ZS5jb20xHzAdBgkqhkiG9w0BCQEWEGluZm9AZXhhbXBsZS5jb20wfDANBgkqhkiG' +
+    '9w0BAQEFAANrADBoAmEAoO3RSQnutJfvT56L85saXYZQi5zCzt5YUb75z3T/WsN1' +
+    'oaWt7NR1Bd1+xBxdmHOSRfSm0CsBw/gkt9YIVyjl6IbclBbhgIGzS3bkoVCvbG6S' +
+    'KtxGJPJcf9BOV8J9DqqXAgMBAAGjUzBRMB0GA1UdDgQWBBRKImmf1879CQy/aFl/' +
+    'miDQp00BJDAfBgNVHSMEGDAWgBRKImmf1879CQy/aFl/miDQp00BJDAPBgNVHRMB' +
+    'Af8EBTADAQH/MA0GCSqGSIb3DQEBCwUAA2EAZ2mFxf4DNHrmVMbvyGVXzzPmmGoz' +
+    'vNdPeSQH16cgl1Q/Ass+52pSLjeIgiSpJcQtG5YzZY/t1m8LPcGqASYg9azce8fo' +
+    'b34G260PvXX4FUrOSBZ2Owx59R5Cl1r238oj';
+
+
+
+  // rsa2048-example.com-1
+  RSA2048_ExampleCom_1_PrivateKeyRSAPEM =
+    'MIIEvQIBADANBgkqhkiG9w0BAQEFAASCBKcwggSjAgEAAoIBAQDe6cFTj4ciladG' +
+    'pHE9r0ytDfmWKVnnJZYLR2DLPVg6LVkEeykusfUSpf4pYwKOuToLD24iZpK5x3CY' +
+    'UR348OXkFT2ytQwIcyRhK91N5x06WbmtCSl2Fx0GVBaKwfgx73LNfwtGvcOQVOQy' +
+    'hozHm0TkhBHVplJ57hD3YGTH98WSiRP0fS1yV595wP72nYAvPAp61bVYpRNJDjFZ' +
+    'QESubigYB5ufLUfGntlOasNd1CuICFFkSpRi1cd/r6qvq4ehhH7ypGTBjbPQ3Zg9' +
+    'vpjR5B3NCKtH2n90fKy+Fuxfcm73GUinjR1C66Ve0CHovoskEROCcbCoi1VT2+oy' +
+    '+cqOExfFAgMBAAECggEBANzZNyK0lqwbHOmOTmtQ3GSv7dFqEppB0NBH3Yw+sMSi' +
+    '3QjlhL2wrh/VuWQDpisFNI50sSb//Op2wAUIiOt0sC8zJDeDy/IrMaXcMZvXGEwR' +
+    'TTY0V5GaALWeZd7/ogjHNTSHZAKoS7MZiCTOzXeNS8ojVxAXgqsuxDxykibUQjiU' +
+    'IVdKTN5KVANu1iL6FX9cXjbTncYmvMdtVqLccs4uFaazhWw756or1rk2rQQIEdXX' +
+    'HisZ0iQeOmZILXy8HZI3EH/Vz8CDC9T3xJG76PiDP6I5wbM2WcOLAZcop+hWi/+U' +
+    'KtTlIMFLYHSOwKjJmc4xkLRKRtoHUUtofAHSvh7CgZkCgYEA9dhhtfCskvw6mZcx' +
+    'BuPNoN6Ge9+m56Z2dhSRVs5mzNSDjuVa+HFXAAramrJ6avc7fDm8S8j/AD9b2XnW' +
+    'x4z4SFn9tTZyuUPEPAQAmwxFS2QHUA1fxDDvDh407iiSzXBO9ehke3b65YM6zjPl' +
+    'WK72OG11dbFfctD4MIjK/0kFo9sCgYEA6B7iZkI/uiLQ0fqz07oOasvsGjtFja6F' +
+    '2uNVZkZo0iYnXzdWGWeLlLQ3bme4kylpIyj2hh2EHQzrjJ6NCgU/W/QvDMFuyJbQ' +
+    'wtUhWEFjlgqgjigRGDm3kMj0+hYbnS5g3rVpmfDsKT8fwCoMXwDCEgMpDe5CnwJf' +
+    'ucgm/Njo1N8CgYAIoLttIzErR2bXFRNHZp9E0gpuNn8pChKGOlqPbVb2QU8MqMf0' +
+    'iCXBfqAFZdYeAuc3iN8u2bL5Uz/p9fivsCbWgzIANhT4o4QzhwBucJPN/Yi0KoP9' +
+    '4qnBGRZKdWoRg6uBvdIo8xgDDgP2UKPv5NQHTvAcXUk4QlUzftmA9BMamQKBgDFa' +
+    'D6zKPR5oNJnQgddsYZBXVxWksH8VMiR93TRnl/XGYuydqVKxbz3oqzhwGRBA57ew' +
+    'B+ov8Fz02EgHldkhkH0Oh8pgfhtr5WrnQbWwAWpvS/+tiSTrcJn6AAwEE07yA2qW' +
+    'i6NNVAjZAPksd4Djel+2CE6L7+I68PthENkFjUtlAoGAX+TvpFV9b7O+HxpKtljz' +
+    'DrCoN54myazIAbkEkQTHoCQcqdnvS4pnCTi+j7Gcvncbw1DHqCUadV4MG+9BNLjp' +
+    'ZuKNEqVcjdKyVC1ZO8o58/PC/jKf46BZf0KPZ2njYN/HhTsYKW+cS8BqQ03z05Vx' +
+    'mIRN6htJ2rDNYLnPKuFxW1s=';
+
+  RSA2048_ExampleCom_1_CertificatePEM =
+    'MIID2TCCAsGgAwIBAgIUDjajQu/92DMG5roEQ0G4WkQ49pQwDQYJKoZIhvcNAQEL' +
+    'BQAwfDELMAkGA1UEBhMCQVUxEzARBgNVBAgMClNvbWUtU3RhdGUxITAfBgNVBAoM' +
+    'GEludGVybmV0IFdpZGdpdHMgUHR5IEx0ZDEUMBIGA1UEAwwLZXhhbXBsZS5jb20x' +
+    'HzAdBgkqhkiG9w0BCQEWEGluZm9AZXhhbXBsZS5jb20wHhcNMjAwNTExMTgyNzE2' +
+    'WhcNMzAwNTA5MTgyNzE2WjB8MQswCQYDVQQGEwJBVTETMBEGA1UECAwKU29tZS1T' +
+    'dGF0ZTEhMB8GA1UECgwYSW50ZXJuZXQgV2lkZ2l0cyBQdHkgTHRkMRQwEgYDVQQD' +
+    'DAtleGFtcGxlLmNvbTEfMB0GCSqGSIb3DQEJARYQaW5mb0BleGFtcGxlLmNvbTCC' +
+    'ASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAN7pwVOPhyKVp0akcT2vTK0N' +
+    '+ZYpWecllgtHYMs9WDotWQR7KS6x9RKl/iljAo65OgsPbiJmkrnHcJhRHfjw5eQV' +
+    'PbK1DAhzJGEr3U3nHTpZua0JKXYXHQZUForB+DHvcs1/C0a9w5BU5DKGjMebROSE' +
+    'EdWmUnnuEPdgZMf3xZKJE/R9LXJXn3nA/vadgC88CnrVtVilE0kOMVlARK5uKBgH' +
+    'm58tR8ae2U5qw13UK4gIUWRKlGLVx3+vqq+rh6GEfvKkZMGNs9DdmD2+mNHkHc0I' +
+    'q0faf3R8rL4W7F9ybvcZSKeNHULrpV7QIei+iyQRE4JxsKiLVVPb6jL5yo4TF8UC' +
+    'AwEAAaNTMFEwHQYDVR0OBBYEFBPFygrc+d52rGccjTlh0lRXhn7VMB8GA1UdIwQY' +
+    'MBaAFBPFygrc+d52rGccjTlh0lRXhn7VMA8GA1UdEwEB/wQFMAMBAf8wDQYJKoZI' +
+    'hvcNAQELBQADggEBAJqY4EARd0fHRYTtQA7antfIGSSDYH0S5E3mVSQEKKNR029h' +
+    'XJNUKi93kheAwMAQlgKqFWWIPRGvEg8rVux3T6tSm14v7aEYmC6z/XdidYo1hA6F' +
+    'f4hAC2eBkhzEcql1FAbt+s1crBmLkfRWxeI8E7/xYmFYP99QJdv+BkxD48Rf+bE3' +
+    'hRIq2X2yOq1oC1zGR75fWcL7+6418bwYQfeOrn4bSHuWiOq19kELlzUQbSmjPnmF' +
+    'zSErKEU8hezaVX5Z6mwYgV1P4Y4CPHaoK/Tl55Lr0KSLEc2U5Ff3SBKvkgkW968q' +
+    'JYTt4/thw9MVT9/AO63iAIiYF79e8C5ZTYa6J/s=';
+
+
+
+  // ecdsa-secp256k1-example.com-1
+  ECDSA_Secp256k1_ExampleCom_1_PrivateKeyPEM =
+    'MIGEAgEAMBAGByqGSM49AgEGBSuBBAAKBG0wawIBAQQgH1iT7iOnhczYKDnUnd0T' +
+    '01m31q2wwDouonax6KF04r2hRANCAATQcPezFewJYlOYPDSYuy46Bu9SAfU8qo7a' +
+    'OYCFgN/WmiFckB/oi+sEqnYxsgPMN77+c9EjSjvl1zKCQhEP4nf1';
+
+  ECDSA_Secp256k1_ExampleCom_1_CertificatePEM =
+    'MIICSzCCAfCgAwIBAgIUMknQUnv2p2k+F2ATArxlu9STJuwwCgYIKoZIzj0EAwIw' +
+    'fDELMAkGA1UEBhMCQVUxEzARBgNVBAgMClNvbWUtU3RhdGUxITAfBgNVBAoMGElu' +
+    'dGVybmV0IFdpZGdpdHMgUHR5IEx0ZDEUMBIGA1UEAwwLZXhhbXBsZS5jb20xHzAd' +
+    'BgkqhkiG9w0BCQEWEGluZm9AZXhhbXBsZS5jb20wHhcNMjAwNTExMTg0MTE4WhcN' +
+    'MzAwNTA5MTg0MTE4WjB8MQswCQYDVQQGEwJBVTETMBEGA1UECAwKU29tZS1TdGF0' +
+    'ZTEhMB8GA1UECgwYSW50ZXJuZXQgV2lkZ2l0cyBQdHkgTHRkMRQwEgYDVQQDDAtl' +
+    'eGFtcGxlLmNvbTEfMB0GCSqGSIb3DQEJARYQaW5mb0BleGFtcGxlLmNvbTBWMBAG' +
+    'ByqGSM49AgEGBSuBBAAKA0IABNBw97MV7AliU5g8NJi7LjoG71IB9Tyqjto5gIWA' +
+    '39aaIVyQH+iL6wSqdjGyA8w3vv5z0SNKO+XXMoJCEQ/id/WjUzBRMB0GA1UdDgQW' +
+    'BBRa68KZXd4PMT2ujfRcGelXVYT5RTAfBgNVHSMEGDAWgBRa68KZXd4PMT2ujfRc' +
+    'GelXVYT5RTAPBgNVHRMBAf8EBTADAQH/MAoGCCqGSM49BAMCA0kAMEYCIQDjOYWa' +
+    'geEf616bxFlOq6GTqzHNdAsoYcllkvdTH7oGrAIhAMx/D4pikimc/8PKt2RROqU2' +
+    '1pYBYY4q+WNHi/FkP1Rb';
+
+
+
+  // dsa-512-example.com-1
+  DSA512_ExampleCom_1_DSAParamsPEM =
+    'MIGdAkEAy7pVdOq2xqDKhJVOK3yjEcBdngaCsng6nahCzR/YkOY1OS+Eb4ED+vv7' +
+    'bjWxjZzQxknRzcgMqAwLEabjoxNIGwIVAOveBUI43583wCYz0nUtdEtRAaEpAkEA' +
+    'uDkymWK9Bcy+YF+x4+xOyM1XGvyXb43TjkvwH+lTrH8jyeNpOfID07cW7xIBR/pz' +
+    'r7sf6aFr0VqBWli+T+5KZQ==';
+
+  DSA512_ExampleCom_1_PrivateKeyPEM =
+    'MIH5AgEAAkEAy7pVdOq2xqDKhJVOK3yjEcBdngaCsng6nahCzR/YkOY1OS+Eb4ED' +
+    '+vv7bjWxjZzQxknRzcgMqAwLEabjoxNIGwIVAOveBUI43583wCYz0nUtdEtRAaEp' +
+    'AkEAuDkymWK9Bcy+YF+x4+xOyM1XGvyXb43TjkvwH+lTrH8jyeNpOfID07cW7xIB' +
+    'R/pzr7sf6aFr0VqBWli+T+5KZQJBAIVwoK42Ydy2m7mtij2NLZ0Bom8l65+XQ62+' +
+    'BmV2+2SPZaLOP3R+6p3voWbimxLr1dHqnaPLxcoNvtLk0QVsAqECFETKnDMulFrC' +
+    'pWeRddos5U5WJNzC';
+
+  DSA512_ExampleCom_1_CertificatePEM =
+    'MIIC0TCCAo6gAwIBAgIUfVSUaT4wpDU2h5Czdf+zJPqtVQYwCwYJYIZIAWUDBAMC' +
+    'MHwxCzAJBgNVBAYTAkFVMRMwEQYDVQQIDApTb21lLVN0YXRlMSEwHwYDVQQKDBhJ' +
+    'bnRlcm5ldCBXaWRnaXRzIFB0eSBMdGQxFDASBgNVBAMMC2V4YW1wbGUuY29tMR8w' +
+    'HQYJKoZIhvcNAQkBFhBpbmZvQGV4YW1wbGUuY29tMB4XDTIwMDUxMTE5NTEyOFoX' +
+    'DTMwMDUwOTE5NTEyOFowfDELMAkGA1UEBhMCQVUxEzARBgNVBAgMClNvbWUtU3Rh' +
+    'dGUxITAfBgNVBAoMGEludGVybmV0IFdpZGdpdHMgUHR5IEx0ZDEUMBIGA1UEAwwL' +
+    'ZXhhbXBsZS5jb20xHzAdBgkqhkiG9w0BCQEWEGluZm9AZXhhbXBsZS5jb20wgfIw' +
+    'gakGByqGSM44BAEwgZ0CQQDLulV06rbGoMqElU4rfKMRwF2eBoKyeDqdqELNH9iQ' +
+    '5jU5L4RvgQP6+/tuNbGNnNDGSdHNyAyoDAsRpuOjE0gbAhUA694FQjjfnzfAJjPS' +
+    'dS10S1EBoSkCQQC4OTKZYr0FzL5gX7Hj7E7IzVca/JdvjdOOS/Af6VOsfyPJ42k5' +
+    '8gPTtxbvEgFH+nOvux/poWvRWoFaWL5P7kplA0QAAkEAvsRAbx3gJSKdOAmD6922' +
+    'L/akoJiyT6hkz/9/D+oHvfdD6C5djg9E7ldBxu2y4G0RT6hrBgucnaY5EKRQ4Qa3' +
+    'aqNTMFEwHQYDVR0OBBYEFN8uO0Y+73h43EIYn10VZvHY28/iMB8GA1UdIwQYMBaA' +
+    'FN8uO0Y+73h43EIYn10VZvHY28/iMA8GA1UdEwEB/wQFMAMBAf8wCwYJYIZIAWUD' +
+    'BAMCAzAAMC0CFQDJuGO19W778E8nVcowcu6INt4++gIUURUMEWm/dRO+4ti8GoHD' +
+    'X4xdmkI=';
+
+
+
+  // dsa-2048-example.com-1
+  DSA2048_ExampleCom_1_DSAParamsPEM =
+    'MIICLAKCAQEA0SWakCcmMvfxKFGQZkRCYDvaCIVu1PVuDTzclYdvWMLRajxpO3jK' +
+    'paekYV9kh/beE6aRtyhEvNbEo9YmWPM8PSYwN5OBp8mW+gxaO7yrr/SVNXrF+xsK' +
+    'dXle7UE4gP5JXtY4Tnl0u0BBGyrhl5rnBKfxJllhC4c+YEoEb+IWuJcal9Qhv1S7' +
+    'dxVqB7KJ1PG8IOe4ainWjM7bnqjoHd5JpqfNami9CKKoV5EAdiQcVPEVcf1uKU+F' +
+    'E6TzAqep60MTdi6K7l+xfTHKt15aZlcAS/93rkA6BiguUK/JV8JFGUvY2Zu2hNh0' +
+    'FlJfGIShRbScrf8jIelzFeCdZc6EujSrQQIhAOTD9z+JcF8PGCRmyHDAdUEDnlXw' +
+    'lobq80CtiTeabSwLAoIBABQTvKuqZNNbhMw6jwjwrVLhbRxVcaLxRHKVGS4b7+zN' +
+    'j6zBANZ+OD0ds9XFpy5XIAkwgOiFCK3A/QC+1/eSRqSpzaBb6NwN9poAsxh5TzQe' +
+    '0j1FmvUGDzjHgPSCZXCaEqgFtwqzn188oeOAWsGDNHfEeEIzM735AEyOfIEtDNwE' +
+    'r5xaUpJa0m0q1TRule90VySR+1JMOJBdl6rDXeUe5YgdjW0oXBoZ7Ejlbzz8bjwk' +
+    'LZaxipq4iScHar6gNIXSH5NRmhKRANg9/IRdzdduC0iyCwvANlQXjNqv6qxONvnK' +
+    'Eeud+U0qeOzXQpFunX7jk0pWhXJsrHYoYE8JEF+t2TE=';
+
+  DSA2048_ExampleCom_1_PrivateKeyPEM =
+    'MIIDVgIBAAKCAQEA0SWakCcmMvfxKFGQZkRCYDvaCIVu1PVuDTzclYdvWMLRajxp' +
+    'O3jKpaekYV9kh/beE6aRtyhEvNbEo9YmWPM8PSYwN5OBp8mW+gxaO7yrr/SVNXrF' +
+    '+xsKdXle7UE4gP5JXtY4Tnl0u0BBGyrhl5rnBKfxJllhC4c+YEoEb+IWuJcal9Qh' +
+    'v1S7dxVqB7KJ1PG8IOe4ainWjM7bnqjoHd5JpqfNami9CKKoV5EAdiQcVPEVcf1u' +
+    'KU+FE6TzAqep60MTdi6K7l+xfTHKt15aZlcAS/93rkA6BiguUK/JV8JFGUvY2Zu2' +
+    'hNh0FlJfGIShRbScrf8jIelzFeCdZc6EujSrQQIhAOTD9z+JcF8PGCRmyHDAdUED' +
+    'nlXwlobq80CtiTeabSwLAoIBABQTvKuqZNNbhMw6jwjwrVLhbRxVcaLxRHKVGS4b' +
+    '7+zNj6zBANZ+OD0ds9XFpy5XIAkwgOiFCK3A/QC+1/eSRqSpzaBb6NwN9poAsxh5' +
+    'TzQe0j1FmvUGDzjHgPSCZXCaEqgFtwqzn188oeOAWsGDNHfEeEIzM735AEyOfIEt' +
+    'DNwEr5xaUpJa0m0q1TRule90VySR+1JMOJBdl6rDXeUe5YgdjW0oXBoZ7Ejlbzz8' +
+    'bjwkLZaxipq4iScHar6gNIXSH5NRmhKRANg9/IRdzdduC0iyCwvANlQXjNqv6qxO' +
+    'NvnKEeud+U0qeOzXQpFunX7jk0pWhXJsrHYoYE8JEF+t2TECggEAbafGARPAM0KD' +
+    '9DNoJTKn94GXQPJcHMqE8i8IZtDTtn2jFNcz5p+Ee9n7Tz0fPeNQuaQLUF3GK7wT' +
+    '82D1JxEyFmWXysIyDa45iwXfFUMb44DxOZh6PNcH7pn/ZTQg9LeXFOSqpIUdEzAC' +
+    '0feCbfaWT081vnJFEq6ZZ4TKNTiYo/pFRs6d6KxlJGHtuR1FvFcR2HmK9wff0W7t' +
+    'wA3+D7rqE1eJd6GiAf2WGYkdwt/Jbyqtn3hQyO6++23qsE9yStaweL5lGxsyzpZ1' +
+    'dyaKg9yQNZZGGIey7EPTZ02bpceADxx0beWg3QhSXMzk35+AA2o4wyL6jWujy7zR' +
+    'xIDYYdGsCwIhAINGDcB6W3IQCCe/XSHrJ9uXEQ7zcytzmBbPBJW7L2Gr';
+
+  DSA2048_ExampleCom_1_CertificatePEM =
+    'MIIFPjCCBOOgAwIBAgIURBEKc3eR4RfSATcwzqCG4zr2rvowCwYJYIZIAWUDBAMC' +
+    'MHwxCzAJBgNVBAYTAkFVMRMwEQYDVQQIDApTb21lLVN0YXRlMSEwHwYDVQQKDBhJ' +
+    'bnRlcm5ldCBXaWRnaXRzIFB0eSBMdGQxFDASBgNVBAMMC2V4YW1wbGUuY29tMR8w' +
+    'HQYJKoZIhvcNAQkBFhBpbmZvQGV4YW1wbGUuY29tMB4XDTIwMDUxMTE4Mzc0MFoX' +
+    'DTMwMDUwOTE4Mzc0MFowfDELMAkGA1UEBhMCQVUxEzARBgNVBAgMClNvbWUtU3Rh' +
+    'dGUxITAfBgNVBAoMGEludGVybmV0IFdpZGdpdHMgUHR5IEx0ZDEUMBIGA1UEAwwL' +
+    'ZXhhbXBsZS5jb20xHzAdBgkqhkiG9w0BCQEWEGluZm9AZXhhbXBsZS5jb20wggNG' +
+    'MIICOQYHKoZIzjgEATCCAiwCggEBANElmpAnJjL38ShRkGZEQmA72giFbtT1bg08' +
+    '3JWHb1jC0Wo8aTt4yqWnpGFfZIf23hOmkbcoRLzWxKPWJljzPD0mMDeTgafJlvoM' +
+    'Wju8q6/0lTV6xfsbCnV5Xu1BOID+SV7WOE55dLtAQRsq4Zea5wSn8SZZYQuHPmBK' +
+    'BG/iFriXGpfUIb9Uu3cVageyidTxvCDnuGop1ozO256o6B3eSaanzWpovQiiqFeR' +
+    'AHYkHFTxFXH9bilPhROk8wKnqetDE3Yuiu5fsX0xyrdeWmZXAEv/d65AOgYoLlCv' +
+    'yVfCRRlL2NmbtoTYdBZSXxiEoUW0nK3/IyHpcxXgnWXOhLo0q0ECIQDkw/c/iXBf' +
+    'DxgkZshwwHVBA55V8JaG6vNArYk3mm0sCwKCAQAUE7yrqmTTW4TMOo8I8K1S4W0c' +
+    'VXGi8URylRkuG+/szY+swQDWfjg9HbPVxacuVyAJMIDohQitwP0Avtf3kkakqc2g' +
+    'W+jcDfaaALMYeU80HtI9RZr1Bg84x4D0gmVwmhKoBbcKs59fPKHjgFrBgzR3xHhC' +
+    'MzO9+QBMjnyBLQzcBK+cWlKSWtJtKtU0bpXvdFckkftSTDiQXZeqw13lHuWIHY1t' +
+    'KFwaGexI5W88/G48JC2WsYqauIknB2q+oDSF0h+TUZoSkQDYPfyEXc3XbgtIsgsL' +
+    'wDZUF4zar+qsTjb5yhHrnflNKnjs10KRbp1+45NKVoVybKx2KGBPCRBfrdkxA4IB' +
+    'BQACggEAbafGARPAM0KD9DNoJTKn94GXQPJcHMqE8i8IZtDTtn2jFNcz5p+Ee9n7' +
+    'Tz0fPeNQuaQLUF3GK7wT82D1JxEyFmWXysIyDa45iwXfFUMb44DxOZh6PNcH7pn/' +
+    'ZTQg9LeXFOSqpIUdEzAC0feCbfaWT081vnJFEq6ZZ4TKNTiYo/pFRs6d6KxlJGHt' +
+    'uR1FvFcR2HmK9wff0W7twA3+D7rqE1eJd6GiAf2WGYkdwt/Jbyqtn3hQyO6++23q' +
+    'sE9yStaweL5lGxsyzpZ1dyaKg9yQNZZGGIey7EPTZ02bpceADxx0beWg3QhSXMzk' +
+    '35+AA2o4wyL6jWujy7zRxIDYYdGsC6NTMFEwHQYDVR0OBBYEFC+/k77yRQlGFqpI' +
+    'unC/qriSkUcoMB8GA1UdIwQYMBaAFC+/k77yRQlGFqpIunC/qriSkUcoMA8GA1Ud' +
+    'EwEB/wQFMAMBAf8wCwYJYIZIAWUDBAMCA0gAMEUCIQCzQ2pv8wajCK9V/0DL4WVE' +
+    '9bPgwloEdmFzoxMxeHfePwIgKjeEa1eIgbzQhMqaejjp/XsuATHUZ6cPU3A3uDWs' +
+    'ezo=';
+
+
+  // rsa-stunnel
+  // from stunnel pem file
+  RSA_STunnel_PrivateKeyRSAPEM =
+    'MIICXAIBAAKBgQCxUFMuqJJbI9KnB8VtwSbcvwNOltWBtWyaSmp7yEnqwWel5TFf' +
+    'cOObCuLZ69sFi1ELi5C91qRaDMow7k5Gj05DZtLDFfICD0W1S+n2Kql2o8f2RSvZ' +
+    'qD2W9l8i59XbCz1oS4l9S09L+3RTZV9oer/Unby/QmicFLNM0WgrVNiKywIDAQAB' +
+    'AoGAKX4KeRipZvpzCPMgmBZi6bUpKPLS849o4pIXaO/tnCm1/3QqoZLhMB7UBvrS' +
+    'PfHj/Tejn0jjHM9xYRHi71AJmAgzI+gcN1XQpHiW6kATNDz1r3yftpjwvLhuOcp9' +
+    'tAOblojtImV8KrAlVH/21rTYQI+Q0m9qnWKKCoUsX9Yu8UECQQDlbHL38rqBvIMk' +
+    'zK2wWJAbRvVf4Fs47qUSef9pOo+p7jrrtaTqd99irNbVRe8EWKbSnAod/B04d+cQ' +
+    'ci8W+nVtAkEAxdqPOnCISW4MeS+qHSVtaGv2kwvfxqfsQw+zkwwHYqa+ueg4wHtG' +
+    '/9+UgxcXyCXrj0ciYCqURkYhQoPbWP82FwJAWWkjgTgqsYcLQRs3kaNiPg8wb7Yb' +
+    'NxviX0oGXTdCaAJ9GgGHjQ08lNMxQprnpLT8BtZjJv5rUOeBuKoXagggHQJAaUAF' +
+    '91GLvnwzWHg5p32UgPsF1V14siX8MgR1Q6EfgKQxS5Y0Mnih4VXfnAi51vgNIk/2' +
+    'AnBEJkoCQW8BTYueCwJBALvz2JkaUfCJc18E7jCP7qLY4+6qqsq+wr0t18+ogOM9' +
+    'JIY9r6e1qwNxQ/j1Mud6gn6cRrObpRtEad5z2FtcnwY=';
+
+  RSA_STunnel_CertificatePEM =
+    'MIICDzCCAXigAwIBAgIBADANBgkqhkiG9w0BAQQFADBCMQswCQYDVQQGEwJQTDEf' +
+    'MB0GA1UEChMWU3R1bm5lbCBEZXZlbG9wZXJzIEx0ZDESMBAGA1UEAxMJbG9jYWxo' +
+    'b3N0MB4XDTk5MDQwODE1MDkwOFoXDTAwMDQwNzE1MDkwOFowQjELMAkGA1UEBhMC' +
+    'UEwxHzAdBgNVBAoTFlN0dW5uZWwgRGV2ZWxvcGVycyBMdGQxEjAQBgNVBAMTCWxv' +
+    'Y2FsaG9zdDCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEAsVBTLqiSWyPSpwfF' +
+    'bcEm3L8DTpbVgbVsmkpqe8hJ6sFnpeUxX3Djmwri2evbBYtRC4uQvdakWgzKMO5O' +
+    'Ro9OQ2bSwxXyAg9FtUvp9iqpdqPH9kUr2ag9lvZfIufV2ws9aEuJfUtPS/t0U2Vf' +
+    'aHq/1J28v0JonBSzTNFoK1TYissCAwEAAaMVMBMwEQYJYIZIAYb4QgEBBAQDAgZA' +
+    'MA0GCSqGSIb3DQEBBAUAA4GBAAhYFTngWc3tuMjVFhS4HbfFF/vlOgTu44/rv2F+' +
+    'ya1mEB93htfNxx3ofRxcjCdorqONZFwEba6xZ8/UujYfVmIGCBy4X8+aXd83TJ9A' +
+    'eSjTzV9UayOoGtmg8Dv2aj/5iabNeK1Qf35ouvlcTezVZt2ZeJRhqUHcGaE+apCN' +
+    'TC9Y';
+{$ENDIF}
+
+
+
+implementation
+
+
+
+end.
+

contrib/fundamentals/TLS/flcTLSTests.pas

@@ -0,0 +1,413 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSTests.pas                                          }
+{   File version:     5.05                                                     }
+{   Description:      TLS tests                                                }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2010/12/15  0.02  Client/Server test case.                                 }
+{   2010/12/17  0.03  Client/Server test cases for TLS 1.0, 1.1 and 1.2.       }
+{   2018/07/17  5.04  Revised for Fundamentals 5.                              }
+{   2020/05/11  5.05  Use client options.                                      }
+{                                                                              }
+{ References:                                                                  }
+{                                                                              }
+{   SSL 3 - www.mozilla.org/projects/security/pki/nss/ssl/draft302.txt         }
+{   RFC 2246 - The TLS Protocol Version 1.0                                    }
+{   RFC 4346 - The TLS Protocol Version 1.1                                    }
+{   RFC 5246 - The TLS Protocol Version 1.2                                    }
+{   RFC 4366 - Transport Layer Security (TLS) Extensions                       }
+{   www.mozilla.org/projects/security/pki/nss/ssl/traces/trc-clnt-ex.html      }
+{   RFC 4492 - Elliptic Curve Cryptography (ECC) Cipher Suites                 }
+{                                                                              }
+{******************************************************************************}
+
+//  -----------------------------------------------------  -------------------------------------------
+//  CIPHER SUITE                                           ClientServer Test
+//  -----------------------------------------------------  -------------------------------------------
+//  RSA_WITH_RC4_128_MD5                                   TESTED OK
+//  RSA_WITH_RC4_128_SHA                                   TESTED OK
+//  RSA_WITH_DES_CBC_SHA                                   TESTED OK
+//  RSA_WITH_AES_128_CBC_SHA                               TESTED OK
+//  RSA_WITH_AES_256_CBC_SHA                               TESTED OK
+//  RSA_WITH_AES_128_CBC_SHA256                            TESTED OK TLS 1.2 only
+//  RSA_WITH_AES_256_CBC_SHA256                            TESTED OK TLS 1.2 only
+//  NULL_WITH_NULL_NULL                                    UNTESTED
+//  RSA_WITH_NULL_MD5                                      UNTESTED
+//  RSA_WITH_NULL_SHA                                      UNTESTED
+//  RSA_WITH_IDEA_CBC_SHA                                  UNTESTED
+//  RSA_WITH_3DES_EDE_CBC_SHA                              ERROR: SERVER DECRYPTION FAILED
+//  RSA_WITH_NULL_SHA256                                   ERROR
+//  DHE_RSA_WITH_AES_256_CBC_SHA                           TESTED OK TLS 1.2
+//  -----------------------------------------------------  -------------------------------------------
+
+{$INCLUDE flcTLS.inc}
+
+{$DEFINE TLS_TEST_LOG_TO_CONSOLE}
+
+{$DEFINE Cipher_SupportEC}
+
+unit flcTLSTests;
+
+interface
+
+
+
+{                                                                              }
+{ Test                                                                         }
+{                                                                              }
+{$IFDEF TLS_TEST}
+procedure Test;
+{$ENDIF}
+
+
+
+implementation
+
+uses
+  { System }
+
+  SysUtils,
+  SyncObjs,
+
+  { Utils }
+
+  flcStdTypes,
+  flcBase64,
+  flcStrings,
+  flcPEM,
+  flcASN1,
+  flcX509Certificate,
+  flcHugeInt,
+
+  { Cipher }
+
+  flcCipherAES,
+  flcCipherRSA,
+  flcCipherDH,
+  {$IFDEF Cipher_SupportEC}
+  flcCipherEllipticCurve,
+  {$ENDIF}
+
+  { TLS }
+
+  flcTLSConsts,
+  flcTLSProtocolVersion,
+  flcTLSRecord,
+  flcTLSAlert,
+  flcTLSAlgorithmTypes,
+  flcTLSRandom,
+  flcTLSCertificate,
+  flcTLSHandshake,
+  flcTLSCipher,
+  flcTLSPRF,
+  flcTLSKeys,
+  flcTLSTransportTypes,
+  flcTLSTransportConnection,
+  flcTLSTransportClient,
+  flcTLSTransportServer,
+  flcTLSTestCertificates;
+
+
+
+{                                                                              }
+{ Test                                                                         }
+{                                                                              }
+{$IFDEF TLS_TEST}
+type
+  TTLSClientServerTester = class
+    Lock : TCriticalSection;
+    Sr : TTLSServer;
+    Cl : TTLSClient;
+    SCl : TTLSServerClient;
+    constructor Create;
+    destructor Destroy; override;
+    procedure ServerTLSendProc(Server: TTLSServer; Client: TTLSServerClient; const Buffer; const Size: Integer);
+    procedure ClientTLSendProc(const Sender: TTLSConnection; const Buffer; const Size: Integer);
+    procedure Log(Msg: String);
+    procedure ClientLog(Sender: TTLSConnection; LogType: TTLSLogType; LogMsg: String; LogLevel: Integer);
+    procedure ServerLog(Sender: TTLSServer; LogType: TTLSLogType; LogMsg: String; LogLevel: Integer);
+  end;
+
+constructor TTLSClientServerTester.Create;
+begin
+  inherited Create;
+  Lock := TCriticalSection.Create;
+  Sr := TTLSServer.Create(ServerTLSendProc);
+  Sr.OnLog := ServerLog;
+  Cl := TTLSClient.Create(ClientTLSendProc);
+  Cl.OnLog := ClientLog;
+end;
+
+destructor TTLSClientServerTester.Destroy;
+begin
+  FreeAndNil(Cl);
+  FreeAndNil(Sr);
+  FreeAndNil(Lock);
+  inherited Destroy;
+end;
+
+procedure TTLSClientServerTester.ServerTLSendProc(Server: TTLSServer; Client: TTLSServerClient; const Buffer; const Size: Integer);
+begin
+  Assert(Assigned(Cl));
+  Cl.ProcessTransportLayerReceivedData(Buffer, Size);
+end;
+
+procedure TTLSClientServerTester.ClientTLSendProc(const Sender: TTLSConnection; const Buffer; const Size: Integer);
+begin
+  Assert(Assigned(SCl));
+  SCl.ProcessTransportLayerReceivedData(Buffer, Size);
+end;
+
+{$IFDEF TLS_TEST_LOG_TO_CONSOLE}
+procedure TTLSClientServerTester.Log(Msg: String);
+var S : String;
+begin
+  S := FormatDateTime('hh:nn:ss.zzz', Now) + ' ' + Msg;
+  Lock.Acquire;
+  try
+    Writeln(S);
+  finally
+    Lock.Release;
+  end;
+end;
+{$ELSE}
+procedure TTLSClientServerTester.Log(Msg: String);
+begin
+end;
+{$ENDIF}
+
+procedure TTLSClientServerTester.ClientLog(Sender: TTLSConnection; LogType: TTLSLogType; LogMsg: String; LogLevel: Integer);
+begin
+  Log(IntToStr(LogLevel) + ' C:' + LogMsg);
+end;
+
+procedure TTLSClientServerTester.ServerLog(Sender: TTLSServer; LogType: TTLSLogType; LogMsg: String; LogLevel: Integer);
+begin
+  Log(IntToStr(LogLevel) + ' S:' + LogMsg);
+end;
+
+procedure TestClientServer(
+          const ClientOptions      : TTLSClientOptions      = [];
+          const VersionOptions     : TTLSVersionOptions     = DefaultTLSClientVersionOptions;
+          const KeyExchangeOptions : TTLSKeyExchangeOptions = DefaultTLSClientKeyExchangeOptions;
+          const CipherOptions      : TTLSCipherOptions      = DefaultTLSClientCipherOptions;
+          const HashOptions        : TTLSHashOptions        = DefaultTLSClientHashOptions
+          );
+const
+  LargeBlockSize = TLS_PLAINTEXT_FRAGMENT_MAXSIZE * 8;
+var CS : TTLSClientServerTester;
+    CtL : TTLSCertificateList;
+    S : RawByteString;
+    I, L : Integer;
+begin
+  CS := TTLSClientServerTester.Create;
+  try
+    // initialise client
+    CS.Cl.ClientOptions := ClientOptions;
+    // initialise server
+    CS.Sr.PrivateKeyRSAPEM := RSA_STunnel_PrivateKeyRSAPEM;
+    TLSCertificateListAppend(CtL,
+        MIMEBase64Decode(RSA_STunnel_CertificatePEM));
+    CS.Sr.CertificateList := CtL;
+    CS.Sr.DHKeySize := 512;
+    // start server
+    CS.Sr.Start;
+    Assert(CS.Sr.State = tlssActive);
+    // start connection
+    CS.SCl := CS.Sr.AddClient(nil);
+    CS.SCl.Start;
+    CS.Cl.Start;
+    // negotiated
+    Assert(CS.Cl.IsReadyState);
+    Assert(CS.SCl.IsReadyState);
+    // application data (small block)
+    S := 'Fundamentals';
+    CS.Cl.Write(S[1], Length(S));
+    Assert(CS.SCl.AvailableToRead = 12);
+    S := '1234567890';
+    Assert(CS.SCl.Read(S[1], 3) = 3);
+    Assert(CS.SCl.AvailableToRead = 9);
+    Assert(S = 'Fun4567890');
+    Assert(CS.SCl.Read(S[1], 9) = 9);
+    Assert(CS.SCl.AvailableToRead = 0);
+    Assert(S = 'damentals0');
+    S := 'Fundamentals';
+    CS.SCl.Write(S[1], Length(S));
+    Assert(CS.Cl.AvailableToRead = 12);
+    S := '123456789012';
+    Assert(CS.Cl.Read(S[1], 12) = 12);
+    Assert(CS.Cl.AvailableToRead = 0);
+    Assert(S = 'Fundamentals');
+    // application data (large blocks)
+    for L := LargeBlockSize - 1 to LargeBlockSize + 1 do
+      begin
+        SetLength(S, L);
+        FillChar(S[1], L, #1);
+        CS.Cl.Write(S[1], L);
+        Assert(CS.SCl.AvailableToRead = L);
+        FillChar(S[1], L, #0);
+        CS.SCl.Read(S[1], L);
+        for I := 1 to L do
+          Assert(S[I] = #1);
+        Assert(CS.SCl.AvailableToRead = 0);
+        CS.SCl.Write(S[1], L);
+        Assert(CS.Cl.AvailableToRead = L);
+        FillChar(S[1], L, #0);
+        Assert(CS.Cl.Read(S[1], L) = L);
+        for I := 1 to L do
+          Assert(S[I] = #1);
+        Assert(CS.Cl.AvailableToRead = 0);
+      end;
+    // close
+    CS.Cl.Close;
+    Assert(CS.Cl.IsFinishedState);
+    Assert(CS.SCl.IsFinishedState);
+    // stop
+    CS.Sr.RemoveClient(CS.SCl);
+    CS.Sr.Stop;
+  finally
+    FreeAndNil(CS);
+  end;
+end;
+
+procedure Test_Units_Dependencies;
+begin
+  flcPEM.Test;
+  flcASN1.Test;
+  flcX509Certificate.Test;
+
+  flcHugeInt.Test;
+
+  flcCipherAES.Test;
+  flcCipherRSA.Test;
+  flcCipherDH.Test;
+  {$IFDEF Cipher_SupportEC}
+  flcCipherEllipticCurve.Test;
+  {$ENDIF}
+end;
+
+procedure Test_Units_TLS;
+begin
+  flcTLSAlert.Test;
+  flcTLSAlgorithmTypes.Test;
+  flcTLSRandom.Test;
+  flcTLSCipher.Test;
+  flcTLSHandshake.Test;
+  flcTLSKeys.Test;
+  flcTLSProtocolVersion.Test;
+  flcTLSPRF.Test;
+  flcTLSRecord.Test;
+end;
+
+procedure Test_ClientServer_TLSVersions;
+begin
+  // TLS 1.2
+  TestClientServer([], [tlsvoTLS12]);
+  // TLS 1.1
+  TestClientServer([], [tlsvoTLS11]);
+  // TLS 1.0
+  TestClientServer([], [tlsvoTLS10]);
+  Sleep(100);
+  // SSL 3
+  // Fails with invalid parameter
+  //SelfTestClientServer([], [tlsvoSSL3]);
+end;
+
+procedure Test_ClientServer_KeyExchangeAlgos;
+begin
+  // TLS 1.2 RSA
+  TestClientServer([], [tlsvoTLS12], [tlskeoRSA]);
+  // TLS 1.2 DHE_RSA
+  TestClientServer([], [tlsvoTLS12], [tlskeoDHE_RSA]);
+  // TLS 1.2 DH_anon
+  // Under development/testing
+  //SelfTestClientServer([], [tlsvoTLS12], [tlskeoDH_Anon]);
+end;
+
+procedure Test_ClientServer_CipherAlgos;
+begin
+  // TLS 1.2 RC4
+  TestClientServer([], [tlsvoTLS12], DefaultTLSClientKeyExchangeOptions,
+      [tlscoRC4]);
+  // TLS 1.2 AES128
+  TestClientServer([], [tlsvoTLS12], DefaultTLSClientKeyExchangeOptions,
+      [tlscoAES128]);
+  // TLS 1.2 AES256
+  TestClientServer([], [tlsvoTLS12], DefaultTLSClientKeyExchangeOptions,
+      [tlscoAES256]);
+  // TLS 1.2 DES
+  TestClientServer([], [tlsvoTLS12], DefaultTLSClientKeyExchangeOptions,
+      [tlscoDES]);
+  // TLS 1.2 3DES
+  // No Cipher Suite
+  {SelfTestClientServer([], [tlsvoTLS12], DefaultTLSClientKeyExchangeOptions,
+      [tlsco3DES]);}
+end;
+
+procedure Test_ClientServer_HashAlgos;
+begin
+  // TLS 1.2 SHA256
+  TestClientServer(
+      [], [tlsvoTLS12], DefaultTLSClientKeyExchangeOptions, DefaultTLSClientCipherOptions,
+      [tlshoSHA256]);
+  // TLS 1.2 SHA1
+  TestClientServer(
+      [], [tlsvoTLS12], DefaultTLSClientKeyExchangeOptions, DefaultTLSClientCipherOptions,
+      [tlshoSHA1]);
+  // TLS 1.2 MD5
+  TestClientServer(
+      [], [tlsvoTLS12], DefaultTLSClientKeyExchangeOptions, DefaultTLSClientCipherOptions,
+      [tlshoMD5]);
+end;
+
+procedure Test_ClientServer;
+begin
+  Test_ClientServer_TLSVersions;
+  Test_ClientServer_KeyExchangeAlgos;
+  Test_ClientServer_CipherAlgos;
+  Test_ClientServer_HashAlgos;
+end;
+
+procedure Test;
+begin
+  Test_Units_Dependencies;
+  Test_Units_TLS;
+  Test_ClientServer;
+end;
+{$ENDIF}
+
+
+
+end.
+

contrib/fundamentals/TLS/flcTLSTransportClient.pas

@@ -0,0 +1,875 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSTransportClient.pas                                }
+{   File version:     5.08                                                     }
+{   Description:      TLS Transport Client                                     }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2010/11/26  0.02  Protocol messages.                                       }
+{   2010/11/30  0.03  Encrypted messages.                                      }
+{   2010/12/03  0.04  Connection base class.                                   }
+{   2016/01/08  0.05  String changes.                                          }
+{   2018/07/17  5.06  Revised for Fundamentals 5.                              }
+{   2020/05/11  5.07  VersionOptions, KeyExchangeOptions, CipherOptions and    }
+{                     HashOptions.                                             }
+{   2020/05/19  5.08  Verify RSA authentication signature for DHE_RSA.         }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSTransportClient;
+
+interface
+
+uses
+  SysUtils,
+
+  { Utils }
+
+  flcStdTypes,
+
+  { Cipher }
+
+  flcCipherRSA,
+  flcCipherDH,
+
+  { X509 }
+
+  flcX509Certificate,
+
+  { TLS }
+
+  flcTLSProtocolVersion,
+  flcTLSAlgorithmTypes,
+  flcTLSRandom,
+  flcTLSCipherSuite,
+  flcTLSRecord,
+  flcTLSAlert,
+  flcTLSKeyExchangeParams,
+  flcTLSCertificate,
+  flcTLSKeys,
+  flcTLSHandshake,
+  flcTLSTransportTypes,
+  flcTLSTransportConnection;
+
+
+
+{                                                                              }
+{ TLS Client                                                                   }
+{                                                                              }
+type
+  TTLSClientOption = (
+      tlscloNone
+    );
+
+  TTLSClientOptions = set of TTLSClientOption;
+
+const
+  DefaultTLSClientOptions            = [];
+  DefaultTLSClientVersionOptions     = AllTLSVersionOptions - [tlsvoSSL3];
+  DefaultTLSClientKeyExchangeOptions = AllTLSKeyExchangeOptions;
+  DefaultTLSClientCipherOptions      = AllTLSCipherOptions;
+  DefaultTLSClientHashOptions        = AllTLSHashOptions;
+
+type
+  TTLSClient = class;
+
+  TTLSClientNotifyEvent = procedure (Sender: TTLSClient) of object;
+
+  TTLSClientState = (
+      tlsclInit,
+      tlsclHandshakeAwaitingServerHello,
+      tlsclHandshakeAwaitingServerHelloDone,
+      tlsclHandshakeClientKeyExchange,
+      tlsclConnection
+    );
+
+  TTLSClient = class(TTLSConnection)
+  protected
+    FClientOptions         : TTLSClientOptions;
+    FVersionOptions        : TTLSVersionOptions;
+    FKeyExchangeOptions    : TTLSKeyExchangeOptions;
+    FCipherOptions         : TTLSCipherOptions;
+    FHashOptions           : TTLSHashOptions;
+    FResumeSessionID       : RawByteString;
+
+    FClientState           : TTLSClientState;
+    FClientProtocolVersion : TTLSProtocolVersion;
+    FServerProtocolVersion : TTLSProtocolVersion;
+    FClientHello           : TTLSClientHello;
+    FClientHelloRandomStr  : RawByteString;
+    FServerHello           : TTLSServerHello;
+    FServerHelloRandomStr  : RawByteString;
+    FServerCertificateList : TTLSCertificateList;
+    FServerX509Certs       : TX509CertificateArray;
+    FServerKeyExchange     : TTLSServerKeyExchange;
+    FCertificateRequest    : TTLSCertificateRequest;
+    FCertificateRequested  : Boolean;
+    FClientKeyExchange     : TTLSClientKeyExchange;
+    FServerRSAPublicKey    : TRSAPublicKey;
+    FDHState               : PDHState;
+    FPreMasterSecretStr    : RawByteString;
+    FMasterSecret          : RawByteString;
+
+    procedure Init; override;
+
+    procedure SetClientState(const AState: TTLSClientState);
+    procedure CheckNotActive;
+
+    procedure SetClientOptions(const AClientOptions: TTLSClientOptions);
+    procedure SetVersionOptions(const AVersionOptions: TTLSVersionOptions);
+    procedure SetCipherOptions(const ACipherOptions: TTLSCipherOptions);
+    procedure SetKeyExchangeOptions(const AKeyExchangeOptions: TTLSKeyExchangeOptions);
+    procedure SetHashOptions(const AHashOptions: TTLSHashOptions);
+
+    procedure InitInitialProtocolVersion;
+    procedure InitSessionProtocolVersion;
+    procedure InitClientHelloCipherSuites;
+    procedure InitDHState;
+
+    procedure InitHandshakeClientHello;
+    procedure InitServerPublicKey_RSA;
+    procedure InitHandshakeClientKeyExchange;
+
+    procedure SendHandshakeClientHello;
+    procedure SendHandshakeCertificate;
+    procedure SendHandshakeClientKeyExchange;
+    procedure SendHandshakeCertificateVerify;
+    procedure SendHandshakeFinished;
+
+    procedure HandleHandshakeHelloRequest(const Buffer; const Size: Integer);
+    procedure HandleHandshakeServerHello(const Buffer; const Size: Integer);
+    procedure HandleHandshakeCertificate(const Buffer; const Size: Integer);
+    procedure HandleHandshakeServerKeyExchange(const Buffer; const Size: Integer);
+    procedure HandleHandshakeCertificateRequest(const Buffer; const Size: Integer);
+    procedure HandleHandshakeServerHelloDone(const Buffer; const Size: Integer);
+    procedure HandleHandshakeFinished(const Buffer; const Size: Integer);
+    procedure HandleHandshakeMessage(const MsgType: TTLSHandshakeType; const Buffer; const Size: Integer); override;
+
+    procedure InitCipherSpecNone;
+    procedure InitCipherSpecNewFromServerHello;
+
+    procedure DoStart;
+
+  public
+    constructor Create(const ATransportLayerSendProc: TTLSConnectionTransportLayerSendProc);
+    destructor Destroy; override;
+
+    property  ClientOptions: TTLSClientOptions read FClientOptions write SetClientOptions default DefaultTLSClientOptions;
+    property  VersionOptions: TTLSVersionOptions read FVersionOptions write SetVersionOptions default DefaultTLSClientVersionOptions;
+    property  KeyExchangeOptions: TTLSKeyExchangeOptions read FKeyExchangeOptions write SetKeyExchangeOptions default DefaultTLSClientKeyExchangeOptions;
+    property  CipherOptions: TTLSCipherOptions read FCipherOptions write SetCipherOptions default DefaultTLSClientCipherOptions;
+    property  HashOptions: TTLSHashOptions read FHashOptions write SetHashOptions default DefaultTLSClientHashOptions;
+
+    property  ResumeSessionID: RawByteString read FResumeSessionID write FResumeSessionID;
+
+    // property OnValidateCertificate
+
+    property  ClientState: TTLSClientState read FClientState;
+
+    procedure Start;
+  end;
+
+
+
+implementation
+
+uses
+  { Utils }
+
+  flcHugeInt,
+  flcASN1,
+
+  { Cipher }
+
+  flcCipherUtils,
+
+  { TLS }
+
+  flcTLSErrors,
+  flcTLSCompress,
+  flcTLSCipher;
+
+
+
+{                                                                              }
+{ TLS Client                                                                   }
+{                                                                              }
+const
+  STLSClientState: array[TTLSClientState] of String = (
+    'Init',
+    'HandshakeAwaitingServerHello',
+    'HandshakeAwaitingServerHelloDone',
+    'HandshakeClientKeyExchange',
+    'Connection');
+
+constructor TTLSClient.Create(const ATransportLayerSendProc: TTLSConnectionTransportLayerSendProc);
+begin
+  inherited Create(ATransportLayerSendProc);
+end;
+
+destructor TTLSClient.Destroy;
+begin
+  if Assigned(FDHState) then
+    begin
+      DHStateFinalise(FDHState^);
+      Dispose(FDHState);
+      FDHState := nil;
+    end;
+  RSAPublicKeyFinalise(FServerRSAPublicKey);
+  SecureClearStr(FMasterSecret);
+  inherited Destroy;
+end;
+
+procedure TTLSClient.Init;
+begin
+  inherited Init;
+
+  RSAPublicKeyInit(FServerRSAPublicKey);
+
+  FClientOptions      := DefaultTLSClientOptions;
+  FVersionOptions     := DefaultTLSClientVersionOptions;
+  FKeyExchangeOptions := DefaultTLSClientKeyExchangeOptions;
+  FCipherOptions      := DefaultTLSClientCipherOptions;
+  FHashOptions        := DefaultTLSClientHashOptions;
+
+  FClientState := tlsclInit;
+end;
+
+procedure TTLSClient.SetClientState(const AState: TTLSClientState);
+begin
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'State:%s', [STLSClientState[AState]]);
+  {$ENDIF}
+
+  FClientState := AState;
+end;
+
+procedure TTLSClient.CheckNotActive;
+begin
+  if FClientState <> tlsclInit then
+    raise ETLSError.Create(TLSError_InvalidState, 'Operation not allowed while active');
+end;
+
+procedure TTLSClient.SetClientOptions(const AClientOptions: TTLSClientOptions);
+begin
+  if AClientOptions = FClientOptions then
+    exit;
+  CheckNotActive;
+  FClientOptions := AClientOptions;
+end;
+
+procedure TTLSClient.SetVersionOptions(const AVersionOptions: TTLSVersionOptions);
+begin
+  if AVersionOptions = FVersionOptions then
+    exit;
+  CheckNotActive;
+  if AVersionOptions = [] then
+    raise ETLSError.Create(TLSError_InvalidParameter, 'Invalid version options');
+  FVersionOptions := AVersionOptions;
+end;
+
+procedure TTLSClient.SetCipherOptions(const ACipherOptions: TTLSCipherOptions);
+begin
+  if ACipherOptions = FCipherOptions then
+    exit;
+  CheckNotActive;
+  if ACipherOptions = [] then
+    raise ETLSError.Create(TLSError_InvalidParameter, 'Invalid cipher options');
+  FCipherOptions := ACipherOptions;
+end;
+
+procedure TTLSClient.SetKeyExchangeOptions(const AKeyExchangeOptions: TTLSKeyExchangeOptions);
+begin
+  if AKeyExchangeOptions = FKeyExchangeOptions then
+    exit;
+  CheckNotActive;
+  if AKeyExchangeOptions = [] then
+    raise ETLSError.Create(TLSError_InvalidParameter, 'Invalid key exchange options');
+  FKeyExchangeOptions := AKeyExchangeOptions;
+end;
+
+procedure TTLSClient.SetHashOptions(const AHashOptions: TTLSHashOptions);
+begin
+  if AHashOptions = FHashOptions then
+    exit;
+  CheckNotActive;
+  if AHashOptions = [] then
+    raise ETLSError.Create(TLSError_InvalidParameter, 'Invalid hash options');
+  FHashOptions := AHashOptions;
+end;
+
+procedure TTLSClient.InitInitialProtocolVersion;
+begin
+  // set highest allowable protocol version
+  if tlsvoTLS12 in FVersionOptions then
+    InitTLSProtocolVersion12(FProtocolVersion) else
+  if tlsvoTLS11 in FVersionOptions then
+    InitTLSProtocolVersion11(FProtocolVersion) else
+  if tlsvoTLS10 in FVersionOptions then
+    InitTLSProtocolVersion10(FProtocolVersion) else
+  if tlsvoSSL3 in FVersionOptions then
+    InitSSLProtocolVersion30(FProtocolVersion)
+  else
+    raise ETLSError.Create(TLSError_InvalidParameter, 'Invalid version options');
+  FClientProtocolVersion := FProtocolVersion;
+
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'InitialProtocolVersion:%s', [TLSProtocolVersionName(FProtocolVersion)]);
+  {$ENDIF}
+end;
+
+procedure TTLSClient.InitSessionProtocolVersion;
+begin
+  FProtocolVersion := FServerProtocolVersion;
+  if IsTLS12(FProtocolVersion) and not (tlsvoTLS12 in FVersionOptions) then
+    InitTLSProtocolVersion11(FProtocolVersion);
+  if IsTLS11(FProtocolVersion) and not (tlsvoTLS11 in FVersionOptions) then
+    InitTLSProtocolVersion10(FProtocolVersion);
+  if IsTLS10(FProtocolVersion) and not (tlsvoTLS10 in FVersionOptions) then
+    InitSSLProtocolVersion30(FProtocolVersion);
+  if IsSSL3(FProtocolVersion) and not (tlsvoSSL3 in FVersionOptions) then
+    raise ETLSError.CreateAlertBadProtocolVersion; // no allowable protocol version
+
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'SessionProtocolVersion:%s', [TLSProtocolVersionName(FProtocolVersion)]);
+  {$ENDIF}
+end;
+
+procedure TTLSClient.InitClientHelloCipherSuites;
+var
+  C : TTLSCipherSuites;
+  I : TTLSCipherSuite;
+  P : PTLSCipherSuiteInfo;
+  R : Boolean;
+begin
+  C := [];
+  for I := Low(I) to High(I) do
+    begin
+      P := @TLSCipherSuiteInfo[I];
+      R := P^.ClientSupport;
+      if R then
+        if not (tlscoRC4 in FCipherOptions) then
+          if P^.Cipher in [tlscscRC4_40, tlscscRC4_56, tlscscRC4_128] then
+            R := False;
+      if R then
+        if not (tlscoDES in FCipherOptions) then
+          if P^.Cipher in [tlscscDES_CBC] then
+            R := False;
+      if R then
+        if not (tlsco3DES in FCipherOptions) then
+          if P^.Cipher in [tlscsc3DES_EDE_CBC] then
+            R := False;
+      if R then
+        if not (tlscoAES128 in FCipherOptions) then
+          if P^.Cipher in [tlscscAES_128_CBC] then
+            R := False;
+      if R then
+        if not (tlscoAES256 in FCipherOptions) then
+          if P^.Cipher in [tlscscAES_256_CBC] then
+            R := False;
+      if R then
+        if not (tlshoMD5 in FHashOptions) then
+          if P^.Hash in [tlscshMD5] then
+            R := False;
+      if R then
+        if not (tlshoSHA1 in FHashOptions) then
+          if P^.Hash in [tlscshSHA] then
+            R := False;
+      if R then
+        if not (tlshoSHA256 in FHashOptions) then
+          if P^.Hash in [tlscshSHA256] then
+            R := False;
+      if R then
+        if not (tlshoSHA384 in FHashOptions) then
+          if P^.Hash in [tlscshSHA384] then
+            R := False;
+      if R then
+        if not (tlskeoRSA in FKeyExchangeOptions) then
+          if P^.KeyExchange in [tlscskeRSA] then
+            R := False;
+      if R then
+        if not (tlskeoDH_Anon in FKeyExchangeOptions) then
+          if P^.KeyExchange in [tlscskeDH_anon] then
+            R := False;
+      if R then
+        if not (tlskeoDH_RSA in FKeyExchangeOptions) then
+          if P^.KeyExchange in [tlscskeDH_RSA] then
+            R := False;
+      if R then
+        if not (tlskeoDHE_RSA in FKeyExchangeOptions) then
+          if P^.KeyExchange in [tlscskeDHE_RSA] then
+            R := False;
+      if R then
+        if not (tlskeoECDH_RSA in FKeyExchangeOptions) then
+          if P^.KeyExchange in [tlscskeECDH_RSA] then
+            R := False;
+      if R then
+        if not (tlskeoECDHE_RSA in FKeyExchangeOptions) then
+          if P^.KeyExchange in [tlscskeECDHE_RSA] then
+            R := False;
+      if R then
+        Include(C, I);
+    end;
+  if C = [] then
+    raise ETLSError.Create(TLSError_InvalidParameter, 'No allowable cipher suite');
+  FClientHello.CipherSuites := C;
+end;
+
+procedure TTLSClient.InitDHState;
+begin
+  New(FDHState);
+  DHStateInit(FDHState^);
+  DHInitHashAlgorithm(FDHState^, dhhSHA1);
+end;
+
+procedure TTLSClient.InitHandshakeClientHello;
+begin
+  InitTLSClientHello(FClientHello,
+      FClientProtocolVersion,
+      FResumeSessionID);
+
+  {$IFDEF TLS_TEST_NO_RANDOM_HELLO}
+  FClientHello.Random.gmt_unix_time := 123;
+  FillChar(FClientHello.Random.random_bytes, 28, 117);
+  {$ENDIF}
+
+  InitClientHelloCipherSuites;
+  FClientHello.CompressionMethods := [tlscmNull];
+  FClientHelloRandomStr := TLSRandomToStr(FClientHello.Random);
+end;
+
+procedure TTLSClient.InitServerPublicKey_RSA;
+begin
+  GetCertificateRSAPublicKey(FServerX509Certs,
+      FServerRSAPublicKey);
+end;
+
+procedure TTLSClient.InitHandshakeClientKeyExchange;
+var
+  S : RawByteString;
+  PMS : TTLSPreMasterSecret;
+  DHXC : HugeWord;
+  DHYC : HugeWord;
+  DHP : HugeWord;
+  DHG : HugeWord;
+  DHYS : HugeWord;
+  ZZ : HugeWord;
+begin
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'InitHandshakeClientKeyExchange:%s', [
+      TLSKeyExchangeAlgorithmInfo[FCipherSpecNew.KeyExchangeAlgorithm].Name]);
+  {$ENDIF}
+
+  case FCipherSpecNew.KeyExchangeAlgorithm of
+    tlskeaRSA :
+      begin
+        { RFC 5246: When RSA is used for server authentication and key exchange, a 48- }
+        { byte pre_master_secret is generated by the client, encrypted under }
+        { the server's public key, and sent to the server.  The server uses its }
+        { private key to decrypt the pre_master_secret.  Both parties then }
+        { convert the pre_master_secret into the master_secret, as specified above. }
+
+        InitTLSPreMasterSecret_Random(PMS, FClientHello.ProtocolVersion);
+        FPreMasterSecretStr := TLSPreMasterSecretToStr(PMS);
+
+        InitServerPublicKey_RSA;
+
+        InitTLSEncryptedPreMasterSecret_RSA(S, PMS, FServerRSAPublicKey);
+        FClientKeyExchange.EncryptedPreMasterSecret := S;
+      end;
+    tlskeaDHE_DSS,
+    tlskeaDHE_RSA,
+    tlskeaDH_Anon :
+      begin
+        //Assert(Assigned(FDHState));
+
+        { RFC 5246: A conventional Diffie-Hellman computation is performed.  The }
+        { negotiated key (Z) is used as the pre_master_secret, and is converted }
+        { into the master_secret, as specified above.  Leading bytes of Z that }
+        { contain all zero bits are stripped before it is used as the }
+        { pre_master_secret }
+
+        InitTLSPreMasterSecret_Random(PMS, FClientHello.ProtocolVersion);
+
+        HugeWordInit(DHXC);
+        HugeWordInit(DHYC);
+        HugeWordInit(DHP);
+        HugeWordInit(DHG);
+        HugeWordInit(DHYS);
+        HugeWordInit(ZZ);
+        try
+          DHHugeWordKeyDecodeBytes(DHP, FServerKeyExchange.DHParams.dh_p);
+          DHHugeWordKeyDecodeBytes(DHG, FServerKeyExchange.DHParams.dh_g);
+          DHHugeWordKeyDecodeBytes(DHYS, FServerKeyExchange.DHParams.dh_Ys);
+
+          //HugeWordSetSize(DHXC, (SizeOf(PMS) + 3) div 4);   //// size? 384 bits in SBA. use q size.
+          //Move(PMS, DHXC.Data^, SizeOf(PMS));
+
+          repeat
+            HugeWordRandom(DHXC, HugeWordGetSize(DHP)); /////
+            if SizeOf(PMS) <= DHXC.Used * 4 then
+              Move(PMS, DHXC.Data^, SizeOf(PMS))
+            else
+              Move(PMS, DHXC.Data^, DHXC.Used * 4);
+          until HugeWordCompare(DHXC, DHP) < 0;
+
+          HugeWordPowerAndMod(DHYC, DHG, DHXC, DHP);  // yc = (g ^ xc) mod p
+
+          FClientKeyExchange.ClientDiffieHellmanPublic.PublicValueEncodingExplicit := True;
+          FClientKeyExchange.ClientDiffieHellmanPublic.dh_Yc := DHHugeWordKeyEncodeBytes(DHYC);
+
+          HugeWordPowerAndMod(ZZ, DHYs, DHXC, DHP);  // ZZ = (ys ^ xc) mod p
+
+          FPreMasterSecretStr := DHHugeWordKeyEncodeBytes(ZZ);
+        finally
+          //// Secure clear
+          HugeWordFinalise(ZZ);
+          HugeWordFinalise(DHYS);
+          HugeWordFinalise(DHG);
+          HugeWordFinalise(DHP);
+          HugeWordFinalise(DHYC);
+          HugeWordFinalise(DHXC);
+        end;
+      end;
+    tlskeaDH_DSS,
+    tlskeaDH_RSA :
+      begin
+        FClientKeyExchange.ClientDiffieHellmanPublic.PublicValueEncodingExplicit := False;
+        FClientKeyExchange.ClientDiffieHellmanPublic.dh_Yc := '';
+      end;
+  end;
+
+  case FCipherSpecNew.KeyExchangeAlgorithm of
+    tlskeaRSA,
+    tlskeaDHE_DSS,
+    tlskeaDHE_RSA,
+    tlskeaDH_Anon :
+      begin
+        Assert(FPreMasterSecretStr <> '');
+        FMasterSecret := TLSMasterSecret(FProtocolVersion, FPreMasterSecretStr,
+            FClientHelloRandomStr, FServerHelloRandomStr);
+        SecureClearStr(FPreMasterSecretStr);
+
+        GenerateTLSKeys(FProtocolVersion,
+            FCipherSpecNew.CipherSuiteDetails.HashInfo^.KeyLength,
+            FCipherSpecNew.CipherSuiteDetails.CipherInfo^.KeyBits,
+            FCipherSpecNew.CipherSuiteDetails.CipherInfo^.IVSize * 8,
+            FMasterSecret,
+            FServerHelloRandomStr,
+            FClientHelloRandomStr,
+            FKeys);
+        GenerateFinalTLSKeys(FProtocolVersion,
+            FCipherSpecNew.CipherSuiteDetails.CipherInfo^.Exportable,
+            FCipherSpecNew.CipherSuiteDetails.CipherInfo^.ExpKeyMat * 8,
+            FServerHelloRandomStr,
+            FClientHelloRandomStr,
+            FKeys);
+
+        SetEncodeKeys(FKeys.ClientMACKey, FKeys.ClientEncKey, FKeys.ClientIV);
+        SetDecodeKeys(FKeys.ServerMACKey, FKeys.ServerEncKey, FKeys.ServerIV);
+      end;
+  end;
+end;
+
+const
+  MaxHandshakeClientHelloSize       = 16384;
+  MaxHandshakeCertificateSize       = 65536;
+  MaxHandshakeClientKeyExchangeSize = 2048;
+  MaxHandshakeCertificateVerifySize = 16384;
+  MaxHandshakeFinishedSize          = 2048;
+
+procedure TTLSClient.SendHandshakeClientHello;
+var
+  Buf  : array[0..MaxHandshakeClientHelloSize - 1] of Byte;
+  Size : Integer;
+begin
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'T:Handshake:ClientHello');
+  {$ENDIF}
+
+  InitHandshakeClientHello;
+  Size := EncodeTLSHandshakeClientHello(Buf, SizeOf(Buf), FClientHello);
+  SendHandshake(Buf, Size);
+end;
+
+procedure TTLSClient.SendHandshakeCertificate;
+var
+  Buf  : array[0..MaxHandshakeCertificateSize - 1] of Byte;
+  Size : Integer;
+begin
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'T:Handshake:Certificate');
+  {$ENDIF}
+
+  Size := EncodeTLSHandshakeCertificate(Buf, SizeOf(Buf), nil);
+  SendHandshake(Buf, Size);
+end;
+
+procedure TTLSClient.SendHandshakeClientKeyExchange;
+var
+  Buf  : array[0..MaxHandshakeClientKeyExchangeSize - 1] of Byte;
+  Size : Integer;
+begin
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'T:Handshake:ClientKeyExchange');
+  {$ENDIF}
+
+  InitHandshakeClientKeyExchange;
+  Size := EncodeTLSHandshakeClientKeyExchange(
+      Buf, SizeOf(Buf),
+      FCipherSpecNew.KeyExchangeAlgorithm,
+      FClientKeyExchange);
+  SendHandshake(Buf, Size);
+end;
+
+procedure TTLSClient.SendHandshakeCertificateVerify;
+var
+  Buf  : array[0..MaxHandshakeCertificateVerifySize - 1] of Byte;
+  Size : Integer;
+begin
+  Size := EncodeTLSHandshakeCertificateVerify(Buf, SizeOf(Buf));
+  SendHandshake(Buf, Size);
+end;
+
+procedure TTLSClient.SendHandshakeFinished;
+var
+  Buf  : array[0..MaxHandshakeFinishedSize - 1] of Byte;
+  Size : Integer;
+begin
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'T:Handshake:Finished:%s', [TLSProtocolVersionName(FProtocolVersion)]);
+  {$ENDIF}
+
+  Size := EncodeTLSHandshakeFinished(Buf, SizeOf(Buf), FMasterSecret, FProtocolVersion, FVerifyHandshakeData, True);
+  SendHandshake(Buf, Size);
+end;
+
+procedure TTLSClient.HandleHandshakeHelloRequest(const Buffer; const Size: Integer);
+begin
+  if IsNegotiatingState then
+    exit; // ignore while negotiating
+  if FConnectionState = tlscoApplicationData then
+    SendAlert(tlsalWarning, tlsadNo_renegotiation); // client does not support renegotiation, notify server
+end;
+
+procedure TTLSClient.HandleHandshakeServerHello(const Buffer; const Size: Integer);
+begin
+  if not (FClientState in [tlsclHandshakeAwaitingServerHello]) or
+     not (FConnectionState in [tlscoStart, tlscoHandshaking]) then
+    raise ETLSError.CreateAlertUnexpectedMessage;
+
+  DecodeTLSServerHello(Buffer, Size, FServerHello);
+  FServerProtocolVersion := FServerHello.ProtocolVersion;
+
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'ServerProtocolVersion:%s', [TLSProtocolVersionName(FServerProtocolVersion)]);
+  {$ENDIF}
+
+  FServerHelloRandomStr := TLSRandomToStr(FServerHello.Random);
+  if not IsTLSProtocolVersion(FServerProtocolVersion, FProtocolVersion) then // different protocol version
+    begin
+      if IsPostTLS12(FServerProtocolVersion) then
+        raise ETLSError.CreateAlert(TLSError_BadProtocol, tlsadProtocol_version); // unsupported future version of TLS
+      if not IsKnownTLSVersion(FServerProtocolVersion) then
+        raise ETLSError.CreateAlert(TLSError_BadProtocol, tlsadProtocol_version); // unknown past TLS version
+    end;
+  InitSessionProtocolVersion;
+  InitCipherSpecNewFromServerHello;
+  SetClientState(tlsclHandshakeAwaitingServerHelloDone);
+end;
+
+procedure TTLSClient.HandleHandshakeCertificate(const Buffer; const Size: Integer);
+begin
+  if FClientState <> tlsclHandshakeAwaitingServerHelloDone then
+    raise ETLSError.CreateAlertUnexpectedMessage;
+
+  DecodeTLSCertificate(Buffer, Size, FServerCertificateList);
+  ParseX509Certificates(FServerCertificateList, FServerX509Certs);
+
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'R:Handshake:Certificate:Count=%d', [Length(FServerX509Certs)]);
+  {$ENDIF}
+end;
+
+procedure TTLSClient.HandleHandshakeServerKeyExchange(const Buffer; const Size: Integer);
+//var
+//  R : HugeWord;
+begin
+  if FClientState <> tlsclHandshakeAwaitingServerHelloDone then
+    raise ETLSError.CreateAlertUnexpectedMessage;
+
+  DecodeTLSServerKeyExchange(Buffer, Size, FCipherSpecNew.KeyExchangeAlgorithm,
+      FServerKeyExchange);
+
+  case FCipherSpecNew.KeyExchangeAlgorithm of
+    tlskeaDHE_DSS,
+    tlskeaDHE_RSA,
+    tlskeaDH_Anon :
+      begin
+        {
+        //// Validate
+        //DHHugeWordKeyDecodeBytes(DHP, FServerKeyExchange.DHParams.dh_p);
+        //DHHugeWordKeyDecodeBytes(DHG, FServerKeyExchange.DHParams.dh_g);
+        //DHHugeWordKeyDecodeBytes(DHYS, FServerKeyExchange.DHParams.dh_Ys);
+
+        InitDHState;
+        DHHugeWordKeyDecodeBytes(FDHState^.P, FServerKeyExchange.DHParams.dh_p);
+        DHHugeWordKeyDecodeBytes(FDHState^.G, FServerKeyExchange.DHParams.dh_g);
+        FDHState^.PrimePBitCount := HugeWordGetSizeInBits(FDHState^.P);
+        FDHState^.PrimeQBitCount := DHQBitCount(FDHState^.PrimePBitCount);
+
+        DHDeriveKeysFromGroupParametersPG(FDHState^, dhhSHA1,
+            FDHState^.PrimeQBitCount,
+            FDHState^.PrimePBitCount,
+            FDHState^.P,
+            FDHState^.G);
+
+        HugeWordInit(R);
+        DHHugeWordKeyDecodeBytes(R, FServerKeyExchange.DHParams.dh_Ys);
+
+        DHGenerateSharedSecretZZ(FDHState^, HugeWordGetSizeInBits(R), R);
+        HugeWordFinalise(R);
+        }
+
+        if FCipherSpecNew.KeyExchangeAlgorithm = tlskeaDHE_RSA then
+          begin
+            InitServerPublicKey_RSA;
+            if not VerifyTLSServerKeyExchangeDH_RSA(FServerKeyExchange,
+                      PTLSClientServerRandom(@FClientHello.Random)^,
+                      PTLSClientServerRandom(@FServerHello.Random)^,
+                      FServerRSAPublicKey) then
+              raise ETLSError.CreateAlert(TLSError_BadProtocol, tlsadHandshake_failure);
+          end;
+      end;
+  end;
+end;
+
+procedure TTLSClient.HandleHandshakeCertificateRequest(const Buffer; const Size: Integer);
+begin
+  if FClientState <> tlsclHandshakeAwaitingServerHelloDone then
+    raise ETLSError.CreateAlertUnexpectedMessage;
+
+  DecodeTLSCertificateRequest(Buffer, Size, FCertificateRequest);
+  FCertificateRequested := True;
+end;
+
+procedure TTLSClient.HandleHandshakeServerHelloDone(const Buffer; const Size: Integer);
+begin
+  if FClientState <> tlsclHandshakeAwaitingServerHelloDone then
+    raise ETLSError.CreateAlertUnexpectedMessage;
+
+  SetClientState(tlsclHandshakeClientKeyExchange);
+  if FCertificateRequested then
+    SendHandshakeCertificate;
+  SendHandshakeClientKeyExchange;
+  // TODO SendHandshakeCertificateVerify;
+  SendChangeCipherSpec;
+  ChangeEncryptCipherSpec;
+  SendHandshakeFinished;
+end;
+
+procedure TTLSClient.HandleHandshakeFinished(const Buffer; const Size: Integer);
+begin
+  if FClientState <> tlsclHandshakeClientKeyExchange then
+    raise ETLSError.CreateAlertUnexpectedMessage;
+
+  SetClientState(tlsclConnection);
+  SetConnectionState(tlscoApplicationData);
+  TriggerHandshakeFinished;
+end;
+
+procedure TTLSClient.HandleHandshakeMessage(const MsgType: TTLSHandshakeType; const Buffer; const Size: Integer);
+begin
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'R:Handshake:%s:%db', [TLSHandshakeTypeToStr(MsgType), Size]);
+  {$ENDIF}
+
+  case MsgType of
+    tlshtHello_request       : HandleHandshakeHelloRequest(Buffer, Size);
+    tlshtClient_hello        : ShutdownBadProtocol(tlsadUnexpected_message);
+    tlshtServer_hello        : HandleHandshakeServerHello(Buffer, Size);
+    tlshtCertificate         : HandleHandshakeCertificate(Buffer, Size);
+    tlshtServer_key_exchange : HandleHandshakeServerKeyExchange(Buffer, Size);
+    tlshtCertificate_request : HandleHandshakeCertificateRequest(Buffer, Size);
+    tlshtServer_hello_done   : HandleHandshakeServerHelloDone(Buffer, Size);
+    tlshtCertificate_verify  : ShutdownBadProtocol(tlsadUnexpected_message);
+    tlshtClient_key_exchange : ShutdownBadProtocol(tlsadUnexpected_message);
+    tlshtFinished            : HandleHandshakeFinished(Buffer, Size);
+  else
+    ShutdownBadProtocol(tlsadUnexpected_message);
+  end;
+end;
+
+procedure TTLSClient.InitCipherSpecNone;
+begin
+  InitTLSSecurityParametersNone(FCipherEncryptSpec);
+  InitTLSSecurityParametersNone(FCipherDecryptSpec);
+  TLSCipherInitNone(FCipherEncryptState, tlscoEncrypt);
+  TLSCipherInitNone(FCipherDecryptState, tlscoDecrypt);
+end;
+
+procedure TTLSClient.InitCipherSpecNewFromServerHello;
+begin
+  InitTLSSecurityParameters(
+      FCipherSpecNew,
+      FServerHello.CompressionMethod,
+      GetCipherSuiteByRec(FServerHello.CipherSuite.B1, FServerHello.CipherSuite.B2));
+
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'CipherSpec:%s', [FCipherSpecNew.CipherSuiteDetails.CipherSuiteInfo^.Name]);
+  {$ENDIF}
+end;
+
+procedure TTLSClient.DoStart;
+begin
+  SetConnectionState(tlscoStart);
+  InitInitialProtocolVersion;
+  InitCipherSpecNone;
+  SetConnectionState(tlscoHandshaking);
+  SetClientState(tlsclHandshakeAwaitingServerHello);
+  SendHandshakeClientHello;
+end;
+
+procedure TTLSClient.Start;
+begin
+  Assert(FConnectionState = tlscoInit);
+  Assert(FClientState = tlsclInit);
+  DoStart;
+end;
+
+
+
+end.
+

contrib/fundamentals/TLS/flcTLSTransportConnection.pas

@@ -0,0 +1,861 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSTransportConnection.pas                            }
+{   File version:     5.06                                                     }
+{   Description:      TLS Transport Connection                                 }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2008/01/18  0.01  Initial development.                                     }
+{   2010/11/26  0.02  Protocol messages.                                       }
+{   2010/11/30  0.03  Encrypted messages.                                      }
+{   2010/12/03  0.04  Revision.                                                }
+{   2011/06/18  0.05  Allow multiple handshakes in a record.                   }
+{   2018/07/17  5.06  Revised for Fundamentals 5.                              }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSTransportConnection;
+
+interface
+
+uses
+  { Utils }
+
+  flcStdTypes,
+
+  { TLS }
+
+  flcTLSErrors,
+  flcTLSProtocolVersion,
+  flcTLSAlgorithmTypes,
+  flcTLSPRF,
+  flcTLSCipherSuite,
+  flcTLSCipher,
+  flcTLSRecord,
+  flcTLSAlert,
+  flcTLSHandshake,
+  flcTLSBuffer,
+  flcTLSKeys,
+  flcTLSTransportTypes;
+
+
+
+{                                                                              }
+{ TLS security parameters                                                      }
+{                                                                              }
+type
+  TTLSSecurityParameters = record
+    PrfAlgorithm                : TTLSPRFAlgorithm;
+    CipherSuite                 : TTLSCipherSuite;
+    CipherSuiteDetails          : TTLSCipherSuiteDetails;
+    CipherSuiteCipherCipherInfo : PTLSCipherSuiteCipherCipherInfo;
+    Compression                 : TTLSCompressionMethod;
+    KeyExchangeAlgorithm        : TTLSKeyExchangeAlgorithm;
+    KeyExchangeAlgorithmInfo    : PTLSKeyExchangeAlgorithmInfo;
+  end;
+  PTLSSecurityParameters = ^TTLSSecurityParameters;
+
+procedure InitTLSSecurityParameters(var A: TTLSSecurityParameters;
+          const CompressionMethod: TTLSCompressionMethod;
+          const CipherSuite: TTLSCipherSuite);
+procedure InitTLSSecurityParametersNone(var A: TTLSSecurityParameters);
+procedure InitTLSSecurityParametersNULL(var A: TTLSSecurityParameters);
+
+
+
+{                                                                              }
+{ TLS connection                                                               }
+{                                                                              }
+type
+  TTLSConnection = class;
+
+  TTLSConnectionTransportLayerSendProc =
+    procedure (const Sender: TTLSConnection; const Buffer; const Size: Integer) of object;
+
+  TTLSConnectionState = (
+      tlscoInit,
+      tlscoStart,
+      tlscoHandshaking,
+      tlscoApplicationData,
+      tlscoErrorBadProtocol,
+      tlscoCancelled,
+      tlscoClosed
+    );
+
+  TTLSConnectionLogEvent = procedure (Sender: TTLSConnection; LogType: TTLSLogType; LogMsg: String; LogLevel: Integer) of object;
+  TTLSConnectionStateChangeEvent = procedure (Sender: TTLSConnection; State: TTLSConnectionState) of object;
+  TTLSConnectionAlertEvent = procedure (Sender: TTLSConnection; Level: TTLSAlertLevel; Description: TTLSAlertDescription) of object;
+  TTLSConnectionNotifyEvent = procedure (Sender: TTLSConnection) of object;
+
+  TTLSConnection = class
+  protected
+    FTransportLayerSendProc : TTLSConnectionTransportLayerSendProc;
+    FOnLog                  : TTLSConnectionLogEvent;
+    FOnStateChange          : TTLSConnectionStateChangeEvent;
+    FOnAlert                : TTLSConnectionAlertEvent;
+    FOnHandshakeFinished    : TTLSConnectionNotifyEvent;
+    FConnectionState        : TTLSConnectionState;
+    FConnectionErrorMessage : String;
+    FInBuf                  : TTLSBuffer;
+    FOutBuf                 : TTLSBuffer;
+    FProtocolVersion        : TTLSProtocolVersion;
+    FReadSeqNo              : Int64;
+    FWriteSeqNo             : Int64;
+    FKeys                   : TTLSKeys;
+    FEncMACKey              : RawByteString;
+    FEncCipherKey           : RawByteString;
+    FEncIV                  : RawByteString;
+    FDecMACKey              : RawByteString;
+    FDecCipherKey           : RawByteString;
+    FDecIV                  : RawByteString;
+    FVerifyHandshakeData    : RawByteString;
+    FCipherEncryptSpec      : TTLSSecurityParameters;
+    FCipherEncryptState     : TTLSCipherState;
+    FCipherDecryptSpec      : TTLSSecurityParameters;
+    FCipherDecryptState     : TTLSCipherState;
+    FCipherSpecNew          : TTLSSecurityParameters;
+
+    procedure Init; virtual;
+
+    procedure Log(const LogType: TTLSLogType; const LogMsg: String; const LogLevel: Integer = 0); overload;
+    procedure Log(const LogType: TTLSLogType; const LogMsg: String; const LogArgs: array of const; const LogLevel: Integer = 0); overload;
+
+    procedure TriggerLog(const LogType: TTLSLogType; const LogMsg: String; const LogLevel: Integer); virtual;
+    procedure TriggerConnectionStateChange; virtual;
+    procedure TriggerAlert(const Level: TTLSAlertLevel; const Description: TTLSAlertDescription); virtual;
+    procedure TriggerHandshakeFinished; virtual;
+
+    procedure SetConnectionState(const State: TTLSConnectionState);
+    procedure SetClosed;
+    procedure SetErrorBadProtocol;
+
+    procedure SetEncodeKeys(const MACKey, CipherKey, IV: RawByteString);
+    procedure SetDecodeKeys(const MACKey, CipherKey, IV: RawByteString);
+
+    procedure TransportLayerSend(const Buffer; const Size: Integer);
+    procedure SendContent(const ContentType: TTLSContentType; const Buffer; const Size: Integer);
+
+    procedure SendAlert(const Level: TTLSAlertLevel; const Description: TTLSAlertDescription);
+    procedure SendAlertCloseNotify;
+    procedure SendAlertUnexpectedMessage;
+    procedure SendAlertIllegalParameter;
+    procedure SendAlertDecodeError;
+    procedure SendAlertProtocolVersion;
+    procedure SendAlertInternalError;
+
+    procedure SendApplicationData(const Buffer; const Size: Integer);
+    procedure SendChangeCipherSpec;
+    procedure SendHandshake(const Buf; const Size: Integer);
+
+    procedure ShutdownBadProtocol(const AlertDescription: TTLSAlertDescription);
+    procedure AddVerifyHandshakeData(const Buffer; const Size: Integer);
+    procedure DoClose;
+    
+    procedure ChangeEncryptCipherSpec; 
+    procedure ChangeDecryptCipherSpec;
+
+    procedure HandleAlertCloseNotify;
+    procedure HandleAlertProtocolVersion;
+    procedure HandleAlertProtocolFailure(const Alert: TTLSAlert);
+    procedure HandleAlertCertificateError(const Alert: TTLSAlert);
+    procedure HandleAlertSecurityError(const Alert: TTLSAlert);
+    procedure HandleAlertUserCancelled;
+    procedure HandleAlertNoRenegotiation;
+    procedure HandleAlertUnknown(const Alert: TTLSAlert);
+    procedure HandleProtocolAlert(const Buffer; const Size: Integer);
+
+    procedure HandleProtocolChangeCipherSpec(const Buffer; const Size: Integer);
+    procedure HandleProtocolApplicationData(const Buffer; const Size: Integer);
+
+    procedure HandleHandshakeMessage(const MsgType: TTLSHandshakeType; const Buffer; const Size: Integer); virtual; abstract;
+    procedure HandleProtocolHandshake(const Buffer; const Size: Integer);
+
+    procedure ProcessTransportLayerData;
+
+  public
+    constructor Create(const ATransportLayerSendProc: TTLSConnectionTransportLayerSendProc);
+    destructor Destroy; override;
+
+    property  OnLog: TTLSConnectionLogEvent read FOnLog write FOnLog;
+    property  OnStateChange: TTLSConnectionStateChangeEvent read FOnStateChange write FOnStateChange;
+    property  OnAlert: TTLSConnectionAlertEvent read FOnAlert write FOnAlert;
+    property  OnHandshakeFinished: TTLSConnectionNotifyEvent read FOnHandshakeFinished write FOnHandshakeFinished;
+
+    property  ConnectionState: TTLSConnectionState read FConnectionState;
+    property  ConnectionErrorMessage: String read FConnectionErrorMessage;
+
+    function  IsNegotiatingState: Boolean;
+    function  IsReadyState: Boolean;
+    function  IsFinishedState: Boolean;
+
+    procedure ProcessTransportLayerReceivedData(const Buffer; const Size: Integer);
+
+    function  AvailableToRead: Integer;
+    function  Read(var Buffer; const Size: Integer): Integer;
+    procedure Write(const Buffer; const Size: Integer);
+    procedure Close;
+  end;
+
+
+
+implementation
+
+uses
+  { System }
+
+  SysUtils,
+
+  { Cipher }
+
+  flcCipherUtils,
+
+  { TLS }
+
+  flcTLSConsts;
+
+
+
+{                                                                              }
+{ Security Parameters                                                          }
+{                                                                              }
+procedure InitTLSSecurityParameters(var A: TTLSSecurityParameters;
+          const CompressionMethod: TTLSCompressionMethod;
+          const CipherSuite: TTLSCipherSuite);
+var C : PTLSCipherSuiteInfo;
+begin
+  C := @TLSCipherSuiteInfo[CipherSuite];
+  A.Compression := CompressionMethod;
+  A.CipherSuite := CipherSuite;
+  InitTLSCipherSuiteDetails(A.CipherSuiteDetails, CipherSuite);
+  A.KeyExchangeAlgorithm := TLSCipherSuiteKeyExchangeInfo[C^.KeyExchange].Algorithm;
+  A.KeyExchangeAlgorithmInfo := @TLSKeyExchangeAlgorithmInfo[A.KeyExchangeAlgorithm];
+end;
+
+procedure InitTLSSecurityParametersNone(var A: TTLSSecurityParameters);
+begin
+  InitTLSSecurityParameters(A, tlscmNull, tlscsNone);
+end;
+
+procedure InitTLSSecurityParametersNULL(var A: TTLSSecurityParameters);
+begin
+  InitTLSSecurityParameters(A, tlscmNull, tlscsNULL_WITH_NULL_NULL);
+end;
+
+
+
+{                                                                              }
+{ TLS connection                                                               }
+{                                                                              }
+constructor TTLSConnection.Create(const ATransportLayerSendProc: TTLSConnectionTransportLayerSendProc);
+begin
+  inherited Create;
+  Init;
+  if not Assigned(ATransportLayerSendProc) then
+    raise ETLSError.Create(TLSError_InvalidParameter);
+  FTransportLayerSendProc := ATransportLayerSendProc;
+end;
+
+procedure TTLSConnection.Init;
+begin
+  FConnectionState := tlscoInit;
+  TLSBufferInitialise(FInBuf);
+  TLSBufferInitialise(FOutBuf);
+end;
+
+destructor TTLSConnection.Destroy;
+begin
+  SecureClearStr(FEncMACKey);
+  SecureClearStr(FEncCipherKey);
+  SecureClearStr(FEncIV);
+  SecureClearStr(FDecMACKey);
+  SecureClearStr(FDecCipherKey);
+  SecureClearStr(FDecIV);
+  SecureClearStr(FVerifyHandshakeData);
+  TLSBufferFinalise(FOutBuf);
+  TLSBufferFinalise(FInBuf);
+  inherited Destroy;
+end;
+
+procedure TTLSConnection.Log(const LogType: TTLSLogType; const LogMsg: String; const LogLevel: Integer);
+begin
+  TriggerLog(LogType, LogMsg, LogLevel);
+end;
+
+procedure TTLSConnection.Log(const LogType: TTLSLogType; const LogMsg: String; const LogArgs: array of const; const LogLevel: Integer);
+begin
+  Log(LogType, Format(LogMsg, LogArgs), LogLevel);
+end;
+
+procedure TTLSConnection.TriggerLog(const LogType: TTLSLogType; const LogMsg: String; const LogLevel: Integer);
+begin
+  if Assigned(FOnLog) then
+    FOnLog(self, LogType, LogMsg, LogLevel);
+end;
+
+procedure TTLSConnection.TriggerConnectionStateChange;
+begin
+  if Assigned(FOnStateChange) then
+    FOnStateChange(self, FConnectionState);
+end;
+
+procedure TTLSConnection.TriggerAlert(const Level: TTLSAlertLevel; const Description: TTLSAlertDescription);
+begin
+  if Assigned(FOnAlert) then
+    FOnAlert(self, Level, Description);
+end;
+
+procedure TTLSConnection.TriggerHandshakeFinished;
+begin
+  if Assigned(FOnHandshakeFinished) then
+    FOnHandshakeFinished(self);
+end;
+
+const
+  TLSConnectionStateStr : array[TTLSConnectionState] of String = (
+    'Init',
+    'Start',
+    'Handshaking',
+    'ApplicationData',
+    'ErrorBadProtocol',
+    'Cancelled',
+    'Closed');
+
+procedure TTLSConnection.SetConnectionState(const State: TTLSConnectionState);
+begin
+  FConnectionState := State;
+
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'ConnectionState:%s', [TLSConnectionStateStr[State]]);
+  {$ENDIF}
+
+  TriggerConnectionStateChange;
+end;
+
+procedure TTLSConnection.SetClosed;
+begin
+  SetConnectionState(tlscoClosed);
+end;
+
+procedure TTLSConnection.SetErrorBadProtocol;
+begin
+  SetConnectionState(tlscoErrorBadProtocol);
+end;
+
+function TTLSConnection.IsNegotiatingState: Boolean;
+begin
+  Result := FConnectionState in [
+      tlscoStart,
+      tlscoHandshaking];
+end;
+
+function TTLSConnection.IsReadyState: Boolean;
+begin
+  Result := FConnectionState = tlscoApplicationData;
+end;
+
+function TTLSConnection.IsFinishedState: Boolean;
+begin
+  Result := FConnectionState in [
+      tlscoErrorBadProtocol,
+      tlscoCancelled,
+      tlscoClosed];
+end;
+
+procedure TTLSConnection.SetEncodeKeys(const MACKey, CipherKey, IV: RawByteString);
+begin
+  FEncMACKey := MACKey;
+  FEncCipherKey := CipherKey;
+  FEncIV := IV;
+end;
+
+procedure TTLSConnection.SetDecodeKeys(const MACKey, CipherKey, IV: RawByteString);
+begin
+  FDecMACKey := MACKey;
+  FDecCipherKey := CipherKey;
+  FDecIV := IV;
+end;
+
+procedure TTLSConnection.TransportLayerSend(const Buffer; const Size: Integer);
+begin
+  Assert(Assigned(FTransportLayerSendProc));
+  Assert(Assigned(@Buffer));
+  Assert(Size >= 0);
+
+  FTransportLayerSendProc(self, Buffer, Size);
+end;
+
+const
+  TLS_CLIENT_RECORDBUF_MAXSIZE = TLS_PLAINTEXT_FRAGMENT_MAXSIZE * 2;
+
+procedure TTLSConnection.SendContent(
+          const ContentType: TTLSContentType;
+          const Buffer; const Size: Integer);
+var P : PByte;
+    L : Integer;
+    BufMsg : array[0..TLS_CLIENT_RECORDBUF_MAXSIZE - 1] of Byte;
+    M, RecSize : Integer;
+begin
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'T:%s:%db', [TLSContentTypeToStr(ContentType), Size]);
+  {$ENDIF}
+
+  P := @Buffer;
+  L := Size;
+  while L > 0 do
+    begin
+      M := L;
+      if M > TLS_PLAINTEXT_FRAGMENT_MAXSIZE then
+        M := TLS_PLAINTEXT_FRAGMENT_MAXSIZE;
+
+      RecSize := EncodeTLSRecord(
+          BufMsg, SizeOf(BufMsg),
+          FProtocolVersion,
+          ContentType,
+          P^, M,
+          FCipherEncryptSpec.Compression,
+          FCipherEncryptSpec.CipherSuiteDetails,
+          FWriteSeqNo,
+          Pointer(FEncMACKey)^, Length(FEncMACKey),
+          FCipherEncryptState,
+          Pointer(FEncIV), Length(FEncIV));
+
+      Inc(FWriteSeqNo);
+      TransportLayerSend(BufMsg, RecSize);
+
+      Dec(L, M);
+      Inc(P, M);
+    end;
+end;
+
+procedure TTLSConnection.SendAlert(const Level: TTLSAlertLevel; const Description: TTLSAlertDescription);
+var B : TTLSAlert;
+begin
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'T:Alert:%s:%s', [TLSAlertLevelToStr(Level), TLSAlertDescriptionToStr(Description)]);
+  {$ENDIF}
+
+  InitTLSAlert(B, Level, Description);
+  SendContent(tlsctAlert, B, TLSAlertSize);
+
+  if Level = tlsalFatal then
+    FConnectionErrorMessage :=
+        TLSAlertLevelToStr(Level) + ':' +
+        TLSAlertDescriptionToStr(Description);
+end;
+
+procedure TTLSConnection.SendAlertCloseNotify;
+begin
+  SendAlert(tlsalWarning, tlsadClose_notify);
+end;
+
+procedure TTLSConnection.SendAlertUnexpectedMessage;
+begin
+  SendAlert(tlsalFatal, tlsadUnexpected_message);
+end;
+
+procedure TTLSConnection.SendAlertIllegalParameter;
+begin
+  SendAlert(tlsalFatal, tlsadIllegal_parameter);
+end;
+
+procedure TTLSConnection.SendAlertDecodeError;
+begin
+  SendAlert(tlsalFatal, tlsadDecode_error);
+end;
+
+procedure TTLSConnection.SendAlertProtocolVersion;
+begin
+  SendAlert(tlsalFatal, tlsadDecode_error);
+end;
+
+procedure TTLSConnection.SendAlertInternalError;
+begin
+  SendAlert(tlsalFatal, tlsadInternal_error);
+end;
+
+procedure TTLSConnection.SendApplicationData(const Buffer; const Size: Integer);
+begin
+  Assert(FConnectionState = tlscoApplicationData);
+  SendContent(tlsctApplication_data, Buffer, Size);
+end;
+
+procedure TTLSConnection.SendHandshake(const Buf; const Size: Integer);
+begin
+  SendContent(tlsctHandshake, Buf, Size);
+  AddVerifyHandshakeData(Buf, Size);
+end;
+
+procedure TTLSConnection.SendChangeCipherSpec;
+var B : TTLSChangeCipherSpec;
+begin
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'T:ChangeCipherSpec');
+  {$ENDIF}
+
+  InitTLSChangeCipherSpec(B);
+  SendContent(tlsctChange_cipher_spec, B, TLSChangeCipherSpecSize);
+end;
+
+procedure TTLSConnection.ShutdownBadProtocol(const AlertDescription: TTLSAlertDescription);
+begin
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'ShutdownBadProtocol:%s', [TLSAlertDescriptionToStr(AlertDescription)]);
+  {$ENDIF}
+
+  SendAlert(tlsalFatal, AlertDescription);
+  SetErrorBadProtocol;
+end;
+
+procedure TTLSConnection.AddVerifyHandshakeData(const Buffer; const Size: Integer);
+var S : RawByteString;
+begin
+  Assert(Size > 0);
+  SetLength(S, Size);
+  Move(Buffer, S[1], Size);
+  FVerifyHandshakeData := FVerifyHandshakeData + S;
+end;
+
+procedure TTLSConnection.DoClose;
+begin
+  if FConnectionState = tlscoApplicationData then
+    SendAlertCloseNotify;
+  SetClosed;
+end;
+
+procedure TTLSConnection.ChangeEncryptCipherSpec;
+begin
+  FCipherEncryptSpec := FCipherSpecNew;
+
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'EncryptCipherSpec:%s', [FCipherEncryptSpec.CipherSuiteDetails.CipherSuiteInfo^.Name]);
+  {$ENDIF}
+
+  FWriteSeqNo := 0;
+  TLSCipherFinalise(FCipherEncryptState);
+  TLSCipherInit(
+      FCipherEncryptState,
+      tlscoEncrypt,
+      FCipherEncryptSpec.CipherSuiteDetails.CipherSuiteInfo^.Cipher,
+      FEncCipherKey[1], Length(FEncCipherKey));
+end;
+
+procedure TTLSConnection.ChangeDecryptCipherSpec;
+begin
+  FCipherDecryptSpec := FCipherSpecNew;
+
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'DecryptCipherSpec:%s', [
+                  FCipherDecryptSpec.CipherSuiteDetails.CipherSuiteInfo^.Name]);
+  {$ENDIF}
+
+  FReadSeqNo := 0;
+  TLSCipherFinalise(FCipherDecryptState);
+  TLSCipherInit(
+      FCipherDecryptState,
+      tlscoDecrypt,
+      FCipherDecryptSpec.CipherSuiteDetails.CipherSuiteInfo^.Cipher,
+      FDecCipherKey[1], Length(FDecCipherKey));
+end;
+
+procedure TTLSConnection.HandleAlertCloseNotify;
+begin
+  SetClosed;
+end;
+
+procedure TTLSConnection.HandleAlertProtocolVersion;
+begin
+  SetErrorBadProtocol;
+end;
+
+procedure TTLSConnection.HandleAlertProtocolFailure(const Alert: TTLSAlert);
+begin
+  SetErrorBadProtocol;
+end;
+
+procedure TTLSConnection.HandleAlertCertificateError(const Alert: TTLSAlert);
+begin
+  SetErrorBadProtocol;
+end;
+
+procedure TTLSConnection.HandleAlertSecurityError(const Alert: TTLSAlert);
+begin
+  SetErrorBadProtocol;
+end;
+
+procedure TTLSConnection.HandleAlertUserCancelled;
+begin
+  SetConnectionState(tlscoCancelled);
+end;
+
+procedure TTLSConnection.HandleAlertNoRenegotiation;
+begin
+  SetErrorBadProtocol;
+end;
+
+procedure TTLSConnection.HandleAlertUnknown(const Alert: TTLSAlert);
+begin
+  if Alert.level = tlsalFatal then
+    SetErrorBadProtocol;
+end;
+
+procedure TTLSConnection.HandleProtocolAlert(const Buffer; const Size: Integer);
+var Alert : PTLSAlert;
+begin
+  Alert := @Buffer;
+
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'R:Alert:%s:%s', [TLSAlertLevelToStr(Alert^.level),
+                                    TLSAlertDescriptionToStr(Alert^.description)]);
+  {$ENDIF}
+
+  if Alert^.level = tlsalFatal then
+    FConnectionErrorMessage :=
+        TLSAlertLevelToStr(Alert^.level) + ':' +
+        TLSAlertDescriptionToStr(Alert^.description);
+
+  case Alert^.description of
+    tlsadClose_notify            : HandleAlertCloseNotify;
+    tlsadProtocol_version        : HandleAlertProtocolVersion;
+    tlsadUnexpected_message,
+    tlsadBad_record_mac,
+    tlsadDecryption_failed,
+    tlsadRecord_overflow,
+    tlsadDecompression_failure,
+    tlsadHandshake_failure,
+    tlsadInternal_error,
+    tlsadIllegal_parameter,
+    tlsadDecode_error,
+    tlsadDecrypt_error,
+    tlsadUnsupported_extention   : HandleAlertProtocolFailure(Alert^);
+    tlsadNo_certificate,
+    tlsadBad_certificate,
+    tlsadUnsupported_certificate,
+    tlsadCertificate_revoked,
+    tlsadCertificate_expired,
+    tlsadCertificate_unknown,
+    tlsadUnknown_ca              : HandleAlertCertificateError(Alert^);
+    tlsadAccess_denied,
+    tlsadExport_restriction,
+    tlsadInsufficient_security   : HandleAlertSecurityError(Alert^);
+    tlsadUser_canceled           : HandleAlertUserCancelled;
+    tlsadNo_renegotiation        : HandleAlertNoRenegotiation;
+    /////
+  else
+    HandleAlertUnknown(Alert^);
+  end;
+
+  TriggerAlert(Alert^.level, Alert^.description);
+end;
+
+procedure TTLSConnection.HandleProtocolChangeCipherSpec(const Buffer; const Size: Integer);
+begin
+  {$IFDEF TLS_DEBUG}
+  Log(tlsltDebug, 'R:ChangeCipherSpec');
+  {$ENDIF}
+
+  ChangeDecryptCipherSpec;
+end;
+
+procedure TTLSConnection.HandleProtocolApplicationData(const Buffer; const Size: Integer);
+begin
+  TLSBufferAddBuf(FOutBuf, Buffer, Size);
+end;
+
+procedure TTLSConnection.HandleProtocolHandshake(const Buffer; const Size: Integer);
+var P : PByte;
+    N : Integer;
+    MsgType : TTLSHandshakeType;
+    Len : Integer;
+begin
+  try
+    P := @Buffer;
+    N := Size;
+    repeat
+      DecodeTLSHandshakeHeader(PTLSHandshakeHeader(P)^, MsgType, Len);
+      if MsgType <> tlshtHello_request then
+        AddVerifyHandshakeData(P^, TLSHandshakeHeaderSize + Len);
+      Inc(P, TLSHandshakeHeaderSize);
+      Dec(N, TLSHandshakeHeaderSize);
+
+      {$IFDEF TLS_DEBUG}
+      Log(tlsltDebug, 'R:Handshake:[%s]:%db', [TLSHandshakeTypeToStr(MsgType), Len]);
+      {$ENDIF}
+
+      HandleHandshakeMessage(MsgType, P^, Len);
+      Inc(P, Len);
+      Dec(N, Len);
+    until N <= 0;
+  except
+    on E : ETLSError do
+      ShutdownBadProtocol(E.AlertDescription)
+    else
+      ShutdownBadProtocol(tlsadHandshake_failure);
+  end;
+end;
+
+procedure TTLSConnection.ProcessTransportLayerData;
+var P, Q            : PByte;
+    RecHeader       : PTLSRecordHeader;
+    ContentType     : TTLSContentType;
+    ProtocolVersion : TTLSProtocolVersion;
+    RecLength       : Word;
+    PlainSize       : Integer;
+    PlainBuf        : array[0..TLS_CLIENT_RECORDBUF_MAXSIZE - 1] of Byte;
+begin
+  while TLSBufferUsed(FInBuf) >= TLSRecordHeaderSize do
+    begin
+      P := TLSBufferPtr(FInBuf);
+
+      // decode header
+      RecHeader := PTLSRecordHeader(P);
+      DecodeTLSRecordHeader(RecHeader^, ContentType, ProtocolVersion, RecLength);
+
+      // validate header
+      if not (ContentType in [
+          tlsctHandshake,
+          tlsctAlert,
+          tlsctApplication_data,
+          tlsctChange_cipher_spec]) then
+        ShutdownBadProtocol(tlsadUnexpected_message);
+
+      // wait for complete record
+      if TLSBufferUsed(FInBuf) < TLSRecordHeaderSize + RecLength then
+        exit;
+
+      // record received
+      {$IFDEF TLS_DEBUG}
+      Log(tlsltDebug, 'R:Record:[%s]:%db', [TLSContentTypeToStr(ContentType), RecLength]);
+      {$ENDIF}
+
+      try
+        Inc(P, TLSRecordHeaderSize);
+        DecodeTLSRecord(
+           RecHeader,
+           P^, RecLength,
+           FProtocolVersion,
+           FCipherDecryptSpec.Compression,
+           FCipherDecryptSpec.CipherSuiteDetails,
+           FReadSeqNo,
+           Pointer(FDecMACKey)^, Length(FDecMACKey),
+           FCipherDecryptState,
+           Pointer(FDecIV), Length(FDecIV),
+           PlainBuf, SizeOf(PlainBuf), PlainSize);
+        TLSBufferDiscard(FInBuf, TLSRecordHeaderSize + RecLength);
+        Inc(FReadSeqNo);
+
+        // process
+        Q := @PlainBuf;
+        case ContentType of
+          tlsctHandshake          : HandleProtocolHandshake(Q^, PlainSize);
+          tlsctAlert              : HandleProtocolAlert(Q^, PlainSize);
+          tlsctApplication_data   : HandleProtocolApplicationData(Q^, PlainSize);
+          tlsctChange_cipher_spec : HandleProtocolChangeCipherSpec(Q^, PlainSize);
+        else
+          ShutdownBadProtocol(tlsadUnexpected_message);
+        end;
+      except
+        on E : ETLSError do
+          if E.AlertDescription = tlsadMax then
+            ShutdownBadProtocol(tlsadDecode_error)
+          else
+            ShutdownBadProtocol(E.AlertDescription);
+        else
+          ShutdownBadProtocol(tlsadDecode_error);
+      end;
+      if IsFinishedState then
+         exit;
+    end;
+  SecureClear(PlainBuf, SizeOf(PlainBuf));
+end;
+
+procedure TTLSConnection.ProcessTransportLayerReceivedData(const Buffer; const Size: Integer);
+begin
+  TLSBufferAddBuf(FInBuf, Buffer, Size);
+  if IsFinishedState then
+    raise ETLSError.Create(TLSError_InvalidState); // tls session finished
+
+  ProcessTransportLayerData;
+end;
+
+function TTLSConnection.AvailableToRead: Integer;
+begin
+  Result := TLSBufferUsed(FOutBuf);
+end;
+
+function TTLSConnection.Read(var Buffer; const Size: Integer): Integer;
+var L, N : Integer;
+begin
+  if Size <= 0 then
+    begin
+      Result := 0;
+      exit;
+    end;
+  N := TLSBufferUsed(FOutBuf);
+  if N = 0 then
+    begin
+      Result := 0;
+      exit;
+    end;
+  if Size > N then
+    L := N
+  else
+    L := Size;
+  Result := TLSBufferRemove(FOutBuf, Buffer, L);
+end;
+
+procedure TTLSConnection.Write(const Buffer; const Size: Integer);
+begin
+  if Size <= 0 then
+    exit;
+  if IsFinishedState then
+    raise ETLSError.Create(TLSError_InvalidState); // tls session finished
+
+  if FConnectionState <> tlscoApplicationData then
+    raise ETLSError.Create(TLSError_InvalidState); // cannot accept application data yet.. todo: buffer until negotiation finished?
+
+  SendApplicationData(Buffer, Size);
+end;
+
+procedure TTLSConnection.Close;
+begin
+  if IsFinishedState then
+    raise ETLSError.Create(TLSError_InvalidState); // not open
+
+  DoClose;
+end;
+
+
+
+end.
+

contrib/fundamentals/TLS/flcTLSTransportTypes.pas

@@ -0,0 +1,151 @@
+{******************************************************************************}
+{                                                                              }
+{   Library:          Fundamentals TLS                                         }
+{   File name:        flcTLSTransportTypes.pas                                 }
+{   File version:     5.01                                                     }
+{   Description:      TLS Transport Types                                      }
+{                                                                              }
+{   Copyright:        Copyright (c) 2008-2020, David J Butler                  }
+{                     All rights reserved.                                     }
+{                     Redistribution and use in source and binary forms, with  }
+{                     or without modification, are permitted provided that     }
+{                     the following conditions are met:                        }
+{                     Redistributions of source code must retain the above     }
+{                     copyright notice, this list of conditions and the        }
+{                     following disclaimer.                                    }
+{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
+{                     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED          }
+{                     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED   }
+{                     WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A          }
+{                     PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL     }
+{                     THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,    }
+{                     INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR             }
+{                     CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,    }
+{                     PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF     }
+{                     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)         }
+{                     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER   }
+{                     IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING        }
+{                     NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE   }
+{                     USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE             }
+{                     POSSIBILITY OF SUCH DAMAGE.                              }
+{                                                                              }
+{   Github:           https://github.com/fundamentalslib                       }
+{   E-mail:           fundamentals.library at gmail.com                        }
+{                                                                              }
+{ Revision history:                                                            }
+{                                                                              }
+{   2020/05/01  5.01  Initial version: Options.                                }
+{                                                                              }
+{******************************************************************************}
+
+{$INCLUDE flcTLS.inc}
+
+unit flcTLSTransportTypes;
+
+interface
+
+
+
+type
+  TTLSLogType = (
+    tlsltDebug,
+    tlsltParameter,
+    tlsltInfo,
+    tlsltWarning,
+    tlsltError
+    );
+
+
+
+type
+  TTLSVersionOption = (
+    tlsvoSSL3,
+    tlsvoTLS10,
+    tlsvoTLS11,
+    tlsvoTLS12
+    );
+
+  TTLSVersionOptions = set of TTLSVersionOption;
+
+const
+  AllTLSVersionOptions = [
+    tlsvoSSL3,
+    tlsvoTLS10,
+    tlsvoTLS11,
+    tlsvoTLS12
+    ];
+
+
+
+type
+  TTLSKeyExchangeOption = (
+    tlskeoRSA,
+    tlskeoDH_Anon,
+    tlskeoDH_RSA,
+    tlskeoDHE_RSA,
+    tlskeoECDH_RSA,
+    tlskeoECDHE_RSA
+    );
+
+  TTLSKeyExchangeOptions = set of TTLSKeyExchangeOption;
+
+const
+  AllTLSKeyExchangeOptions = [
+    tlskeoRSA,
+    tlskeoDH_Anon,
+    tlskeoDH_RSA,
+    tlskeoDHE_RSA,
+    tlskeoECDH_RSA,
+    tlskeoECDHE_RSA
+    ];
+
+
+
+type
+  TTLSCipherOption = (
+    tlscoRC4,
+    tlscoDES,
+    tlsco3DES,
+    tlscoAES128,
+    tlscoAES256
+    );
+
+  TTLSCipherOptions = set of TTLSCipherOption;
+
+const
+  AllTLSCipherOptions = [
+    tlscoRC4,
+    tlscoDES,
+    tlsco3DES,
+    tlscoAES128,
+    tlscoAES256
+    ];
+
+
+
+type
+  TTLSHashOption = (
+    tlshoMD5,
+    tlshoSHA1,
+    tlshoSHA256,
+    tlshoSHA384
+    );
+
+  TTLSHashOptions = set of TTLSHashOption;
+
+const
+  AllTLSHashOptions = [
+    tlshoMD5,
+    tlshoSHA1,
+    tlshoSHA256,
+    tlshoSHA384
+    ];
+
+
+
+implementation
+
+
+
+end.
+