clsspi.pas

Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码

  SCH_CRED_REVOCATION_CHECK_CHAIN              = $00000200;
  SCH_CRED_REVOCATION_CHECK_CHAIN_EXCLUDE_ROOT = $00000400;
  SCH_CRED_IGNORE_NO_REVOCATION_CHECK          = $00000800;
  SCH_CRED_IGNORE_REVOCATION_OFFLINE           = $00001000;

  // flag/identifiers for protocols
  SP_PROT_PCT1_SERVER             = $00000001;
  SP_PROT_PCT1_CLIENT             = $00000002;
  SP_PROT_PCT1                    = SP_PROT_PCT1_SERVER + SP_PROT_PCT1_CLIENT;

  SP_PROT_SSL2_SERVER             = $00000004;
  SP_PROT_SSL2_CLIENT             = $00000008;
  SP_PROT_SSL2                    = SP_PROT_SSL2_SERVER + SP_PROT_SSL2_CLIENT;

  SP_PROT_SSL3_SERVER             = $00000010;
  SP_PROT_SSL3_CLIENT             = $00000020;
  SP_PROT_SSL3                    = SP_PROT_SSL3_SERVER + SP_PROT_SSL3_CLIENT;

  SP_PROT_TLS1_SERVER             = $00000040;
  SP_PROT_TLS1_CLIENT             = $00000080;
  SP_PROT_TLS1                    = SP_PROT_TLS1_SERVER + SP_PROT_TLS1_CLIENT;

  SP_PROT_SSL3TLS1_CLIENTS        = SP_PROT_TLS1_CLIENT + SP_PROT_SSL3_CLIENT;
  SP_PROT_SSL3TLS1_SERVERS        = SP_PROT_TLS1_SERVER + SP_PROT_SSL3_SERVER;
  SP_PROT_SSL3TLS1                = SP_PROT_SSL3 + SP_PROT_TLS1;

  SP_PROT_UNI_SERVER              = $40000000;
  SP_PROT_UNI_CLIENT              = $80000000;
  SP_PROT_UNI                     = SP_PROT_UNI_SERVER + SP_PROT_UNI_CLIENT;

  SP_PROT_ALL                     = $ffffffff;
  SP_PROT_NONE                    = $0;
  SP_PROT_CLIENTS                 = SP_PROT_PCT1_CLIENT + SP_PROT_SSL2_CLIENT + SP_PROT_SSL3_CLIENT + SP_PROT_UNI_CLIENT + SP_PROT_TLS1_CLIENT;
  SP_PROT_SERVERS                 = SP_PROT_PCT1_SERVER + SP_PROT_SSL2_SERVER + SP_PROT_SSL3_SERVER + SP_PROT_UNI_SERVER + SP_PROT_TLS1_SERVER;

  // internal errors
  SSPI_E_LoadLibrary                = -1;
  SSPI_E_FuncTableInit              = -2;
  SSPI_E_SecPackage                 = -3;
  SSPI_E_AcquireFailed              = -4;
  SSPI_E_PackageNotFound            = -5;
  SSPI_E_QueryPackageInfoFailed     = -6;
  SSPI_E_CertificateNotFound        = -7;
  SSPI_E_QueryRemoteCertificate     = -8;
  SSPI_E_QueryLocalCertificate      = -9;
  SSPI_E_RemoteCertificateNotTrusted = -10;
  SSPI_E_WhileVerify                 = -11;
  SSPI_E_NOT_SUPPORTED               = -12;
  // errors and warnings codes

  SEC_E_OK                    = SECURITY_STATUS($00000000);
  SEC_E_OUTOFMEMORY           = SECURITY_STATUS($00000014);
  SEC_I_RENEGOTIATE           = SECURITY_STATUS($00090321);
  SEC_E_INVALID_HANDLE        = SECURITY_STATUS($80090301);
  SEC_E_UNSUPPORTED_FUNCTION  = SECURITY_STATUS($80090302);
  SEC_E_TARGET_UNKNOWN        = SECURITY_STATUS($80090303);
  SEC_E_INTERNAL_ERROR        = SECURITY_STATUS($80090304);
  SEC_E_SECPKG_NOT_FOUND      = SECURITY_STATUS($80090305);
  SEC_E_NOT_OWNER             = SECURITY_STATUS($80090306);
  SEC_E_CANNOT_INSTALL        = SECURITY_STATUS($80090307);
  SEC_E_INVALID_TOKEN         = SECURITY_STATUS($80090308);
  SEC_E_CANNOT_PACK           = SECURITY_STATUS($80090309);
  SEC_E_QOP_NOT_SUPPORTED     = SECURITY_STATUS($8009030A);
  SEC_E_NO_IMPERSONATION      = SECURITY_STATUS($8009030B);
  SEC_E_LOGON_DENIED          = SECURITY_STATUS($8009030C);
  SEC_E_UNKNOWN_CREDENTIALS   = SECURITY_STATUS($8009030D);
  SEC_E_NO_CREDENTIALS        = SECURITY_STATUS($8009030E);
  SEC_E_MESSAGE_ALTERED       = SECURITY_STATUS($8009030F);
  SEC_E_OUT_OF_SEQUENCE       = SECURITY_STATUS($80090310);
  SEC_E_NO_AUTHENTICATING_AUTHORITY = SECURITY_STATUS($80090311);

  SEC_I_CONTINUE_NEEDED       = SECURITY_STATUS($00090312);
  SEC_I_COMPLETE_NEEDED       = SECURITY_STATUS($00090313);
  SEC_I_COMPLETE_AND_CONTINUE = SECURITY_STATUS($00090314);
  SEC_I_LOCAL_LOGON           = SECURITY_STATUS($00090315);
  SEC_E_BAD_PKGID             = SECURITY_STATUS($80090316);

  SEC_I_END_SESSION           = SECURITY_STATUS($00090317);

  SEC_E_INCOMPLETE_MESSAGE    = SECURITY_STATUS($80090318);
  SEC_I_INCOMPLETE_CREDENTIALS = SECURITY_STATUS($00090320);

  CERT_E_EXPIRED               = SECURITY_STATUS($800B0101);
  CERT_E_VALIDITYPERIODNESTING = SECURITY_STATUS($800B0102);
  CERT_E_ROLE                  = SECURITY_STATUS($800B0103);
  CERT_E_PATHLENCONST          = SECURITY_STATUS($800B0104);
  CERT_E_CRITICAL              = SECURITY_STATUS($800B0105);
  CERT_E_PURPOSE               = SECURITY_STATUS($800B0106);
  CERT_E_ISSUERCHAINING        = SECURITY_STATUS($800B0107);
  CERT_E_MALFORMED             = SECURITY_STATUS($800B0108);
  CERT_E_UNTRUSTEDROOT         = SECURITY_STATUS($800B0109);
  CERT_E_CHAINING              = SECURITY_STATUS($800B010A);
  TRUST_E_FAIL                 = SECURITY_STATUS($800B010B);
  CERT_E_REVOKED               = SECURITY_STATUS($800B010C);
  CERT_E_UNTRUSTEDTESTROOT     = SECURITY_STATUS($800B010D);
  CERT_E_REVOCATION_FAILURE    = SECURITY_STATUS($800B010E);
  CERT_E_CN_NO_MATCH           = SECURITY_STATUS($800B010F);
  CERT_E_WRONG_USAGE           = SECURITY_STATUS($800B0110);

  SECBUFFER_VERSION           = 0;

  SECBUFFER_EMPTY             = 0;   // Undefined, replaced by provider
  SECBUFFER_DATA              = 1;   // Packet data
  SECBUFFER_TOKEN             = 2;   // Security token
  SECBUFFER_PKG_PARAMS        = 3;   // Package specific parameters
  SECBUFFER_MISSING           = 4;   // Missing Data indicator
  SECBUFFER_EXTRA             = 5;   // Extra data
  SECBUFFER_STREAM_TRAILER    = 6;   // Security Trailer
  SECBUFFER_STREAM_HEADER     = 7;   // Security Header
  SECBUFFER_NEGOTIATION_INFO  = 8;   // Hints from the negotiation pkg

  ISC_REQ_DELEGATE                = $00000001;
  ISC_REQ_MUTUAL_AUTH             = $00000002;
  ISC_REQ_REPLAY_DETECT           = $00000004;
  ISC_REQ_SEQUENCE_DETECT         = $00000008;
  ISC_REQ_CONFIDENTIALITY         = $00000010;
  ISC_REQ_USE_SESSION_KEY         = $00000020;
  ISC_REQ_PROMPT_FOR_CREDS        = $00000040;
  ISC_REQ_USE_SUPPLIED_CREDS      = $00000080;
  ISC_REQ_ALLOCATE_MEMORY         = $00000100;
  ISC_REQ_USE_DCE_STYLE           = $00000200;
  ISC_REQ_DATAGRAM                = $00000400;
  ISC_REQ_CONNECTION              = $00000800;
  ISC_REQ_CALL_LEVEL              = $00001000;
  ISC_REQ_EXTENDED_ERROR          = $00004000;
  ISC_REQ_STREAM                  = $00008000;
  ISC_REQ_INTEGRITY               = $00010000;
  ISC_REQ_IDENTIFY                = $00020000;
  ISC_REQ_NULL_SESSION            = $00040000;

  ISC_RET_DELEGATE                = $00000001;
  ISC_RET_MUTUAL_AUTH             = $00000002;
  ISC_RET_REPLAY_DETECT           = $00000004;
  ISC_RET_SEQUENCE_DETECT         = $00000008;
  ISC_RET_CONFIDENTIALITY         = $00000010;
  ISC_RET_USE_SESSION_KEY         = $00000020;
  ISC_RET_USED_COLLECTED_CREDS    = $00000040;
  ISC_RET_USED_SUPPLIED_CREDS     = $00000080;
  ISC_RET_ALLOCATED_MEMORY        = $00000100;
  ISC_RET_USED_DCE_STYLE          = $00000200;
  ISC_RET_DATAGRAM                = $00000400;
  ISC_RET_CONNECTION              = $00000800;
  ISC_RET_INTERMEDIATE_RETURN     = $00001000;
  ISC_RET_CALL_LEVEL              = $00002000;
  ISC_RET_EXTENDED_ERROR          = $00004000;
  ISC_RET_STREAM                  = $00008000;
  ISC_RET_INTEGRITY               = $00010000;
  ISC_RET_IDENTIFY                = $00020000;
  ISC_RET_NULL_SESSION            = $00040000;
  ISC_RET_MANUAL_CRED_VALIDATION  = $00080000;
  ISC_RET_RESERVED1               = $00100000;
  ISC_RET_FRAGMENT_ONLY           = $00200000;

  ASC_REQ_DELEGATE                = $00000001;
  ASC_REQ_MUTUAL_AUTH             = $00000002;
  ASC_REQ_REPLAY_DETECT           = $00000004;
  ASC_REQ_SEQUENCE_DETECT         = $00000008;
  ASC_REQ_CONFIDENTIALITY         = $00000010;
  ASC_REQ_USE_SESSION_KEY         = $00000020;
  ASC_REQ_ALLOCATE_MEMORY         = $00000100;
  ASC_REQ_USE_DCE_STYLE           = $00000200;
  ASC_REQ_DATAGRAM                = $00000400;
  ASC_REQ_CONNECTION              = $00000800;
  ASC_REQ_CALL_LEVEL              = $00001000;
  ASC_REQ_EXTENDED_ERROR          = $00008000;
  ASC_REQ_STREAM                  = $00010000;
  ASC_REQ_INTEGRITY               = $00020000;
  ASC_REQ_LICENSING               = $00040000;
  ASC_REQ_IDENTIFY                = $00080000;
  ASC_REQ_ALLOW_NULL_SESSION      = $00100000;
  ASC_REQ_ALLOW_NON_USER_LOGONS   = $00200000;
  ASC_REQ_ALLOW_CONTEXT_REPLAY    = $00400000;
  ASC_REQ_FRAGMENT_TO_FIT         = $00800000;
  ASC_REQ_FRAGMENT_SUPPLIED       = $00002000;
  ASC_REQ_NO_TOKEN                = $01000000;

  ASC_RET_DELEGATE                = $00000001;
  ASC_RET_MUTUAL_AUTH             = $00000002;
  ASC_RET_REPLAY_DETECT           = $00000004;
  ASC_RET_SEQUENCE_DETECT         = $00000008;
  ASC_RET_CONFIDENTIALITY         = $00000010;
  ASC_RET_USE_SESSION_KEY         = $00000020;
  ASC_RET_ALLOCATED_MEMORY        = $00000100;
  ASC_RET_USED_DCE_STYLE          = $00000200;
  ASC_RET_DATAGRAM                = $00000400;
  ASC_RET_CONNECTION              = $00000800;
  ASC_RET_CALL_LEVEL              = $00002000; // skipped 1000 to be like ISC_
  ASC_RET_THIRD_LEG_FAILED        = $00004000;
  ASC_RET_EXTENDED_ERROR          = $00008000;
  ASC_RET_STREAM                  = $00010000;
  ASC_RET_INTEGRITY               = $00020000;
  ASC_RET_LICENSING               = $00040000;
  ASC_RET_IDENTIFY                = $00080000;
  ASC_RET_NULL_SESSION            = $00100000;
  ASC_RET_ALLOW_NON_USER_LOGONS   = $00200000;
  ASC_RET_ALLOW_CONTEXT_REPLAY    = $00400000;
  ASC_RET_FRAGMENT_ONLY           = $00800000;
  ASC_RET_NO_TOKEN                = $01000000;

  // Data Representation Constant:
  SECURITY_NATIVE_DREP        = $00000010;
  SECURITY_NETWORK_DREP       = $00000000;

  // Credential Use Flags
  SECPKG_CRED_INBOUND         = $00000001;
  SECPKG_CRED_OUTBOUND        = $00000002;
  SECPKG_CRED_BOTH            = $00000003;

 //  Security Context Attributes:

  SECPKG_ATTR_SIZES           = $00000000;
  SECPKG_ATTR_NAMES           = $00000001;
  SECPKG_ATTR_LIFESPAN        = $00000002;
  SECPKG_ATTR_DCE_INFO        = $00000003;
  SECPKG_ATTR_STREAM_SIZES    = $00000004;
  SECPKG_ATTR_KEY_INFO        = $00000005;
  SECPKG_ATTR_AUTHORITY       = $00000006;
  SECPKG_ATTR_PROTO_INFO      = $00000007;
  SECPKG_ATTR_PASSWORD_EXPIRY = $00000008;
  SECPKG_ATTR_SESSION_KEY     = $00000009;
  SECPKG_ATTR_PACKAGE_INFO    = $00000010;

// QueryContextAttributes/QueryCredentialsAttribute extensions

  SECPKG_ATTR_REMOTE_CERT_CONTEXT  = $53;  // returns PCCERT_CONTEXT
  SECPKG_ATTR_LOCAL_CERT_CONTEXT   = $54;  // returns PCCERT_CONTEXT
  SECPKG_ATTR_ROOT_STORE           = $55;  // returns HCERTCONTEXT to the root store
  SECPKG_ATTR_SUPPORTED_ALGS       = $56;  // returns SecPkgCred_SupportedAlgs
  SECPKG_ATTR_CIPHER_STRENGTHS     = $57;  // returns SecPkgCred_CipherStrengths
  SECPKG_ATTR_SUPPORTED_PROTOCOLS  = $58;  // returns SecPkgCred_SupportedProtocols
  SECPKG_ATTR_ISSUER_LIST_EX       = $59;  // returns SecPkgContext_IssuerListInfoEx
  SECPKG_ATTR_CONNECTION_INFO      = $5a;  // returns SecPkgContext_ConnectionInfo

  CERT_CHAIN_FIND_BY_ISSUER       = 1;

  DLL_NAMES: array[0..2] of PChar = ('security.dll', 'schannel.dll', 'secur32.dll');

  SECURITY_ENTRYPOINTA = 'InitSecurityInterfaceA';
  SECURITY_ENTRYPOINTW = 'InitSecurityInterfaceW';
  SECURITY_ENTRYPOINT  = SECURITY_ENTRYPOINTA;

  PACKAGE_NAMES: array[0..3] of PChar = (
    'Microsoft Unified Security Protocol Provider',
    'Microsoft SSL 3.0',
    'NTLM',
    'Negotiate');

function GetSspiErrorMessage(AErrorCode: SECURITY_STATUS): string;
function CheckSspiError(AErrorCode: SECURITY_STATUS): TclSspiReturnCode;
procedure SetSspiErrorIf(ACondition: Boolean; ANewErrorCode: SECURITY_STATUS); overload;
procedure SetSspiErrorIf(AErrorCode, ANewErrorCode: SECURITY_STATUS); overload;

implementation

uses
  clSSPIUtils{$IFDEF LOGGER}, clLogger{$ENDIF};

function GetSspiErrorMessage(AErrorCode: SECURITY_STATUS): string;
begin
  case AErrorCode of
    SSPI_E_NOT_SUPPORTED:              Result := SclSimpleNotSupported;
    SEC_E_INVALID_HANDLE:              Result := SSPIErrorINVALIDHANDLE;
    SEC_E_UNSUPPORTED_FUNCTION:        Result := SSPIErrorUNSUPPORTED_FUNCTION;
    SEC_E_TARGET_UNKNOWN:              Result := SSPIErrorTARGET_UNKNOWN;
    SEC_E_INTERNAL_ERROR:              Result := SSPIErrorINTERNAL_ERROR;
    SEC_E_SECPKG_NOT_FOUND:            Result := SSPIErrorSECPKG_NOT_FOUND;
    SEC_E_NOT_OWNER:                   Result := SSPIErrorNOT_OWNER;
    SEC_E_CANNOT_INSTALL:              Result := SSPIErrorCANNOT_INSTALL;
    SEC_E_INVALID_TOKEN:               Result := SSPIErrorINVALID_TOKEN;
    SEC_E_CANNOT_PACK:                 Result := SSPIErrorCANNOT_PACK;
    SEC_E_QOP_NOT_SUPPORTED:           Result := SSPIErrorQOP_NOT_SUPPORTED;
    SEC_E_NO_IMPERSONATION:            Result := SSPIErrorNO_IMPERSONATION;
    SEC_E_LOGON_DENIED:                Result := SSPIErrorLOGON_DENIED;
    SEC_E_UNKNOWN_CREDENTIALS:         Result := SSPIErrorUNKNOWN_CREDENTIALS;
    SEC_E_NO_CREDENTIALS:              Result := SSPIErrorNO_CREDENTIALS;
    SEC_E_MESSAGE_ALTERED:             Result := SSPIErrorMESSAGE_ALTERED;
    SEC_E_OUT_OF_SEQUENCE:             Result := SSPIErrorOUT_OF_SEQUENCE;
    SEC_E_NO_AUTHENTICATING_AUTHORITY: Result := SSPIErrorNO_AUTHENTICATING_AUTHORITY;
    SEC_E_BAD_PKGID:                   Result := SSPIErrorBAD_PKGID;
    SEC_E_OUTOFMEMORY:                 Result := SSPIErrorOUTOFMEMORY;
    SSPI_E_WhileVerify:                Result := SSPIErrorWhileTrustPerforming;
    SSPI_E_LoadLibrary:                Result := SSPIErrorLoadLibrary;
    SSPI_E_FuncTableInit:              Result := SSPIErrorFuncTableInit;
    SSPI_E_SecPackage:                 Result := SSPIErrorSecPackage;
    SSPI_E_AcquireFailed:              Result := SSPIErrorAcquireFailed;
    SSPI_E_PackageNotFound:            Result := SSPIErrorPackageNotFound;
    SSPI_E_QueryPackageInfoFailed:     Result := SSPIErrorQueryPackageInfoFailed;
    SSPI_E_CertificateNotFound:        Result := SSPIErrorCertificateNotFound;
    SSPI_E_QueryRemoteCertificate:     Result := SSPIErrorQueryRemoteCertificate;
    SSPI_E_QueryLocalCertificate:      Result := SSPIErrorQueryLocalCertificate;
    SSPI_E_RemoteCertificateNotTrusted:Result := SSPIErrorRemoteCertificateNotTrusted;
    CERT_E_EXPIRED:                    Result := SSPIErrorCERTEXPIRED;
    CERT_E_VALIDITYPERIODNESTING:      Result := SSPIErrorCERTVALIDITYPERIODNESTING;
    CERT_E_ROLE:                       Result := SSPIErrorCERTROLE;
    CERT_E_PATHLENCONST:               Result := SSPIErrorCERTPATHLENCONST;
    CERT_E_CRITICAL:                   Result := SSPIErrorCERTCRITICAL;
    CERT_E_PURPOSE:                    Result := SSPIErrorCERTPURPOSE;
    CERT_E_ISSUERCHAINING:             Result := SSPIErrorCERTISSUERCHAINING;
    CERT_E_MALFORMED:                  Result := SSPIErrorCERTMALFORMED;
    CERT_E_UNTRUSTEDROOT:              Result := SSPIErrorCERTUNTRUSTEDROOT;
    CERT_E_CHAINING:                   Result := SSPIErrorCERTCHAINING;
    TRUST_E_FAIL:                      Result := SSPIErrorCERTFAIL;
    CERT_E_REVOKED:                    Result := SSPIErrorCERTREVOKED;
    CERT_E_UNTRUSTEDTESTROOT:          Result := SSPIErrorCERTUNTRUSTEDTESTROOT;
    CERT_E_REVOCATION_FAILURE:         Result := SSPIErrorCERTREVOCATION_FAILURE;
    CERT_E_CN_NO_MATCH:                Result := SSPIErrorCERTCN_NO_MATCH;
    CERT_E_WRONG_USAGE:                Result := SSPIErrorCERTWRONG_USAGE;
  else
    Result := Format(SSPIErrorUnknownError, [AErrorCode]);
  end;
end;

function CheckSspiError(AErrorCode: SECURITY_STATUS): TclSspiReturnCode;
begin
  case AErrorCode of
    SEC_E_INCOMPLETE_MESSAGE: Result := rcMoreDataNeeded;
    SEC_I_CONTINUE_NEEDED:    Result := rcContinueNeeded;
    SEC_I_COMPLETE_NEEDED:    Result := rcCompleteNeeded;
    SEC_I_RENEGOTIATE:        Result := rcReAuthNeeded;
    SEC_I_END_SESSION:        Result := rcClosingNeeded;
    SEC_E_OK:                 Result := rcOK;
  else
    raise EclSSPIError.Create(GetSspiErrorMessage(AErrorCode), AErrorCode);
  end;
end;

procedure SetSspiErrorIf(ACondition: Boolean; ANewErrorCode: SECURITY_STATUS);
begin
  if ACondition then
  begin
    CheckSspiError(ANewErrorCode);
  end;
end;

procedure SetSspiErrorIf(AErrorCode, ANewErrorCode: SECURITY_STATUS);
begin
  SetSspiErrorIf((AErrorCode < SEC_E_OK), ANewErrorCode);
end;

{ TclTlsSspi }

function TclTlsSspi.GetStreamSizes: TSecPkgContext_StreamSizes;
var
  scRet: SECURITY_STATUS;
begin
  if (FStreamSizes.cbHeader = 0) then
  begin
    scRet := FunctionTable.QueryContextAttributes(@FCtxtHandle, SECPKG_ATTR_STREAM_SIZES, @FStreamSizes);
    SetSspiErrorIf(scRet <> SEC_E_OK, SSPI_E_QueryPackageInfoFailed);
  end;
  Result := FStreamSizes;
end;

function TclTlsSspi.GetPackageName: string;
begin
  Result := PACKAGE_NAMES[FPackageNo];
end;

function TclTlsSspi.GetPackageNo: Integer;
var
  I, J: Integer;
  PackagesCount: Cardinal;
  PackageInfoArray: PSecPkgInfo;
begin
  EnumerateSecurityPackages(PackagesCount, PackageInfoArray);
  try
    Result := Length(PACKAGE_NAMES);
    for J := 0 to PackagesCount - 1 do
    begin