clsspi.pas

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

{
  Clever Internet Suite Version 6.2
  Copyright (C) 1999 - 2006 Clever Components
  www.CleverComponents.com
}

unit clSspi;

interface

{$I clVer.inc}
{$IFDEF DELPHI6}
  {$WARNINGS OFF}
{$ENDIF}

uses
  Classes, SysUtils, Windows, clCryptAPI, clSocket, clCert;
 
type
  EclSSPIError = class(EclSocketError);

  TSecHandle = record
    dwLower: Cardinal;
    dwUpper: Cardinal;
  end;
  PSecHandle = TSecHandle;

  TCredHandle = TSecHandle;
  PCredHandle = ^TSecHandle;
  TCtxtHandle = TSecHandle;
  PCtxtHandle = ^TSecHandle;

  PLUID = PLargeInteger;

  PCardinal = ^Cardinal;
  PTimeStamp = ^TTimeStamp;

{$IFDEF DELPHI5}
  SECURITY_STATUS = HRESULT;
{$ELSE}
  SECURITY_STATUS = type Longint;
{$ENDIF}

  PSecBuffer = ^TSecBuffer;
  TSecBuffer = record
    cbBuffer: Cardinal;             // Size of the buffer, in bytes
    BufferType: Cardinal;           // Type of the buffer (below)
    pvBuffer: Pointer;              // Pointer to the buffer
  end;

  PSecBufferDesc = ^TSecBufferDesc;
  TSecBufferDesc = record
    ulVersion: Cardinal;            // Version number
    cBuffers: Cardinal;             // Number of buffers
    pBuffers: PSecBuffer;           // Pointer to array of buffers
  end;

  PSecPkgInfo = ^TSecPkgInfo;
  TSecPkgInfo = record
    fCapabilities: Cardinal;        // capability of bit mask
    wVersion: Word;                 // version of driver
    wRPCID: Word;                   // identifier for RPC run time
    cbMaxToken: Cardinal;           // size of authentication token
    Name: PChar;                    // text name
    Comment: PChar;                 // comment
  end;
  PSecPkgInfoArray = ^TSecPkgInfoArray;
  TSecPkgInfoArray = array[0..0] of TSecPkgInfo;

  PSecPkgContext_Sizes = ^TSecPkgContext_Sizes;
  TSecPkgContext_Sizes = record
    cbMaxToken: Cardinal;
    cbMaxSignature: Cardinal;
    cbBlockSize: Cardinal;
    cbSecurityTrailer: Cardinal;
  end;

  PSecPkgContext_StreamSizes = ^TSecPkgContext_StreamSizes;
  TSecPkgContext_StreamSizes = record
    cbHeader: Cardinal;
    cbTrailer: Cardinal;
    cbMaximumMessage: Cardinal;
    cBuffers: Cardinal;
    cbBlockSize: Cardinal;
  end;

  PSecPkgCred_SupportedAlgs = ^TSecPkgCred_SupportedAlgs;
  TSecPkgCred_SupportedAlgs = record
    cSupportedAlgs: Cardinal;
    palgSupportedAlgs: Pointer;
  end;
  
  PSChannel_Cred = ^TSChannel_Cred;
  TSChannel_Cred = record
    dwVersion: Cardinal;
    cCreds: Cardinal;
    paCred: Pointer; //PCCERT_CONTEXT *
    hRootStore: Cardinal; //HCERTSTORE
    cMappers: Pointer;
    aphMappers: Pointer; // struct _HMAPPER **
    cSupportedAlgs: Cardinal;
    palgSupportedAlgs: Pointer; //
    grbitEnabledProtocols: Cardinal;
    dwMinimumCipherStrength: Cardinal;
    dwMaximumCipherStrength: Cardinal;
    dwSessionLifespan: Cardinal;
    dwFlags: Cardinal;
    reserved: Cardinal;
  end;

  PSecPkgContext_IssuerListInfoEx = ^TSecPkgContext_IssuerListInfoEx;
  TSecPkgContext_IssuerListInfoEx = record
    aIssuers: array[0..0] of CERT_NAME_BLOB;
    cIssuers: Cardinal;
  end;

  PEnumerateSecurityPackages = ^TEnumerateSecurityPackages;
  TEnumerateSecurityPackages = function(
    var pcPackages: Cardinal;       // receives the number of packages
    var ppPackageInfo: PSecPkgInfo  // receives array of information
  ): SECURITY_STATUS; stdcall;

  TQueryCredentialsAttributes = function(
    phCredential: PCredHandle;  // credential to query
    ulAttribute: Cardinal;      // attribute to query
    var pBuffer: Pointer        // buffer that receives attributes
  ): SECURITY_STATUS; stdcall;

  TQuerySecurityPackageInfo = function(
    pszPackageName: PChar;          // name of package
    var ppPackageInfo: PSecPkgInfo  // receives package information
  ): SECURITY_STATUS; stdcall;

  TFreeContextBuffer = function(
    pvContextBuffer: Pointer        // buffer to free
  ): SECURITY_STATUS; stdcall;

  TDeleteSecurityContext = function(
    phContext: PCtxtHandle         // handle of the context to delete
  ): SECURITY_STATUS; stdcall;

  TApplyControlToken = function(
    phContext: PCtxtHandle; // handle of the context to modify
    pInput: PSecBufferDesc  // input token to apply
  ): SECURITY_STATUS; stdcall;

  TQueryContextAttributes = function(
    phContext: PCtxtHandle;        // handle of the context to query
    ulAttribute: Cardinal;         // attribute to query
    pBuffer: Pointer              // buffer for attributes
  ): SECURITY_STATUS; stdcall;

  TImpersonateSecurityContext = function(
    phContext: PCtxtHandle // handle of the context to impersonate
  ): SECURITY_STATUS; stdcall;

  TRevertSecurityContext = function(
    phContext: PCtxtHandle // handle of the context being impersonated
  ): SECURITY_STATUS; stdcall;
  
  TFreeCredentialHandle = function(
    phContext: PCredHandle          // handle of the credential to delete
  ): SECURITY_STATUS; stdcall;

  TAcquireCredentialsHandle = function(
    pszPrincipal: PChar;              // name of principal
    pszPackage: PChar;                // name of package
    fCredentialUse: Cardinal;         // flags indicating use
    pvLogonID: PLUID;                 // pointer to logon identifier
    pAuthData: Pointer;               // package-specific data
    pGetKeyFn: Pointer;               // pointer to GetKey function
    pvGetKeyArgument: Pointer;        // value to pass to GetKey
    phCredential: PCredHandle;    // credential handle
    ptsExpiry: PTimeStamp         // lifetime of the returned credentials
  ): SECURITY_STATUS; stdcall;

  TInitializeSecurityContext = function(
    phCredential: PCredHandle;      // handle to the credentials
    phContext: PCtxtHandle;     // handle of partially formed context
    pszTargetName: PWideChar;           // name of the target of the context
    fContextReq: Cardinal;          // required context attributes
    Reserved1: Cardinal;            // reserved; must be zero
    TargetDataRep: Cardinal;        // data representation on the target
    pInput: PSecBufferDesc;     // pointer to the input buffers
    Reserved2: Cardinal;            // reserved; must be zero
    phNewContext: PCtxtHandle;  // receives the new context handle
    pOutput: PSecBufferDesc;    // pointer to the output buffers
    pfContextAttr: PCardinal;    // receives the context attributes
    ptsExpiry: PTimeStamp       // receives the life span of the security context
  ): SECURITY_STATUS; stdcall;

  TAcceptSecurityContext = function(
    phCredential: PCredHandle;      // handle to the credentials
    phContext: PCtxtHandle;     // handle of partially formed context
    pInput: PSecBufferDesc;     // pointer to the input buffers
    fContextReq: Cardinal;          // required context attributes
    fTargetDataRep: Cardinal;
    phNewContext: PCtxtHandle;  // receives the new context handle
    pOutput: PSecBufferDesc;    // pointer to the output buffers
    pfContextAttr: PCardinal;    // receives the context attributes
    ptsExpiry: PTimeStamp       // receives the life span of the security context
  ): SECURITY_STATUS; stdcall;
  
  TCompleteAuthToken = function(
    phContext: PCtxtHandle;         // handle of the context to complete
    pToken: PSecBufferDesc          // token to complete
  ): SECURITY_STATUS; stdcall;

  TEncryptMessage = function(
    phContext: PCtxtHandle;    // context to use
    fQOP: PCardinal;           // quality of protection
    pMessage: PSecBufferDesc;  // buffer containing the message to encrypt
    MessageSeqNo: Cardinal    // expected sequence number
  ): SECURITY_STATUS; stdcall;

  TDecryptMessage = function(
    phContext: PCtxtHandle;    // context to use
    pMessage: PSecBufferDesc;  // buffer containing the message to decrypt
    MessageSeqNo: Cardinal;    // expected sequence number
    pfQOP: PCardinal           // quality of protection
  ): SECURITY_STATUS; stdcall;

  PSecurityFunctionTable = ^TSecurityFunctionTable;
  TSecurityFunctionTable = record
    dwVersion: Cardinal;
    EnumerateSecurityPackages: TEnumerateSecurityPackages;
    QueryCredentialsAttributes: TQueryCredentialsAttributes;
    AcquireCredentialsHandle: TAcquireCredentialsHandle;
    FreeCredentialHandle: TFreeCredentialHandle;
    SspiLogonUserA: Pointer;
    InitializeSecurityContext: TInitializeSecurityContext;
    AcceptSecurityContext: TAcceptSecurityContext;
    CompleteAuthToken: TCompleteAuthToken;
    DeleteSecurityContext: TDeleteSecurityContext;
    ApplyControlToken: TApplyControlToken;
    QueryContextAttributes: TQueryContextAttributes;
    ImpersonateSecurityContext: TImpersonateSecurityContext;
    RevertSecurityContext: TRevertSecurityContext;
    MakeSignature: Pointer;
    VerifySignature: Pointer;
    FreeContextBuffer: TFreeContextBuffer;
    QuerySecurityPackageInfo: TQuerySecurityPackageInfo;
    SealMessage: TEncryptMessage;
    UnSealMessage: TDecryptMessage;
    ExportSecurityContext: Pointer;
    ImportSecurityContextA: Pointer;
    Reserved7: Pointer;
    Reserved8: Pointer;
    QuerySecurityContextToken: Pointer;
    EncryptMessage: TEncryptMessage;  // alias of SealMessage
    DecryptMessage: TDecryptMessage;  // alias of UnSealMessage
  end;

  PInitSecurityInterface = ^TInitSecurityInterface;
  TInitSecurityInterface = function: PSecurityFunctionTable; stdcall;

  TclSspiReturnCode = (rcOK, rcError,
    rcReAuthNeeded, rcAuthContinueNeeded, rcAuthDataNeeded, rcAuthMoreDataNeeded,
    rcCompleteNeeded, rcContinueNeeded, rcClosingNeeded,
    rcMoreDataNeeded, rcEncodeNeeded, rcContinueAndMoreDataNeeded, rcCredentialNeeded);

{$IFDEF LOGGER}
const
  clSspiReturnCodes: array[TclSspiReturnCode] of string = ('rcOK', 'rcError',
    'rcReAuthNeeded', 'rcAuthContinueNeeded', 'rcAuthDataNeeded', 'rcAuthMoreDataNeeded',
    'rcCompleteNeeded', 'rcContinueNeeded', 'rcClosingNeeded',
    'rcMoreDataNeeded', 'rcEncodeNeeded', 'rcContinueAndMoreDataNeeded', 'rcCredentialNeeded');
{$ENDIF}

type
  TclTlsFlag = (tfUseSSL2, tfUseSSL3, tfUseTLS);
  TclTlsFlags = set of TclTlsFlag;

  TclSspi = class
  private
    FDLLHandle: THandle;
    FFunctionTable: PSecurityFunctionTable;
    procedure InitFunctionTable;
    function GetFunctionTable: PSecurityFunctionTable;
  public
    constructor Create;
    destructor Destroy; override;
    property FunctionTable: PSecurityFunctionTable read GetFunctionTable;
  end;

  TclTlsSspi = class(TclSspi)
  private
    FNewConversation: Boolean;
    FPackageNo: Integer;
    FMaxToken: Cardinal;
    FCredHandle: TCredHandle;
    FCtxtHandle: TCtxtHandle;
    FStreamSizes: TSecPkgContext_StreamSizes;
    FStatusCode: SECURITY_STATUS;
    FPeerCertificate: TclCertificate;
    FCertified: Boolean;
    FCertificateFlags: TclCertificateFlags;
    FTLSFlags: TclTlsFlags;
    function GetStreamSizes: TSecPkgContext_StreamSizes;
    function GetMaxToken: Cardinal;
    function GetPackageName: string;
    function GetPackageNo: Integer;
    procedure InitPackage;
    procedure EnumerateSecurityPackages(var APackagesCount: Cardinal; var APackageInfoArray: PSecPkgInfo);
    procedure DeleteContext;
    procedure DeleteCredentials;
    function GenCredentials(ACertificate: TclCertificate; AllowEmptyCred: Boolean;
      ASecData: TSChannel_Cred; ACredentialUse: Cardinal): Boolean;
    procedure FreePeerCertificate;
  public
    constructor Create;
    destructor Destroy; override;
    function EndSession(ABuffer: TStream): TclSspiReturnCode; virtual; abstract;
    function GenContext(ABuffer: TStream; ACertificate: TclCertificate;
      AllowEmptyCred: Boolean): TclSspiReturnCode; virtual; abstract;
    function Encrypt(ASource, ADestination: TStream; ASourceSize: Integer): TclSspiReturnCode;
    function Decrypt(ASource, ADestination, AExtraBuffer: TStream): TclSspiReturnCode;
    property StreamSizes: TSecPkgContext_StreamSizes read GetStreamSizes;
    property PeerCertificate: TclCertificate read FPeerCertificate;
    property Certified: Boolean read FCertified;
    property StatusCode: SECURITY_STATUS read FStatusCode;
    property CertificateFlags: TclCertificateFlags read FCertificateFlags write FCertificateFlags;
    property TLSFlags: TclTlsFlags read FTLSFlags write FTLSFlags;
  end;

  TclTlsClientSspi = class(TclTlsSspi)
  private
    FTargetName: string;
    function VerifyServerCertificate: Boolean;
    function ContinueConversation(ASecData: TSChannel_Cred; ABuffer: TStream;
      ACertificate: TclCertificate; AllowEmptyCred: Boolean): TclSspiReturnCode;
    function NewConversation(ASecData: TSChannel_Cred; ABuffer: TStream): TclSspiReturnCode;
  public
    constructor Create(const ATargetName: string);
    function EndSession(ABuffer: TStream): TclSspiReturnCode; override;
    function GenContext(ABuffer: TStream; ACertificate: TclCertificate;
      AllowEmptyCred: Boolean): TclSspiReturnCode; override;
    property TargetName: string read FTargetName;
  end;

  TclTlsServerSspi = class(TclTlsSspi)
  private
    FRequireClientCertificate: Boolean;
    procedure GetClientCertificate;
  public
    constructor Create(ARequireClientCertificate: Boolean);
    function EndSession(ABuffer: TStream): TclSspiReturnCode; override;
    function GenContext(ABuffer: TStream; ACertificate: TclCertificate;
      AllowEmptyCred: Boolean): TclSspiReturnCode; override;
    property RequireClientCertificate: Boolean read FRequireClientCertificate;
  end;

const
  HEAP_NO_SERIALIZE        =       $00000001;
  HEAP_GENERATE_EXCEPTIONS =       $00000004;

  SCHANNEL_SHUTDOWN           = 1;
  SCHANNEL_CRED_VERSION       = 4;

  // SChannel credentials

  SCH_CRED_NO_SYSTEM_MAPPER                    = $00000002;
  SCH_CRED_NO_SERVERNAME_CHECK                 = $00000004;
  SCH_CRED_MANUAL_CRED_VALIDATION              = $00000008;
  SCH_CRED_NO_DEFAULT_CREDS                    = $00000010;
  SCH_CRED_AUTO_CRED_VALIDATION                = $00000020;
  SCH_CRED_USE_DEFAULT_CREDS                   = $00000040;

  SCH_CRED_REVOCATION_CHECK_END_CERT           = $00000100;