211 lines
10 KiB
ObjectPascal
211 lines
10 KiB
ObjectPascal
{******************************************************************************}
|
|
{ }
|
|
{ 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}
|
|
|
|
|
|
|
|
end.
|
|
|