Vichingo455-RePacks
/
xtool
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases 1 Wiki Activity
xtool/contrib/mORMot/SynSSPI.pas

591 lines
19 KiB
ObjectPascal
Raw Blame History

/// low level access to Windows SSPI/SChannel API for the Win32/Win64 platform
// - this unit is a part of the freeware Synopse framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit SynSSPI;
{
This file is part of Synopse mORMot framework.
Synopse mORMot framework. Copyright (C) 2022 Arnaud Bouchez
Synopse Informatique - https://synopse.info
*** BEGIN LICENSE BLOCK *****
Version: MPL 1.1/GPL 2.0/LGPL 2.1
The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
for the specific language governing rights and limitations under the License.
The Original Code is Synopse mORMot framework.
The Initial Developer of the Original Code is Chaa.
Portions created by the Initial Developer are Copyright (C) 2022
the Initial Developer. All Rights Reserved.
Contributor(s):
Arnaud Bouchez
Alternatively, the contents of this file may be used under the terms of
either the GNU General Public License Version 2 or later (the "GPL"), or
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
in which case the provisions of the GPL or the LGPL are applicable instead
of those above. If you wish to allow use of your version of this file only
under the terms of either the GPL or the LGPL, and not to allow others to
use your version of this file under the terms of the MPL, indicate your
decision by deleting the provisions above and replace them with the notice
and other provisions required by the GPL or the LGPL. If you do not delete
the provisions above, a recipient may use your version of this file under
the terms of any one of the MPL, the GPL or the LGPL.
***** END LICENSE BLOCK *****
}
{$I Synopse.inc} // define HASINLINE and other compatibility switches
interface
{$ifdef MSWINDOWS} // compiles as void unit for non-Windows - allow Lazarus package
uses
Windows,
SysUtils;
(* ================= Low-Level SSPI / SChannel API types and functions ====== *)
type
{$ifdef CPU64}
LONG_PTR = Int64;
{$else}
LONG_PTR = integer;
{$endif}
{$ifdef HASCODEPAGE}
TSSPIBuffer = RawByteString;
{$else}
TSSPIBuffer = AnsiString;
{$endif}
/// SSPI context handle
TSecHandle = record
dwLower: LONG_PTR;
dwUpper: LONG_PTR;
end;
PSecHandle = ^TSecHandle;
/// SSPI context
TSecContext = record
ID: Int64;
CredHandle: TSecHandle;
CtxHandle: TSecHandle;
CreatedTick64: Int64;
end;
PSecContext = ^TSecContext;
/// dynamic array of SSPI contexts
// - used to hold information between calls to ServerSSPIAuth
TSecContextDynArray = array of TSecContext;
/// defines a SSPI buffer
{$ifdef USERECORDWITHMETHODS}TSecBuffer = record
{$else}TSecBuffer = object{$endif}
public
cbBuffer: Cardinal;
BufferType: Cardinal;
pvBuffer: Pointer;
procedure Init(aType: cardinal; aData: pointer; aSize: cardinal);
end;
PSecBuffer = ^TSecBuffer;
/// describes a SSPI buffer
{$ifdef USERECORDWITHMETHODS}TSecBufferDesc = record
{$else}TSecBufferDesc = object{$endif}
public
ulVersion: Cardinal;
cBuffers: Cardinal;
pBuffers: PSecBuffer;
procedure Init(aVersion: cardinal; aBuffers: PSecBuffer; aBuffersCount: cardinal);
end;
PSecBufferDesc = ^TSecBufferDesc;
/// store the name associated with the context
SecPkgContext_NamesW = record
sUserName: PWideChar;
end;
/// store information about a SSPI package
TSecPkgInfoW = record
fCapabilities: Cardinal;
wVersion: Word;
wRPCID: Word;
cbMaxToken: Cardinal;
Name: PWideChar;
Comment: PWideChar;
end;
/// pointer to information about a SSPI package
PSecPkgInfoW = ^TSecPkgInfoW;
/// store negotation information about a SSPI package
TSecPkgContext_NegotiationInfo = record
PackageInfo: PSecPkgInfoW;
NegotiationState: Cardinal;
end;
/// store various working buffer sizes of a SSPI command
TSecPkgContext_Sizes = record
cbMaxToken: Cardinal;
cbMaxSignature: Cardinal;
cbBlockSize: Cardinal;
cbSecurityTrailer: Cardinal;
end;
/// store various working buffer sizes of a SSPI stream
TSecPkgContext_StreamSizes = record
cbHeader: Cardinal;
cbTrailer: Cardinal;
cbMaximumMessage: Cardinal;
cBuffers: Cardinal;
cbBlockSize: Cardinal;
end;
/// information about SSPI supported algorithm
TSecPkgCred_SupportedAlgs = record
cSupportedAlgs: Cardinal;
palgSupportedAlgs: Pointer;
end;
/// pointer to SSPI supported algorithm
PSecPkgCred_SupportedAlgs = ^TSecPkgCred_SupportedAlgs;
/// information about SSPI Authority Identify
TSecWinntAuthIdentityW = record
User: PWideChar;
UserLength: Cardinal;
Domain: PWideChar;
DomainLength: Cardinal;
Password: PWideChar;
PasswordLength: Cardinal;
Flags: Cardinal
end;
/// pointer to SSPI Authority Identify
PSecWinntAuthIdentityW = ^TSecWinntAuthIdentityW;
const
SECBUFFER_VERSION = 0;
SECBUFFER_DATA = 1;
SECBUFFER_TOKEN = 2;
SECBUFFER_PADDING = 9;
SECBUFFER_STREAM = 10;
SECPKG_CRED_INBOUND = $00000001;
SECPKG_CRED_OUTBOUND = $00000002;
SECPKG_ATTR_SIZES = 0;
SECPKG_ATTR_NAMES = 1;
SECPKG_ATTR_STREAM_SIZES = 4;
SECPKG_ATTR_NEGOTIATION_INFO = 12;
SECURITY_NETWORK_DREP = 0;
SECURITY_NATIVE_DREP = $10;
ISC_REQ_MUTUAL_AUTH = $00000002;
ISC_REQ_CONFIDENTIALITY = $00000010;
ISC_REQ_ALLOCATE_MEMORY = $00000100;
ASC_REQ_CONFIDENTIALITY = $00000010;
ASC_REQ_ALLOCATE_MEMORY = $00000100;
SEC_I_CONTINUE_NEEDED = $00090312;
SEC_I_COMPLETE_NEEDED = $00090313;
SEC_I_COMPLETE_AND_CONTINUE = $00090314;
SEC_WINNT_AUTH_IDENTITY_UNICODE = $02;
function QuerySecurityPackageInfoW(pszPackageName: PWideChar;
var ppPackageInfo: PSecPkgInfoW): Integer; stdcall;
function AcquireCredentialsHandleW(pszPrincipal, pszPackage: PWideChar;
fCredentialUse: Cardinal; pvLogonId: Pointer; pAuthData: PSecWinntAuthIdentityW;
pGetKeyFn: Pointer; pvGetKeyArgument: Pointer; phCredential: PSecHandle;
var ptsExpiry: LARGE_INTEGER): Integer; stdcall;
function InitializeSecurityContextW(phCredential: PSecHandle; phContext: PSecHandle;
pszTargetName: PWideChar; fContextReq, Reserved1, TargetDataRep: Cardinal;
pInput: PSecBufferDesc; Reserved2: Cardinal; phNewContext: PSecHandle;
pOutput: PSecBufferDesc; var pfContextAttr: Cardinal; var ptsExpiry: LARGE_INTEGER): Integer; stdcall;
function AcceptSecurityContext(phCredential: PSecHandle; phContext: PSecHandle;
pInput: PSecBufferDesc; fContextReq, TargetDataRep: Cardinal;
phNewContext: PSecHandle; pOutput: PSecBufferDesc; var pfContextAttr: Cardinal;
var ptsExpiry: LARGE_INTEGER): Integer; stdcall;
function CompleteAuthToken(phContext: PSecHandle; pToken: PSecBufferDesc): Integer; stdcall;
function QueryContextAttributesW(phContext: PSecHandle; ulAttribute: Cardinal;
pBuffer: Pointer): Integer; stdcall;
function QuerySecurityContextToken(phContext: PSecHandle; var Token: THandle): Integer; stdcall;
function EncryptMessage(phContext: PSecHandle; fQOP: Cardinal;
pToken: PSecBufferDesc; MessageSeqNo: Cardinal): Integer; stdcall;
function DecryptMessage(phContext: PSecHandle; pToken: PSecBufferDesc;
MessageSeqNo: Cardinal; var fQOP: Cardinal): Integer; stdcall;
function FreeContextBuffer(pvContextBuffer: Pointer): Integer; stdcall;
function DeleteSecurityContext(phContext: PSecHandle): Integer; stdcall;
function FreeCredentialsHandle(phCredential: PSecHandle): Integer; stdcall;
type
HCRYPTPROV = pointer;
HCERTSTORE = Pointer;
PCCERT_CONTEXT = pointer;
ALG_ID = pointer;
_HMAPPER = pointer;
/// SChannel credential information
TSChannel_Cred = record
dwVersion: Cardinal;
cCreds: Cardinal;
paCred: PCCERT_CONTEXT;
hRootStore: HCERTSTORE;
cMappers: Cardinal;
aphMappers: _HMAPPER;
cSupportedAlgs: Cardinal;
palgSupportedAlgs: ALG_ID;
grbitEnabledProtocols: Cardinal;
dwMinimumCipherStrength: Cardinal;
dwMaximumCipherStrength: Cardinal;
dwSessionLifespan: Cardinal;
dwFlags: Cardinal;
dwCredFormat: Cardinal;
end;
/// pointer to SChannel credential information
PSChannel_Cred = ^TSChannel_Cred;
const
UNISP_NAME = 'Microsoft Unified Security Protocol Provider';
SP_PROT_TLS1_0_SERVER = $00000040;
SP_PROT_TLS1_0_CLIENT = $00000080;
SP_PROT_TLS1_0 = SP_PROT_TLS1_0_SERVER + SP_PROT_TLS1_0_CLIENT;
SP_PROT_TLS1_1_SERVER = $00000100;
SP_PROT_TLS1_1_CLIENT = $00000200;
SP_PROT_TLS1_1 = SP_PROT_TLS1_1_SERVER + SP_PROT_TLS1_1_CLIENT;
// TLS 1.2 should be the preferred safe default
SP_PROT_TLS1_2_SERVER = $00000400;
SP_PROT_TLS1_2_CLIENT = $00000800;
SP_PROT_TLS1_2 = SP_PROT_TLS1_2_SERVER + SP_PROT_TLS1_2_CLIENT;
SP_PROT_TLS1_X_SERVER = SP_PROT_TLS1_0_SERVER + SP_PROT_TLS1_1_SERVER + SP_PROT_TLS1_2_SERVER;
SP_PROT_TLS1_X_CLIENT = SP_PROT_TLS1_0_CLIENT + SP_PROT_TLS1_1_CLIENT + SP_PROT_TLS1_2_CLIENT;
SP_PROT_TLS1_X = SP_PROT_TLS1_X_SERVER + SP_PROT_TLS1_X_CLIENT;
function CertOpenStore(lpszStoreProvider: PAnsiChar; dwEncodingType: DWORD;
hCryptProv: HCRYPTPROV; dwFlags: DWORD; pvPara: Pointer): HCERTSTORE; stdcall;
function CertOpenSystemStoreW(hProv: HCRYPTPROV; szSubsystemProtocol: PWideChar): HCERTSTORE; stdcall;
function CertCloseStore(hCertStore: HCERTSTORE; dwFlags: DWORD): BOOL; stdcall;
function CertFindCertificateInStore(hCertStore: HCERTSTORE;
dwCertEncodingType, dwFindFlags, dwFindType: DWORD; pvFindPara: Pointer;
pPrevCertContext: PCCERT_CONTEXT): PCCERT_CONTEXT; stdcall;
(* ========================= High-Level SSPI / SChannel API wrappers ======= *)
/// Sets aSecHandle fields to empty state for a given connection ID
procedure InvalidateSecContext(var aSecContext: TSecContext; aConnectionID: Int64);
/// Free aSecContext on client or server side
procedure FreeSecContext(var aSecContext: TSecContext);
/// Encrypts a message
// - aSecContext must be set e.g. from previous success call to ServerSSPIAuth
// or ClientSSPIAuth
// - aPlain contains data that must be encrypted
// - returns encrypted message
function SecEncrypt(var aSecContext: TSecContext; const aPlain: TSSPIBuffer): TSSPIBuffer;
/// Decrypts a message
// - aSecContext must be set e.g. from previous success call to ServerSSPIAuth
// or ClientSSPIAuth
// - aEncrypted contains data that must be decrypted
// - warning: aEncrypted is modified in-place during the process
// - returns decrypted message
function SecDecrypt(var aSecContext: TSecContext; var aEncrypted: TSSPIBuffer): TSSPIBuffer;
type
/// exception class raised durint SSPI/SChannel process
ESynSSPI = class(Exception)
public
constructor CreateLastOSError(const aContext: TSecContext);
end;
/// the supported TLS modes
// - unsafe deprecated modes (e.g. SSL) are not defined at all
TSynSSPIMode = (tls10, tls11, tls12);
/// set of supported TLS modes
TSynSSPIModes = set of TSynSSPIMode;
/// used for low-level logging
TSynSSPILog = procedure(const Fmt: TSSPIBuffer; const Args: array of const) of object;
/// abstract parent class for SSPI / SChannel process
TSynSSPIAbstract = class
protected
fNewConversation: boolean;
fTLS: TSynSSPIModes;
fContext: TSecContext;
fStreamSizes: TSecPkgContext_StreamSizes;
procedure DeleteContext;
procedure EnsureStreamSizes;
public
/// initialize the process
constructor Create(aConnectionID: Int64); virtual;
/// read-only access to the associated connection ID, as provided to Create
property ConnectionID: Int64 read fContext.ID;
/// the TLS modes supported by this instance
// - only TLS 1.2 is suppported by default, for security reasons
property TLS: TSynSSPIModes read fTLS write fTLS;
end;
TSynSSPIClient = class(TSynSSPIAbstract)
protected
public
end;
implementation
(* ========================= Low-Level SSPI / SChannel API types ====== *)
const
secur32 = 'secur32.dll';
function QuerySecurityPackageInfoW; external secur32;
function AcquireCredentialsHandleW; external secur32;
function InitializeSecurityContextW; external secur32;
function AcceptSecurityContext; external secur32;
function CompleteAuthToken; external secur32;
function QueryContextAttributesW; external secur32;
function QuerySecurityContextToken; external secur32;
function EncryptMessage; external secur32;
function DecryptMessage; external secur32;
function FreeContextBuffer; external secur32;
function DeleteSecurityContext; external secur32;
function FreeCredentialsHandle; external secur32;
const
crypt32 = 'crypt32.dll';
function CertOpenStore; external crypt32;
function CertOpenSystemStoreW; external crypt32;
function CertCloseStore; external crypt32;
function CertFindCertificateInStore; external crypt32;
{ TSecBuffer }
procedure TSecBuffer.Init(aType: cardinal; aData: pointer;
aSize: cardinal);
begin
BufferType := aType;
pvBuffer := aData;
cbBuffer := aSize;
end;
{ TSecBufferDesc }
procedure TSecBufferDesc.Init(aVersion: cardinal; aBuffers: PSecBuffer;
aBuffersCount: cardinal);
begin
ulVersion := aVersion;
pBuffers := aBuffers;
cBuffers := aBuffersCount;
end;
(* ========================= High-Level SSPI / SChannel API wrappers === *)
procedure InvalidateSecContext(var aSecContext: TSecContext; aConnectionID: Int64);
begin
aSecContext.ID := aConnectionID;
aSecContext.CredHandle.dwLower := -1;
aSecContext.CredHandle.dwUpper := -1;
aSecContext.CtxHandle.dwLower := -1;
aSecContext.CtxHandle.dwUpper := -1;
aSecContext.CreatedTick64 := 0;
end;
procedure FreeSecurityContext(var handle: TSecHandle);
begin
if (handle.dwLower <> -1) or (handle.dwUpper <> -1) then begin
DeleteSecurityContext(@handle);
handle.dwLower := -1;
handle.dwUpper := -1;
end;
end;
procedure FreeCredentialsContext(var handle: TSecHandle);
begin
if (handle.dwLower <> -1) or (handle.dwUpper <> -1) then begin
FreeCredentialsHandle(@handle);
handle.dwLower := -1;
handle.dwUpper := -1;
end;
end;
procedure FreeSecContext(var aSecContext: TSecContext);
begin
FreeSecurityContext(aSecContext.CtxHandle);
FreeCredentialsContext(aSecContext.CredHandle);
end;
function SecEncrypt(var aSecContext: TSecContext; const aPlain: TSSPIBuffer): TSSPIBuffer;
var Sizes: TSecPkgContext_Sizes;
SrcLen, EncLen: Cardinal;
Token: array [0..127] of Byte; // Usually 60 bytes
Padding: array [0..63] of Byte; // Usually 1 byte
InBuf: array[0..2] of TSecBuffer;
InDesc: TSecBufferDesc;
EncBuffer: TSSPIBuffer;
Status: Integer;
BufPtr: PByte;
begin
// Sizes.cbSecurityTrailer is size of the trailer (signature + padding) block
if QueryContextAttributesW(@aSecContext.CtxHandle, SECPKG_ATTR_SIZES, @Sizes) <> 0 then
raise ESynSSPI.CreateLastOSError(aSecContext);
// Encrypted data buffer structure:
//
// SSPI/Kerberos Interoperability with GSSAPI
// https://msdn.microsoft.com/library/windows/desktop/aa380496.aspx
//
// GSS-API wrapper for Microsoft's Kerberos SSPI in Windows 2000
// http://www.kerberos.org/software/samples/gsskrb5/gsskrb5/krb5/krb5msg.c
//
// cbSecurityTrailer bytes SrcLen bytes cbBlockSize bytes or less
// (60 bytes) (0 bytes, not used)
// +-------------------------+----------------+--------------------------+
// | Trailer | Data | Padding |
// +-------------------------+----------------+--------------------------+
Assert(Sizes.cbSecurityTrailer <= High(Token)+1);
InBuf[0].Init(SECBUFFER_TOKEN, @Token[0], Sizes.cbSecurityTrailer);
// Encoding done in-place, so we copy the data
SrcLen := Length(aPlain);
SetString(EncBuffer, PAnsiChar(Pointer(aPlain)), SrcLen);
InBuf[1].Init(SECBUFFER_DATA, Pointer(EncBuffer), SrcLen);
Assert(Sizes.cbBlockSize <= High(Padding)+1);
InBuf[2].Init(SECBUFFER_PADDING, @Padding[0], Sizes.cbBlockSize);
InDesc.Init(SECBUFFER_VERSION, @InBuf, 3);
Status := EncryptMessage(@aSecContext.CtxHandle, 0, @InDesc, 0);
if Status < 0 then
raise ESynSSPI.CreateLastOSError(aSecContext);
EncLen := InBuf[0].cbBuffer + InBuf[1].cbBuffer + InBuf[2].cbBuffer;
SetLength(Result, EncLen);
BufPtr := PByte(Result);
Move(PByte(InBuf[0].pvBuffer)^, BufPtr^, InBuf[0].cbBuffer);
Inc(BufPtr, InBuf[0].cbBuffer);
Move(PByte(InBuf[1].pvBuffer)^, BufPtr^, InBuf[1].cbBuffer);
Inc(BufPtr, InBuf[1].cbBuffer);
Move(PByte(InBuf[2].pvBuffer)^, BufPtr^, InBuf[2].cbBuffer);
end;
function SecDecrypt(var aSecContext: TSecContext; var aEncrypted: TSSPIBuffer): TSSPIBuffer;
var EncLen, SigLen: Cardinal;
BufPtr: PByte;
InBuf: array [0..1] of TSecBuffer;
InDesc: TSecBufferDesc;
Status: Integer;
QOP: Cardinal;
begin
EncLen := Length(aEncrypted);
BufPtr := PByte(aEncrypted);
if EncLen < SizeOf(Cardinal) then begin
SetLastError(ERROR_INVALID_PARAMETER);
raise ESynSSPI.CreateLastOSError(aSecContext);
end;
// Hack for compatibility with previous versions.
// Should be removed in future.
// Old version buffer format - first 4 bytes is Trailer length, skip it.
// 16 bytes for NTLM and 60 bytes for Kerberos
SigLen := PCardinal(BufPtr)^;
if (SigLen = 16) or (SigLen = 60) then
begin
Inc(BufPtr, SizeOf(Cardinal));
Dec(EncLen, SizeOf(Cardinal));
end;
InBuf[0].Init(SECBUFFER_STREAM, BufPtr, EncLen);
InBuf[1].Init(SECBUFFER_DATA, nil, 0);
InDesc.Init(SECBUFFER_VERSION, @InBuf, 2);
Status := DecryptMessage(@aSecContext.CtxHandle, @InDesc, 0, QOP);
if Status < 0 then
raise ESynSSPI.CreateLastOSError(aSecContext);
SetString(Result, PAnsiChar(InBuf[1].pvBuffer), InBuf[1].cbBuffer);
end;
{ ESynSSPI }
constructor ESynSSPI.CreateLastOSError(const aContext: TSecContext);
var error: integer;
begin
error := GetLastError;
CreateFmt('API Error %d [%s] for ConnectionID=%d',
[error,SysErrorMessage(error),aContext.ID]);
end;
{ TSynSSPIAbstract }
constructor TSynSSPIAbstract.Create(aConnectionID: Int64);
begin
inherited Create;
fNewConversation := true;
InvalidateSecContext(fContext, aConnectionID);
fTLS := [tls12];
end;
procedure TSynSSPIAbstract.EnsureStreamSizes;
begin
if fStreamSizes.cbHeader=0 then
if QueryContextAttributesW(@fContext.CtxHandle,SECPKG_ATTR_STREAM_SIZES,@fStreamSizes) <> 0 then
raise ESynSSPI.CreateLastOSError(fContext);
end;
procedure TSynSSPIAbstract.DeleteContext;
begin
FreeSecurityContext(fContext.CtxHandle);
FreeCredentialsContext(fContext.CredHandle);
end;
{$else}
implementation // compiles as void unit for non-Windows
{$endif MSWINDOWS}
end.
Reference in New Issue View Git Blame Copy Permalink