SChannel helper

Unit SChannel.Utils

Description
Uses
Classes, Interfaces, Objects and Records
Functions and Procedures
Types
Constants
Variables

Description

Helper functions for easy implementation of TLS communication by means of Windows SChannel. The functions are transport-agnostic so they could be applied to any socket implementation or even other transport.

Inspired by TLS-Sample

Uses JEDI API units

(c) Fr0sT-Brutal

License MIT

Overview

Classes, Interfaces, Objects and Records

Name Description
Record THandShakeData United state and data for TLS handshake
Record TSessionCreds Credentials related to a connection
Interface ISharedSessionCreds Interface with session creds for sharing between multiple sessions
Class TDefaultDebugFnHoster Class with stub debug logging function that reports messages via OutputDebugString
Class TTrustedCerts App-local storage of trusted certs.
Record TSessionData Data related to a session.
Class TBaseTLSOptions Abstract base class for shared TLS options storage
Record TBuffer Trivial data storage
Class ESSPIError Specific exception class.

Functions and Procedures

procedure LoadSecurityLibrary;
procedure CreateCredentials(const User: string; out hCreds: CredHandle; var SchannelCred: SCHANNEL_CRED);
procedure VerifyServerCertificate(pServerCert: PCCERT_CONTEXT; const szServerName: string; dwCertFlags: DWORD);
function GetCertContext(const hContext: CtxtHandle): PCCERT_CONTEXT;
procedure Init;
procedure Fin;
procedure CreateSessionCreds(var SessionCreds: TSessionCreds);
function CreateSharedCreds: ISharedSessionCreds;
procedure FreeSessionCreds(var SessionCreds: TSessionCreds);
procedure FinSession(var SessionData: TSessionData);
procedure Debug(DebugLogFn: TDebugFn; const Msg: string);
function DoClientHandshake(var SessionData: TSessionData; var HandShakeData: THandShakeData; DebugLogFn: TDebugFn = nil): SECURITY_STATUS;
procedure GetShutdownData(const SessionData: TSessionData; const hContext: CtxtHandle; out OutBuffer: SecBuffer);
function GetCurrentCert(const hContext: CtxtHandle): TBytes;
function CheckServerCert(const hContext: CtxtHandle; const ServerName: string; const TrustedCerts: TTrustedCerts = nil; CertCheckIgnoreFlags: TCertCheckIgnoreFlags = []): TCertCheckResult; overload;
function CheckServerCert(const hContext: CtxtHandle; const SessionData: TSessionData): TCertCheckResult; overload;
procedure DeleteContext(var hContext: CtxtHandle);
procedure InitBuffers(const hContext: CtxtHandle; out pbIoBuffer: TBytes; out Sizes: SecPkgContext_StreamSizes);
procedure EncryptData(const hContext: CtxtHandle; const Sizes: SecPkgContext_StreamSizes; pbMessage: PByte; cbMessage: DWORD; pbIoBuffer: PByte; pbIoBufferLength: DWORD; out cbWritten: DWORD);
function DecryptData(const hContext: CtxtHandle; const Sizes: SecPkgContext_StreamSizes; pbIoBuffer: PByte; var cbEncData: DWORD; pbDecData: PByte; cbDecDataLength: DWORD; out cbWritten: DWORD): SECURITY_STATUS;
function SecIsNullHandle(const x: SecHandle): Boolean;
function SecStatusErrStr(scRet: SECURITY_STATUS): string;
function WinVerifyTrustErrorStr(Status: DWORD): string;
function IsWinHandshakeBug(scRet: SECURITY_STATUS): Boolean;
function GetSessionCredsPtr(const SessionData: TSessionData): PSessionCreds;

Types

THandShakeStage = (...);
TChannelState = (...);
PSessionCreds = ˆTSessionCreds;
TSessionFlag = (...);
TSessionFlags = set of TSessionFlag;
TDebugFn = procedure (const Msg: string) of object;
TCertCheckIgnoreFlag = (...);
TCertCheckIgnoreFlags = set of TCertCheckIgnoreFlag;
PSessionData = ˆTSessionData;
TCertCheckResult = (...);

Constants

LogPrefix = '[SChannel]: ';
IO_BUFFER_SIZE = $10000;
USED_PROTOCOLS: DWORD = SP_PROT_TLS1_1 or SP_PROT_TLS1_2;
USED_ALGS: ALG_ID = 0;
SSPI_FLAGS = ISC_REQ_SEQUENCE_DETECT or ISC_REQ_REPLAY_DETECT or ISC_REQ_CONFIDENTIALITY or ISC_RET_EXTENDED_ERROR or ISC_REQ_ALLOCATE_MEMORY or ISC_REQ_STREAM;
CertCheckIgnoreAll = [Low(TCertCheckIgnoreFlag)..High(TCertCheckIgnoreFlag)];
S_Msg_Received = 'Received %d bytes of encrypted data / %d bytes of payload';
S_Msg_SessionClosed = 'Server closed the session [SEC_I_CONTEXT_EXPIRED]';
S_Msg_Renegotiate = 'Server requested renegotiate';
S_Msg_Sending = 'Sending %d bytes of payload / %d bytes encrypted';
S_Msg_StartingTLS = 'Starting TLS handshake';
S_Msg_HShStageW1Success = 'Handshake @W1 - %d bytes sent';
S_Msg_HShStageW1Incomplete = 'Handshake @W1 - ! incomplete data sent';
S_Msg_HShStageW1Fail = 'Handshake @W1 - ! error sending data ([#%d] %s)';
S_Msg_HShStageRFail = 'Handshake @R - ! no data received or error receiving ([#%d] %s)';
S_Msg_HShStageRSuccess = 'Handshake @R - %d bytes received';
S_Msg_HandshakeBug = 'Handshake bug: "%s", retrying';
S_Msg_HShStageW2Success = 'Handshake @W2 - %d bytes sent';
S_Msg_HShStageW2Incomplete = 'Handshake @W2 - ! incomplete data sent';
S_Msg_HShStageW2Fail = 'Handshake @W2 - ! error sending data ([#%d] %s)';
S_Msg_HShExtraData = 'Handshake: got "%d" bytes of extra data';
S_Msg_Established = 'Handshake established';
S_Msg_SrvCredsAuth = 'Server credentials authenticated';
S_Msg_CredsInited = 'Credentials initialized';
S_Msg_AddrIsIP = 'Address "%s" is IP, verification by name is disabled';
S_Msg_ShuttingDownTLS = 'Shutting down TLS';
S_Msg_SendingShutdown = 'Sending shutdown notify - %d bytes of data';
S_Err_ListeningNotSupported = 'Listening is not supported with SChannel yet';
S_Msg_CertIsTrusted = 'Certificate is in trusted list';
S_Msg_CertIsValidWithFlags = 'Certificate is valid using some ignore flags';

Variables

hMYCertStore: HCERTSTORE = nil;
g_pSSPI: PSecurityFunctionTable;

Description

Functions and Procedures

procedure LoadSecurityLibrary;

Mainly for internal use

Exceptions raised
ESSPIError
on error
procedure CreateCredentials(const User: string; out hCreds: CredHandle; var SchannelCred: SCHANNEL_CRED);

Mainly for internal use.

Parameters
SchannelCred
- [?IN/OUT] If SchannelCred.dwVersion = SCHANNEL_CRED_VERSION, the parameter is considered "IN/OUT" and won't be modified before AcquireCredentialsHandle call. Otherwise the parameter is considered "OUT" and is init-ed with default values. Thus user can pass desired values to AcquireCredentialsHandle function.
Exceptions raised
ESSPIError
on error
procedure VerifyServerCertificate(pServerCert: PCCERT_CONTEXT; const szServerName: string; dwCertFlags: DWORD);

Validate certificate. Mainly for internal use. Gets called by CheckServerCert

Parameters
pServerCert
- pointer to cert context
szServerName
- host name of the server to check. Could be empty but appropriate flags must be set as well, otherwise the function will raise error
dwCertFlags
- value of SSL_EXTRA_CERT_CHAIN_POLICY_PARA.fdwChecks field: flags defining errors to ignore. 0 to ignore nothing
Exceptions raised
ESSPIError
on error
function GetCertContext(const hContext: CtxtHandle): PCCERT_CONTEXT;

Retrieve server certificate. Mainly for internal use. Gets called by CheckServerCert. Returned result must be freed via CertFreeCertificateContext.

Parameters
hContext
- current session context
Returns

server certificate data

Exceptions raised
ESSPIError
on error
procedure Init;

Load global stuff. Must be called before any other function called. Could be called multiple times without checks.
Thread-unsafe! Uses global variables

Exceptions raised
ESSPIError
on error
procedure Fin;

Dispose and nullify global stuff. Could be called multiple times without checks.
Thread-unsafe! Uses global variables

procedure CreateSessionCreds(var SessionCreds: TSessionCreds);

Init session creds, return data record to be used in calling other functions. Could be called multiple times (nothing will be done on already init-ed record)

Parameters
SessionCreds
- [IN, OUT] record that receives values. On first call must be zeroed. Alternatively, user could fill SessionCreds.SchannelCred with desired values to tune channel properties.
Exceptions raised
ESSPIError
on error
function CreateSharedCreds: ISharedSessionCreds;

Shared creds factory

procedure FreeSessionCreds(var SessionCreds: TSessionCreds);

Finalize session creds

procedure FinSession(var SessionData: TSessionData);

Finalize session, free credentials

procedure Debug(DebugLogFn: TDebugFn; const Msg: string);

Print debug message either with user-defined function if set or default one (TDefaultDebugFnHoster.Debug method)

function DoClientHandshake(var SessionData: TSessionData; var HandShakeData: THandShakeData; DebugLogFn: TDebugFn = nil): SECURITY_STATUS;

Function to prepare all necessary handshake data. No transport level actions.

Function to prepare all necessary handshake data. No transport level actions. Function actions and returning data depending on input stage:

Parameters
SessionData
- [IN/OUT] record with session data
HandShakeData
- [IN/OUT] record with handshake data
DebugLogFn
- logging callback, could be Nil
Exceptions raised
ESSPIError
on error
ESSPIError
on error
procedure GetShutdownData(const SessionData: TSessionData; const hContext: CtxtHandle; out OutBuffer: SecBuffer);

Generate data to send to a server on connection shutdown

Exceptions raised
ESSPIError
on error
function GetCurrentCert(const hContext: CtxtHandle): TBytes;

Retrieve server certificate linked to current context. More suitable for userland application than GetCertContext, without any SChannel-specific stuff.

Parameters
hContext
- current session context
Returns

server certificate data

Exceptions raised
ESSPIError
on error
function CheckServerCert(const hContext: CtxtHandle; const ServerName: string; const TrustedCerts: TTrustedCerts = nil; CertCheckIgnoreFlags: TCertCheckIgnoreFlags = []): TCertCheckResult; overload;

Check server certificate with a certificate that contains a common name that is not valid will be ignored. (SECURITY_FLAG_IGNORE_CERT_CN_INVALID flag will be set calling CertVerifyCertificateChainPolicy)

Parameters
hContext
- current session context
ServerName
- host name of the server to check. If empty, errors associated
TrustedCerts
- list of trusted certs. If cert is in this list, it won't be checked by system
CertCheckIgnoreFlags
- set of cert aspects to ignore when checking.
Returns

Result of cert check

Exceptions raised
ESSPIError
on error
function CheckServerCert(const hContext: CtxtHandle; const SessionData: TSessionData): TCertCheckResult; overload;

Check server certificate - variant using SessionData only

Returns

Result of cert check

Exceptions raised
ESSPIError
on error
procedure DeleteContext(var hContext: CtxtHandle);

Dispose and nullify security context

procedure InitBuffers(const hContext: CtxtHandle; out pbIoBuffer: TBytes; out Sizes: SecPkgContext_StreamSizes);

Receive size values for current session and init buffer length to contain full message including header and trailer

Exceptions raised
ESSPIError
on error
procedure EncryptData(const hContext: CtxtHandle; const Sizes: SecPkgContext_StreamSizes; pbMessage: PByte; cbMessage: DWORD; pbIoBuffer: PByte; pbIoBufferLength: DWORD; out cbWritten: DWORD);

Encrypt data (prepare for sending to server).

Parameters
hContext
- current session context
Sizes
- current session sizes
pbMessage
- input data to encrypt
cbMessage
- length of input data
pbIoBuffer
- buffer to receive encrypted data
pbIoBufferLength
- size of buffer
cbWritten
- [OUT] size of encrypted data written to buffer
Exceptions raised
ESSPIError
on error
function DecryptData(const hContext: CtxtHandle; const Sizes: SecPkgContext_StreamSizes; pbIoBuffer: PByte; var cbEncData: DWORD; pbDecData: PByte; cbDecDataLength: DWORD; out cbWritten: DWORD): SECURITY_STATUS;

Decrypt data received from server. If input data is not processed completely, unprocessed chunk is copied to beginning of buffer. Thus subsequent call to Recv could just receive to @Buffer[DataLength]

Parameters
hContext
- current session context
Sizes
- current session sizes
pbIoBuffer
- input encrypted data to decrypt
cbEncData
- [IN/OUT] length of encrypted data in buffer. After function call it is set to amount of unprocessed data that is placed from the beginning of the buffer
pbDecData
- buffer to receive decrypted data
cbDecDataLength
- size of buffer
cbWritten
- [OUT] size of decrypted data written to buffer
Returns

  • SEC_I_CONTEXT_EXPIRED - server signaled end of session

  • SEC_E_OK - message processed fully

  • SEC_E_INCOMPLETE_MESSAGE - need more data

  • SEC_I_RENEGOTIATE - server wants to perform another handshake sequence

Exceptions raised
ESSPIError
on error or if Result is not one of above mentioned values
function SecIsNullHandle(const x: SecHandle): Boolean;

Check if handle x is null (has both fields equal to zero)

function SecStatusErrStr(scRet: SECURITY_STATUS): string;

Returns string representaion of given security status (locale message + constant name + numeric value)

function WinVerifyTrustErrorStr(Status: DWORD): string;

Returns string representaion of given verify trust error (locale message + constant name + numeric value)

function IsWinHandshakeBug(scRet: SECURITY_STATUS): Boolean;

Check if status is likely a Windows TLS v1.2 handshake bug (SEC_E_BUFFER_TOO_SMALL or SEC_E_MESSAGE_ALTERED status is returned by InitializeSecurityContext on handshake). This function only checks if parameter is one of these two values.

function GetSessionCredsPtr(const SessionData: TSessionData): PSessionCreds;

Return effective pointer to session credentials - either personal or shared

Types

THandShakeStage = (...);

Detect replayed messages that have been encoded by using the EncryptMessage or MakeSignature functions Encrypt messages by using the EncryptMessage function When errors occur, the remote party will be notified The security package allocates output buffers for you. When you have finished using the output buffers, free them by calling the FreeContextBuffer function Stage of handshake

Values
  • hssNotStarted: Initial stage
  • hssSendCliHello: Sending client hello
  • hssReadSrvHello: Reading server hello - general
  • hssReadSrvHelloNoRead: Reading server hello - repeat call without reading
  • hssReadSrvHelloContNeed: Reading server hello - in process, send token
  • hssReadSrvHelloOK: Reading server hello - success, send token
  • hssDone: Final stage
TChannelState = (...);

State of secure channel

Values
  • chsNotStarted: Initial stage
  • chsHandshake: Handshaking with server
  • chsEstablished: Channel established successfully
  • chsShutdown: Sending shutdown signal and closing connection
PSessionCreds = ˆTSessionCreds;
 
TSessionFlag = (...);

Session options

Values
  • sfNoServerVerify: If set, SChannel won't automatically verify server certificate by setting ISC_REQ_MANUAL_CRED_VALIDATION flag in InitializeSecurityContextW call. User has to call manual verification via CheckServerCert after handshake is established (this allows connecting to an IP, domains with custom certs, expired certs, valid certs if system CRL is expired etc).
TSessionFlags = set of TSessionFlag;
 
TDebugFn = procedure (const Msg: string) of object;

Logging method that is used by functions to report non-critical errors and handshake details.

TCertCheckIgnoreFlag = (...);

Flags to ignore some cert aspects when checking manually via CheckServerCert. Mirror of SECURITY_FLAG_IGNORE_* constants

Values
  • ignRevokation: don't check cert revokation (useful if CRL is unavailable)
  • ignUnknownCA: don't check CA
  • ignWrongUsage
  • ignCertCNInvalid: don't check cert name (useful when connecting by IP)
  • ignCertDateInvalid: don't check expiration date
TCertCheckIgnoreFlags = set of TCertCheckIgnoreFlag;
 
PSessionData = ˆTSessionData;
 
TCertCheckResult = (...);

Result of CheckServerCert function

Values
  • ccrValid: Cert is valid
  • ccrTrusted: Cert was in trusted list, no check was performed
  • ccrValidWithFlags: Cert is valid with some ignore flags

Constants

LogPrefix = '[SChannel]: ';

Just a suggested prefix for log output

IO_BUFFER_SIZE = $10000;

Size of handshake buffer

USED_PROTOCOLS: DWORD = SP_PROT_TLS1_1 or SP_PROT_TLS1_2;

Set of used protocols. Note: TLS 1.0 is not used by default, add SP_PROT_TLS1_0 if needed

USED_ALGS: ALG_ID = 0;

Detect messages received out of sequence

SSPI_FLAGS = ISC_REQ_SEQUENCE_DETECT or ISC_REQ_REPLAY_DETECT or ISC_REQ_CONFIDENTIALITY or ISC_RET_EXTENDED_ERROR or ISC_REQ_ALLOCATE_MEMORY or ISC_REQ_STREAM;

Support a stream-oriented connection

CertCheckIgnoreAll = [Low(TCertCheckIgnoreFlag)..High(TCertCheckIgnoreFlag)];

Set of cert validation ignore flags that has all items set - use it to ignore everything

S_Msg_Received = 'Received %d bytes of encrypted data / %d bytes of payload';

Messages that could be written to log by various implementations. None of these are used in this unit

S_Msg_SessionClosed = 'Server closed the session [SEC_I_CONTEXT_EXPIRED]';
 
S_Msg_Renegotiate = 'Server requested renegotiate';
 
S_Msg_Sending = 'Sending %d bytes of payload / %d bytes encrypted';
 
S_Msg_StartingTLS = 'Starting TLS handshake';
 
S_Msg_HShStageW1Success = 'Handshake @W1 - %d bytes sent';
 
S_Msg_HShStageW1Incomplete = 'Handshake @W1 - ! incomplete data sent';
 
S_Msg_HShStageW1Fail = 'Handshake @W1 - ! error sending data ([#%d] %s)';
 
S_Msg_HShStageRFail = 'Handshake @R - ! no data received or error receiving ([#%d] %s)';
 
S_Msg_HShStageRSuccess = 'Handshake @R - %d bytes received';
 
S_Msg_HandshakeBug = 'Handshake bug: "%s", retrying';
 
S_Msg_HShStageW2Success = 'Handshake @W2 - %d bytes sent';
 
S_Msg_HShStageW2Incomplete = 'Handshake @W2 - ! incomplete data sent';
 
S_Msg_HShStageW2Fail = 'Handshake @W2 - ! error sending data ([#%d] %s)';
 
S_Msg_HShExtraData = 'Handshake: got "%d" bytes of extra data';
 
S_Msg_Established = 'Handshake established';
 
S_Msg_SrvCredsAuth = 'Server credentials authenticated';
 
S_Msg_CredsInited = 'Credentials initialized';
 
S_Msg_AddrIsIP = 'Address "%s" is IP, verification by name is disabled';
 
S_Msg_ShuttingDownTLS = 'Shutting down TLS';
 
S_Msg_SendingShutdown = 'Sending shutdown notify - %d bytes of data';
 
S_Err_ListeningNotSupported = 'Listening is not supported with SChannel yet';
 
S_Msg_CertIsTrusted = 'Certificate is in trusted list';
 
S_Msg_CertIsValidWithFlags = 'Certificate is valid using some ignore flags';
 

Variables

hMYCertStore: HCERTSTORE = nil;
 
g_pSSPI: PSecurityFunctionTable;
 
Generated by PasDoc 0.16.0.