{
  $Project$
  $Workfile$
  $Revision$
  $DateUTC$
  $Id$

  This file is part of the Indy (Internet Direct) project, and is offered
  under the dual-licensing agreement described on the Indy website.
  (http://www.indyproject.org/)

  Copyright:
   (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
  $Log$
}
{
    Rev 1.3    6/11/2004 9:33:58 AM  DSiders
  Added "Do not Localize" comments.

  Rev 1.2    13.1.2004 ã. 17:26:06  DBondzhev
  Added Domain property

  Rev 1.1    4/12/2003 10:24:04 PM  GGrieve
  Fix to Compile

  Rev 1.0    11/14/2002 02:13:50 PM  JPMugaas
}

unit IdAuthenticationSSPI;

{
  Implementation of the NTLM authentication with SSPI
  Author: Alex Brainman
  Copyright: (c) Chad Z. Hower and The Winshoes Working Group.
}

{$DEFINE SET_ENCRYPT_IN_FT_WITH_GETPROCADDRESS_FUDGE}

interface

{$i IdCompilerDefines.inc}

uses
  IdGlobal,
  IdAuthentication,
  IdCoder,
  Windows,
  SysUtils,
  IdSSPI;

const
  SEC_E_OK                         = 0;
  {$EXTERNALSYM SEC_E_OK}
  SEC_E_INSUFFICIENT_MEMORY        = HRESULT($80090300);
  {$EXTERNALSYM SEC_E_INSUFFICIENT_MEMORY}
  SEC_E_INVALID_HANDLE             = HRESULT($80090301);
  {$EXTERNALSYM SEC_E_INVALID_HANDLE}
  SEC_E_UNSUPPORTED_FUNCTION       = HRESULT($80090302);
  {$EXTERNALSYM SEC_E_UNSUPPORTED_FUNCTION}
  SEC_E_TARGET_UNKNOWN             = HRESULT($80090303);
  {$EXTERNALSYM SEC_E_TARGET_UNKNOWN}
  SEC_E_INTERNAL_ERROR             = HRESULT($80090304);
  {$EXTERNALSYM SEC_E_INTERNAL_ERROR}
  SEC_E_SECPKG_NOT_FOUND           = HRESULT($80090305);
  {$EXTERNALSYM SEC_E_SECPKG_NOT_FOUND}
  SEC_E_NOT_OWNER                  = HRESULT($80090306);
  {$EXTERNALSYM SEC_E_NOT_OWNER}
  SEC_E_CANNOT_INSTALL             = HRESULT($80090307);
  {$EXTERNALSYM SEC_E_CANNOT_INSTALL}
  SEC_E_INVALID_TOKEN              = HRESULT($80090308);
  {$EXTERNALSYM SEC_E_INVALID_TOKEN}
  SEC_E_CANNOT_PACK                = HRESULT($80090309);
  {$EXTERNALSYM SEC_E_CANNOT_PACK}
  SEC_E_QOP_NOT_SUPPORTED          = HRESULT($8009030A);
  {$EXTERNALSYM SEC_E_QOP_NOT_SUPPORTED}
  SEC_E_NO_IMPERSONATION           = HRESULT($8009030B);
  {$EXTERNALSYM SEC_E_NO_IMPERSONATION}
  SEC_E_LOGON_DENIED               = HRESULT($8009030C);
  {$EXTERNALSYM SEC_E_LOGON_DENIED}
  SEC_E_UNKNOWN_CREDENTIALS        = HRESULT($8009030D);
  {$EXTERNALSYM SEC_E_UNKNOWN_CREDENTIALS}
  SEC_E_NO_CREDENTIALS             = HRESULT($8009030E);
  {$EXTERNALSYM SEC_E_NO_CREDENTIALS}
  SEC_E_MESSAGE_ALTERED            = HRESULT($8009030F);
  {$EXTERNALSYM SEC_E_MESSAGE_ALTERED}
  SEC_E_OUT_OF_SEQUENCE            = HRESULT($80090310);
  {$EXTERNALSYM SEC_E_OUT_OF_SEQUENCE}
  SEC_E_NO_AUTHENTICATING_AUTHORITY = HRESULT($80090311);
  {$EXTERNALSYM SEC_E_NO_AUTHENTICATING_AUTHORITY}
  SEC_I_CONTINUE_NEEDED            = HRESULT($00090312);
  {$EXTERNALSYM SEC_I_CONTINUE_NEEDED}
  SEC_I_COMPLETE_NEEDED            = HRESULT($00090313);
  {$EXTERNALSYM SEC_I_COMPLETE_NEEDED}
  SEC_I_COMPLETE_AND_CONTINUE      = HRESULT($00090314);
  {$EXTERNALSYM SEC_I_COMPLETE_AND_CONTINUE}
  SEC_I_LOCAL_LOGON                = HRESULT($00090315);
  {$EXTERNALSYM SEC_I_LOCAL_LOGON}
  SEC_E_BAD_PKGID                  = HRESULT($80090316);
  {$EXTERNALSYM SEC_E_BAD_PKGID}
  SEC_E_CONTEXT_EXPIRED            = HRESULT($80090317);
  {$EXTERNALSYM SEC_E_CONTEXT_EXPIRED}
  SEC_E_INCOMPLETE_MESSAGE         = HRESULT($80090318);
  {$EXTERNALSYM SEC_E_INCOMPLETE_MESSAGE}
  SEC_E_INCOMPLETE_CREDENTIALS     = HRESULT($80090320);
  {$EXTERNALSYM SEC_E_INCOMPLETE_CREDENTIALS}
  SEC_E_BUFFER_TOO_SMALL           = HRESULT($80090321);
  {$EXTERNALSYM SEC_E_BUFFER_TOO_SMALL}
  SEC_I_INCOMPLETE_CREDENTIALS     = HRESULT($00090320);
  {$EXTERNALSYM SEC_I_INCOMPLETE_CREDENTIALS}
  SEC_I_RENEGOTIATE                = HRESULT($00090321);
  {$EXTERNALSYM SEC_I_RENEGOTIATE}
  SEC_E_WRONG_PRINCIPAL            = HRESULT($80090322);
  {$EXTERNALSYM SEC_E_WRONG_PRINCIPAL}
  SEC_I_NO_LSA_CONTEXT             = HRESULT($00090323);
  {$EXTERNALSYM SEC_I_NO_LSA_CONTEXT}
  SEC_E_TIME_SKEW                  = HRESULT($80090324);
  {$EXTERNALSYM SEC_E_TIME_SKEW}
  SEC_E_UNTRUSTED_ROOT             = HRESULT($80090325);
  {$EXTERNALSYM SEC_E_UNTRUSTED_ROOT}
  SEC_E_ILLEGAL_MESSAGE            = HRESULT($80090326);
  {$EXTERNALSYM SEC_E_ILLEGAL_MESSAGE}
  SEC_E_CERT_UNKNOWN               = HRESULT($80090327);
  {$EXTERNALSYM SEC_E_CERT_UNKNOWN}
  SEC_E_CERT_EXPIRED               = HRESULT($80090328);
  {$EXTERNALSYM SEC_E_CERT_EXPIRED}
  SEC_E_ENCRYPT_FAILURE            = HRESULT($80090329);
  {$EXTERNALSYM SEC_E_ENCRYPT_FAILURE}
  SEC_E_DECRYPT_FAILURE            = HRESULT($80090330);
  {$EXTERNALSYM SEC_E_DECRYPT_FAILURE}
  SEC_E_ALGORITHM_MISMATCH         = HRESULT($80090331);
  {$EXTERNALSYM SEC_E_ALGORITHM_MISMATCH}
  SEC_E_SECURITY_QOS_FAILED        = HRESULT($80090332);
  {$EXTERNALSYM SEC_E_SECURITY_QOS_FAILED}
 
  SEC_E_UNFINISHED_CONTEXT_DELETED = HRESULT($80090333);
  {$EXTERNALSYM SEC_E_UNFINISHED_CONTEXT_DELETED}
  SEC_E_NO_TGT_REPLY               = HRESULT($80090334);
  {$EXTERNALSYM SEC_E_NO_TGT_REPLY}
  SEC_E_NO_IP_ADDRESSES            = HRESULT($80090335);
  {$EXTERNALSYM SEC_E_NO_IP_ADDRESSES}
  SEC_E_WRONG_CREDENTIAL_HANDLE    = HRESULT($80090336);
  {$EXTERNALSYM SEC_E_WRONG_CREDENTIAL_HANDLE}
  SEC_E_CRYPTO_SYSTEM_INVALID      = HRESULT($80090337);
  {$EXTERNALSYM SEC_E_CRYPTO_SYSTEM_INVALID}
  SEC_E_MAX_REFERRALS_EXCEEDED     = HRESULT($80090338);
  {$EXTERNALSYM SEC_E_MAX_REFERRALS_EXCEEDED}
  SEC_E_MUST_BE_KDC                = HRESULT($80090339);
  {$EXTERNALSYM SEC_E_MUST_BE_KDC}
  SEC_E_STRONG_CRYPTO_NOT_SUPPORTED = HRESULT($8009033A);
  {$EXTERNALSYM SEC_E_STRONG_CRYPTO_NOT_SUPPORTED}
  SEC_E_TOO_MANY_PRINCIPALS        = HRESULT($8009033B);
  {$EXTERNALSYM SEC_E_TOO_MANY_PRINCIPALS}
  SEC_E_NO_PA_DATA                 = HRESULT($8009033C);
  {$EXTERNALSYM SEC_E_NO_PA_DATA}
  SEC_E_PKINIT_NAME_MISMATCH       = HRESULT($8009033D);
  {$EXTERNALSYM SEC_E_PKINIT_NAME_MISMATCH}
  SEC_E_SMARTCARD_LOGON_REQUIRED   = HRESULT($8009033E);
  {$EXTERNALSYM SEC_E_SMARTCARD_LOGON_REQUIRED}
  SEC_E_SHUTDOWN_IN_PROGRESS       = HRESULT($8009033F);
  {$EXTERNALSYM SEC_E_SHUTDOWN_IN_PROGRESS}
  SEC_E_KDC_INVALID_REQUEST        = HRESULT($80090340);
  {$EXTERNALSYM SEC_E_KDC_INVALID_REQUEST}
  SEC_E_KDC_UNABLE_TO_REFER        = HRESULT($80090341);
  {$EXTERNALSYM SEC_E_KDC_UNABLE_TO_REFER}
  SEC_E_KDC_UNKNOWN_ETYPE          = HRESULT($80090342);
  {$EXTERNALSYM SEC_E_KDC_UNKNOWN_ETYPE}
  SEC_E_UNSUPPORTED_PREAUTH        = HRESULT($80090343);
  {$EXTERNALSYM SEC_E_UNSUPPORTED_PREAUTH}
  SEC_E_DELEGATION_REQUIRED        = HRESULT($80090345);
  {$EXTERNALSYM SEC_E_DELEGATION_REQUIRED}
  SEC_E_BAD_BINDINGS               = HRESULT($80090346);
  {$EXTERNALSYM SEC_E_BAD_BINDINGS}
  SEC_E_MULTIPLE_ACCOUNTS          = HRESULT($80090347);
  {$EXTERNALSYM SEC_E_MULTIPLE_ACCOUNTS}
  SEC_E_NO_KERB_KEY                = HRESULT($80090348);
  {$EXTERNALSYM SEC_E_NO_KERB_KEY}
  SEC_E_CERT_WRONG_USAGE           = HRESULT($80090349);
  {$EXTERNALSYM SEC_E_CERT_WRONG_USAGE}
  SEC_E_DOWNGRADE_DETECTED         = HRESULT($80090350);
  {$EXTERNALSYM SEC_E_DOWNGRADE_DETECTED}
  SEC_E_SMARTCARD_CERT_REVOKED     = HRESULT($80090351);
  {$EXTERNALSYM SEC_E_SMARTCARD_CERT_REVOKED}
  SEC_E_ISSUING_CA_UNTRUSTED       = HRESULT($80090352);
  {$EXTERNALSYM SEC_E_ISSUING_CA_UNTRUSTED}
  SEC_E_REVOCATION_OFFLINE_C       = HRESULT($80090353);
  {$EXTERNALSYM SEC_E_REVOCATION_OFFLINE_C}
  SEC_E_PKINIT_CLIENT_FAILURE      = HRESULT($80090354);
  {$EXTERNALSYM SEC_E_PKINIT_CLIENT_FAILURE}
  SEC_E_SMARTCARD_CERT_EXPIRED     = HRESULT($80090355);
  {$EXTERNALSYM SEC_E_SMARTCARD_CERT_EXPIRED}
  SEC_E_NO_S4U_PROT_SUPPORT        = HRESULT($80090356);
  {$EXTERNALSYM SEC_E_NO_S4U_PROT_SUPPORT}
  SEC_E_CROSSREALM_DELEGATION_FAILURE = HRESULT($80090357);
  {$EXTERNALSYM SEC_E_CROSSREALM_DELEGATION_FAILURE}
  SEC_E_REVOCATION_OFFLINE_KDC     = HRESULT($80090358);
  {$EXTERNALSYM SEC_E_REVOCATION_OFFLINE_KDC}
  SEC_E_ISSUING_CA_UNTRUSTED_KDC   = HRESULT($80090359);
  {$EXTERNALSYM SEC_E_ISSUING_CA_UNTRUSTED_KDC}
  SEC_E_KDC_CERT_EXPIRED           = HRESULT($8009035A);
  {$EXTERNALSYM SEC_E_KDC_CERT_EXPIRED}
  SEC_E_KDC_CERT_REVOKED           = HRESULT($8009035B);
  {$EXTERNALSYM SEC_E_KDC_CERT_REVOKED}
  SEC_I_SIGNATURE_NEEDED           = HRESULT($0009035C);
  {$EXTERNALSYM SEC_I_SIGNATURE_NEEDED}
  SEC_E_INVALID_PARAMETER          = HRESULT($8009035D);
  {$EXTERNALSYM SEC_E_INVALID_PARAMETER}
  SEC_E_DELEGATION_POLICY          = HRESULT($8009035E);
  {$EXTERNALSYM SEC_E_DELEGATION_POLICY}
  SEC_E_POLICY_NLTM_ONLY           = HRESULT($8009035F);
  {$EXTERNALSYM SEC_E_POLICY_NLTM_ONLY}
  SEC_I_NO_RENEGOTIATION           = HRESULT($00090360);
  {$EXTERNALSYM SEC_I_NO_RENEGOTIATION}
  SEC_E_NO_CONTEXT                 = HRESULT($80090361);
  {$EXTERNALSYM SEC_E_NO_CONTEXT}
  SEC_E_PKU2U_CERT_FAILURE         = HRESULT($80090362);
  {$EXTERNALSYM SEC_E_PKU2U_CERT_FAILURE}
  SEC_E_MUTUAL_AUTH_FAILED         = HRESULT($80090363);
  {$EXTERNALSYM SEC_E_MUTUAL_AUTH_FAILED}

type
  ESSPIException = class(Exception)
  public
    // Params must be in this order to avoid conflict with CreateHelp
    // constructor in CBuilder as CB does not differentiate constructors
    // by name as Delphi does
    constructor CreateError(const AErrorNo: Integer; const AFailedFuncName: string);
    //
    class function GetErrorMessageByNo(AErrorNo: UInt32): string;
  end;

  ESSPIInterfaceInitFailed = class(ESSPIException);

  { TSSPIInterface }

  TSSPIInterface = class(TObject)
  private
    fLoadPending, fIsAvailable: Boolean;
    fPFunctionTable: PSecurityFunctionTable;
    fDLLHandle: THandle;
    procedure ReleaseFunctionTable;
    procedure CheckAvailable;
    function GetFunctionTable: SecurityFunctionTable;
  public
    class procedure RaiseIfError(aStatus: SECURITY_STATUS; const aFunctionName: string);
    function IsAvailable: Boolean;
    property FunctionTable: SecurityFunctionTable read GetFunctionTable;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  { TSSPIPackages }

  TSSPIPackage = class(TObject)
  private
    fPSecPkginfo: PSecPkgInfo;
    function GetPSecPkgInfo: PSecPkgInfo;
    function GetMaxToken: ULONG;
    function GetName: {$IFDEF SSPI_UNICODE}TIdUnicodeString{$ELSE}AnsiString{$ENDIF};
  public
    property MaxToken: ULONG read GetMaxToken;
    property Name: {$IFDEF SSPI_UNICODE}TIdUnicodeString{$ELSE}AnsiString{$ENDIF} read GetName;
  public
    constructor Create(aPSecPkginfo: PSecPkgInfo);
  end;

  TCustomSSPIPackage = class(TSSPIPackage)
  private
    fInfo: PSecPkgInfo;
  public
    constructor Create(const aPkgName: {$IFDEF SSPI_UNICODE}TIdUnicodeString{$ELSE}AnsiString{$ENDIF});
    destructor Destroy; override;
  end;

  TSSPINTLMPackage = class(TCustomSSPIPackage)
  public
    constructor Create;
  end;

  { TSSPICredentials }

  TSSPICredentialsUse = (scuInBound, scuOutBound, scuBoth);

  TSSPICredentials = class(TObject)
  private
    fPackage: TSSPIPackage;
    fHandle: CredHandle;
    fUse: TSSPICredentialsUse;
    fAcquired: Boolean;
    fExpiry: TimeStamp;
    function GetHandle: PCredHandle;
    procedure SetUse(aValue: TSSPICredentialsUse);
  protected
    procedure CheckAcquired;
    procedure CheckNotAcquired;
    procedure DoAcquire(pszPrincipal: {$IFDEF SSPI_UNICODE}PSEC_WCHAR{$ELSE}PSEC_CHAR{$ENDIF}; pvLogonId, pAuthData: PVOID);
    procedure DoRelease; virtual;
  public
    procedure Release;
    property Package: TSSPIPackage read fPackage;
    property Handle: PCredHandle read GetHandle;
    property Use: TSSPICredentialsUse read fUse write SetUse;
    property Acquired: Boolean read fAcquired;
  public
    constructor Create(aPackage: TSSPIPackage);
    destructor Destroy; override;
  end;

  { TSSPIWinNTCredentials }

  TSSPIWinNTCredentials = class(TSSPICredentials)
  protected
  public
    procedure Acquire(aUse: TSSPICredentialsUse); overload;
    procedure Acquire(aUse: TSSPICredentialsUse;
      const aDomain, aUserName, aPassword: {$IFDEF SSPI_UNICODE}TIdUnicodeString{$ELSE}AnsiString{$ENDIF}); overload;
  end;

  { TSSPIContext }

  TSSPIContext = class(TObject)
  private
    fCredentials: TSSPICredentials;
    fHandle: CtxtHandle;
    fHasHandle: Boolean;
    fExpiry: TimeStamp;
    function GetHandle: PCtxtHandle;
    function GetExpiry: TimeStamp;
    procedure UpdateHasContextAndCheckForError(
      const aFuncResult: SECURITY_STATUS; const aFuncName: string;
      const aErrorsToIgnore: array of SECURITY_STATUS);
  protected
    procedure CheckHasHandle;
    procedure CheckCredentials;
    function DoInitialize(const aTokenSourceName: {$IFDEF SSPI_UNICODE}TIdUnicodeString{$ELSE}AnsiString{$ENDIF};
      var aIn, aOut: SecBufferDesc;
      const errorsToIgnore: array of SECURITY_STATUS): SECURITY_STATUS;
    procedure DoRelease; virtual;
    function GetRequestedFlags: ULONG; virtual; abstract;
    procedure SetEstablishedFlags(aFlags: ULONG); virtual; abstract;
    function GetAuthenticated: Boolean; virtual; abstract;
    property HasHandle: Boolean read fHasHandle;
  public
    procedure Release;
    property Credentials: TSSPICredentials read fCredentials;
    property Handle: PCtxtHandle read GetHandle;
    property Authenticated: Boolean read GetAuthenticated;
    property Expiry: TimeStamp read GetExpiry;
  public
    constructor Create(aCredentials: TSSPICredentials);
    destructor Destroy; override;
  end;

  { TSSPIConnectionContext }

  TCustomSSPIConnectionContext = class(TSSPIContext)
  private
    fStatus: SECURITY_STATUS;
    fOutBuffDesc, fInBuffDesc: SecBufferDesc;
    fInBuff: SecBuffer;
  protected
    procedure DoRelease; override;
    function GetAuthenticated: Boolean; override;
    function DoUpdateAndGenerateReply(var aIn, aOut: SecBufferDesc;
      const aErrorsToIgnore: array of SECURITY_STATUS
      ): SECURITY_STATUS; virtual; abstract;
  public
    constructor Create(ACredentials: TSSPICredentials);
    function UpdateAndGenerateReply(
      const aFromPeerToken: TIdBytes; var aToPeerToken: TIdBytes): Boolean;
  end;

  TSSPIClientConnectionContext = class(TCustomSSPIConnectionContext)
  private
    fTargetName: string;
    fReqReguested, fReqEstablished: ULONG;
  protected
    function GetRequestedFlags: ULONG; override;
    procedure SetEstablishedFlags(aFlags: ULONG); override;
    function DoUpdateAndGenerateReply(var aIn, aOut: SecBufferDesc;
      const aErrorsToIgnore: array of SECURITY_STATUS
      ): SECURITY_STATUS; override;
  public
    function GenerateInitialChallenge(const aTargetName: string;
      var aToPeerToken: TIdBytes): Boolean;
  public
    constructor Create(aCredentials: TSSPICredentials);
  end;

  TIndySSPINTLMClient = class(TObject)
  protected
    fNTLMPackage: TSSPINTLMPackage;
    fCredentials: TSSPIWinNTCredentials;
    fContext: TSSPIClientConnectionContext;
  public
    procedure SetCredentials(const aDomain, aUserName, aPassword: string);
    procedure SetCredentialsAsCurrentUser;
    function InitAndBuildType1Message: TIdBytes;
    function UpdateAndBuildType3Message(const aServerType2Message: TIdBytes): TIdBytes;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TIdSSPINTLMAuthentication = class(TIdAuthentication)
  protected
    FNTLMInfo: string;
    FSSPIClient: TIndySSPINTLMClient;
    procedure SetDomain(const Value: String);
    function GetDomain: String;
    procedure SetUserName(const Value: String); override;
    function GetSteps: Integer; override;
    function DoNext: TIdAuthWhatsNext; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    function Authentication: string; override;
    function KeepAlive: Boolean; override;
    property Domain: String read GetDomain write SetDomain;
  end;

  // RLebeau 4/17/10: this forces C++Builder to link to this unit so
  // RegisterAuthenticationMethod can be called correctly at program startup...

  {$IFDEF HAS_DIRECTIVE_HPPEMIT_LINKUNIT}
    {$HPPEMIT LINKUNIT}
  {$ELSE}
    {$HPPEMIT '#pragma link "IdAuthenticationSSPI"'}
  {$ENDIF}

implementation

uses
  IdGlobalCore,
  IdGlobalProtocols,
  IdException,
  IdCoderMIME,
  IdResourceStringsSSPI,
  IdHeaderList;

var
  gSSPIInterface: TSSPIInterface = nil;
  gAuthRegistered: Boolean = False;

{ ESSPIException }

class function ESSPIException.GetErrorMessageByNo(aErrorNo: UInt32): string;
begin
  case HRESULT(aErrorNo) of
    SEC_E_OK:
      Result := RSHTTPSSPISuccess;
    SEC_E_INSUFFICIENT_MEMORY:
      Result := RSHTTPSSPINotEnoughMem;
    SEC_E_INVALID_HANDLE:
      Result := RSHTTPSSPIInvalidHandle;
    SEC_E_UNSUPPORTED_FUNCTION:
      Result := RSHTTPSSPIFuncNotSupported;
    SEC_E_TARGET_UNKNOWN:
      Result := RSHTTPSSPIUnknownTarget;
    SEC_E_INTERNAL_ERROR:
      Result := RSHTTPSSPIInternalError;
    SEC_E_SECPKG_NOT_FOUND:
      Result :=  RSHTTPSSPISecPackageNotFound;
    SEC_E_NOT_OWNER:
      Result := RSHTTPSSPINotOwner;
    SEC_E_CANNOT_INSTALL:
      Result := RSHTTPSSPIPackageCannotBeInstalled;
    SEC_E_INVALID_TOKEN:
      Result := RSHTTPSSPIInvalidToken;
    SEC_E_CANNOT_PACK:
      Result := RSHTTPSSPICannotPack;
    SEC_E_QOP_NOT_SUPPORTED:
      Result := RSHTTPSSPIQOPNotSupported;
    SEC_E_NO_IMPERSONATION:
      Result := RSHTTPSSPINoImpersonation;
    SEC_E_LOGON_DENIED:
      Result := RSHTTPSSPILoginDenied;
    SEC_E_UNKNOWN_CREDENTIALS:
      Result := RSHTTPSSPIUnknownCredentials;
    SEC_E_NO_CREDENTIALS:
      Result := RSHTTPSSPINoCredentials;
    SEC_E_MESSAGE_ALTERED:
      Result := RSHTTPSSPIMessageAltered;
    SEC_E_OUT_OF_SEQUENCE:
      Result := RSHTTPSSPIOutOfSequence;
    SEC_E_NO_AUTHENTICATING_AUTHORITY:
      Result := RSHTTPSSPINoAuthAuthority;
    SEC_I_CONTINUE_NEEDED:
      Result := RSHTTPSSPIContinueNeeded;
    SEC_I_COMPLETE_NEEDED:
      Result := RSHTTPSSPICompleteNeeded;
    SEC_I_COMPLETE_AND_CONTINUE:
      Result :=RSHTTPSSPICompleteContinueNeeded;
    SEC_I_LOCAL_LOGON:
      Result := RSHTTPSSPILocalLogin;
    SEC_E_BAD_PKGID:
      Result := RSHTTPSSPIBadPackageID;
    SEC_E_CONTEXT_EXPIRED:
      Result := RSHTTPSSPIContextExpired;
    SEC_E_INCOMPLETE_MESSAGE:
      Result := RSHTTPSSPIIncompleteMessage;
    SEC_E_INCOMPLETE_CREDENTIALS:
      Result := RSHTTPSSPIIncompleteCredentialNotInit;
    SEC_E_BUFFER_TOO_SMALL:
      Result := RSHTTPSSPIBufferTooSmall;
    SEC_I_INCOMPLETE_CREDENTIALS:
      Result := RSHTTPSSPIIncompleteCredentialsInit;
    SEC_I_RENEGOTIATE:
      Result := RSHTTPSSPIRengotiate;
    SEC_E_WRONG_PRINCIPAL:
      Result := RSHTTPSSPIWrongPrincipal;
    SEC_I_NO_LSA_CONTEXT:
      Result := RSHTTPSSPINoLSACode;
    SEC_E_TIME_SKEW:
      Result := RSHTTPSSPITimeScew;
    SEC_E_UNTRUSTED_ROOT:
      Result := RSHTTPSSPIUntrustedRoot;
    SEC_E_ILLEGAL_MESSAGE:
      Result := RSHTTPSSPIIllegalMessage;
    SEC_E_CERT_UNKNOWN:
      Result := RSHTTPSSPICertUnknown;
    SEC_E_CERT_EXPIRED:
      Result := RSHTTPSSPICertExpired;
    SEC_E_ENCRYPT_FAILURE:
      Result := RSHTTPSSPIEncryptionFailure;
    SEC_E_DECRYPT_FAILURE:
      Result := RSHTTPSSPIDecryptionFailure;
    SEC_E_ALGORITHM_MISMATCH:
      Result := RSHTTPSSPIAlgorithmMismatch;
    SEC_E_SECURITY_QOS_FAILED:
      Result := RSHTTPSSPISecurityQOSFailure;
    SEC_E_UNFINISHED_CONTEXT_DELETED :
      Result := RSHTTPSSPISecCtxWasDelBeforeUpdated;
    SEC_E_NO_TGT_REPLY :
      Result := RSHTTPSSPIClientNoTGTReply;
    SEC_E_NO_IP_ADDRESSES :
      Result := RSHTTPSSPILocalNoIPAddr;
    SEC_E_WRONG_CREDENTIAL_HANDLE :
      Result := RSHTTPSSPIWrongCredHandle;
    SEC_E_CRYPTO_SYSTEM_INVALID :
      Result := RSHTTPSSPICryptoSysInvalid;
    SEC_E_MAX_REFERRALS_EXCEEDED :
      Result := RSHTTPSSPIMaxTicketRef;
    SEC_E_MUST_BE_KDC :
      Result := RSHTTPSSPIMustBeKDC;
    SEC_E_STRONG_CRYPTO_NOT_SUPPORTED :
      Result := RSHTTPSSPIStrongCryptoNotSupported;
    SEC_E_TOO_MANY_PRINCIPALS :
      Result := RSHTTPSSPIKDCReplyTooManyPrincipals;
    SEC_E_NO_PA_DATA :
      Result := RSHTTPSSPINoPAData;
    SEC_E_PKINIT_NAME_MISMATCH :
      Result := RSHTTPSSPIPKInitNameMismatch;
    SEC_E_SMARTCARD_LOGON_REQUIRED :
      Result := RSHTTPSSPISmartcardLogonReq;
    SEC_E_SHUTDOWN_IN_PROGRESS :
      Result := RSHTTPSSPISysShutdownInProg;
    SEC_E_KDC_INVALID_REQUEST :
      Result := RSHTTPSSPIKDCInvalidRequest;
    SEC_E_KDC_UNABLE_TO_REFER :
      Result := RSHTTPSSPIKDCUnableToRefer;
    SEC_E_KDC_UNKNOWN_ETYPE :
      Result := RSHTTPSSPIKDCETypeUnknown;
    SEC_E_UNSUPPORTED_PREAUTH :
      Result := RSHTTPSSPIUnsupPreauth;
    SEC_E_DELEGATION_REQUIRED :
      Result := RSHTTPSSPIDeligationReq;
    SEC_E_BAD_BINDINGS :
      Result := RSHTTPSSPIBadBindings;
    SEC_E_MULTIPLE_ACCOUNTS :
      Result := RSHTTPSSPIMultipleAccounts;
    SEC_E_NO_KERB_KEY :
      Result := RSHTTPSSPINoKerbKey;
    SEC_E_CERT_WRONG_USAGE :
      Result := RSHTTPSSPICertWrongUsage;
    SEC_E_DOWNGRADE_DETECTED :
      Result := RSHTTPSSPIDowngradeDetected;
    SEC_E_SMARTCARD_CERT_REVOKED :
      Result := RSHTTPSSPISmartcardCertRevoked;
    SEC_E_ISSUING_CA_UNTRUSTED :
      Result := RSHTTPSSPIIssuingCAUntrusted;
    SEC_E_REVOCATION_OFFLINE_C :
      Result := RSHTTPSSPIRevocationOffline;
    SEC_E_PKINIT_CLIENT_FAILURE :
      Result := RSHTTPSSPIPKInitClientFailure;
    SEC_E_SMARTCARD_CERT_EXPIRED :
      Result := RSHTTPSSPISmartcardExpired;
    SEC_E_NO_S4U_PROT_SUPPORT :
      Result := RSHTTPSSPINoS4UProtSupport;
    SEC_E_CROSSREALM_DELEGATION_FAILURE :
      Result := RSHTTPSSPICrossRealmDeligationFailure;
    SEC_E_REVOCATION_OFFLINE_KDC :
      Result := RSHTTPSSPIRevocationOfflineKDC;
    SEC_E_ISSUING_CA_UNTRUSTED_KDC :
      Result := RSHTTPSSPICAUntrustedKDC;
    SEC_E_KDC_CERT_EXPIRED :
      Result := RSHTTPSSPIKDCCertExpired;
    SEC_E_KDC_CERT_REVOKED :
      Result := RSHTTPSSPIKDCCertRevoked;
    SEC_I_SIGNATURE_NEEDED :
      Result := RSHTTPSSPISignatureNeeded;
    SEC_E_INVALID_PARAMETER :
      Result := RSHTTPSSPIInvalidParameter;
    SEC_E_DELEGATION_POLICY :
      Result := RSHTTPSSPIDeligationPolicy;
    SEC_E_POLICY_NLTM_ONLY :
      Result := RSHTTPSSPIPolicyNTLMOnly;
    SEC_I_NO_RENEGOTIATION :
      Result := RSHTTPSSPINoRenegotiation;
    SEC_E_NO_CONTEXT :
      Result := RSHTTPSSPINoContext;
    SEC_E_PKU2U_CERT_FAILURE :
      Result := RSHTTPSSPIPKU2UCertFailure;
    SEC_E_MUTUAL_AUTH_FAILED :
      Result := RSHTTPSSPIMutualAuthFailed;
  else
    Result := RSHTTPSSPIUnknwonError;
  end;
end;

constructor ESSPIException.CreateError(const AErrorNo: Integer; const AFailedFuncName: string);
begin
  if AErrorNo = SEC_E_OK then begin
    inherited Create(AFailedFuncName);
  end else begin
    inherited CreateFmt(RSHTTPSSPIErrorMsg,
      [AFailedFuncName, AErrorNo, AErrorNo, GetErrorMessageByNo(AErrorNo)]);
  end;
end;

{ TSSPIInterface }

procedure TSSPIInterface.ReleaseFunctionTable;
begin
  if fPFunctionTable <> nil then begin
    fPFunctionTable := nil;
  end;
end;

procedure TSSPIInterface.CheckAvailable;
begin
  if not IsAvailable then begin
    raise ESSPIInterfaceInitFailed.Create(RSHTTPSSPIInterfaceInitFailed);
  end;
end;

function TSSPIInterface.GetFunctionTable: SecurityFunctionTable;
begin
  CheckAvailable;
  Result := fPFunctionTable^;
end;

class procedure TSSPIInterface.RaiseIfError(aStatus: SECURITY_STATUS;
  const aFunctionName: string);
begin
  if not SEC_SUCCESS(aStatus) then begin
    raise ESSPIException.CreateError(aStatus, aFunctionName);
  end;
end;

function TSSPIInterface.IsAvailable: Boolean;

  procedure LoadDLL;
  const
    SECURITY_DLL_NT = 'security.dll';    {Do not translate}
    SECURITY_DLL_95 = 'secur32.dll';   {Do not translate}
    ENCRYPT_MESSAGE = 'EncryptMessage';   {Do not translate}
    DECRYPT_MESSAGE = 'DecryptMessage';    {Do not translate}
  var
    dllName: string;
    entrypoint: INIT_SECURITY_INTERFACE;
  begin
    fIsAvailable := False;
    if IndyWindowsPlatform = VER_PLATFORM_WIN32_WINDOWS then
      { Windows95 SSPI dll }
      dllName := SECURITY_DLL_95
    else
      { WindowsNT & Windows2000 SSPI dll }
      dllName := SECURITY_DLL_NT;
    { load SSPI dll }
    //In Windows, you should use SafeLoadLibrary instead of the LoadLibrary API
    //call because LoadLibrary messes with the FPU control word.
    fDLLHandle := SafeLoadLibrary(dllName);
    if fDLLHandle > 0 then begin
      { get InitSecurityInterface entry point
        and call it to fetch SPPI function table}
      entrypoint := GetProcAddress(fDLLHandle, SECURITY_ENTRYPOINT);
      fPFunctionTable := entrypoint();
      { let's see what SSPI functions are available
        and if we can continue on with the set }
      fIsAvailable :=
        Assigned({$IFDEF SSPI_UNICODE}fPFunctionTable^.QuerySecurityPackageInfoW{$ELSE}fPFunctionTable^.QuerySecurityPackageInfoA{$ENDIF}) and
        Assigned(fPFunctionTable^.FreeContextBuffer) and
        Assigned(fPFunctionTable^.DeleteSecurityContext) and
        Assigned(fPFunctionTable^.FreeCredentialsHandle) and
        Assigned({$IFDEF SSPI_UNICODE}fPFunctionTable^.AcquireCredentialsHandleW{$ELSE}fPFunctionTable^.AcquireCredentialsHandleA{$ENDIF}) and
        Assigned({$IFDEF SSPI_UNICODE}fPFunctionTable^.InitializeSecurityContextW{$ELSE}fPFunctionTable^.InitializeSecurityContextA{$ENDIF}) and
        Assigned(fPFunctionTable^.AcceptSecurityContext) and
        Assigned(fPFunctionTable^.ImpersonateSecurityContext) and
        Assigned(fPFunctionTable^.RevertSecurityContext) and
        Assigned({$IFDEF SSPI_UNICODE}fPFunctionTable^.QueryContextAttributesW{$ELSE}fPFunctionTable^.QueryContextAttributesA{$ENDIF}) and
        Assigned(fPFunctionTable^.MakeSignature) and
        Assigned(fPFunctionTable^.VerifySignature);
      {$IFDEF SET_ENCRYPT_IN_FT_WITH_GETPROCADDRESS_FUDGE}
      { fudge for Encrypt/DecryptMessage }
      if not Assigned(fPFunctionTable^.EncryptMessage) then begin
        fPFunctionTable^.EncryptMessage := GetProcAddress(fDLLHandle, ENCRYPT_MESSAGE);
      end;
      if not Assigned(fPFunctionTable^.DecryptMessage) then begin
        fPFunctionTable^.DecryptMessage := GetProcAddress(fDLLHandle, DECRYPT_MESSAGE);
      end;
      {$ENDIF}
    end;
  end;

begin
  if not fIsAvailable then begin
    if fLoadPending then begin
      ReleaseFunctionTable;
      LoadDLL;
      fLoadPending := False;
    end;
  end;
  Result := fIsAvailable;
end;

constructor TSSPIInterface.Create;
begin
  inherited Create;
  fLoadPending := True;
  fIsAvailable := False;
  fPFunctionTable := nil;
end;

destructor TSSPIInterface.Destroy;
begin
  ReleaseFunctionTable;
  FreeLibrary(fDLLHandle);
  inherited Destroy;
end;

{ TSSPIPackage }

constructor TSSPIPackage.Create(aPSecPkginfo: PSecPkgInfo);
begin
  inherited Create;
  fPSecPkginfo := aPSecPkginfo;
end;

function TSSPIPackage.GetPSecPkgInfo: PSecPkgInfo;
begin
  if not Assigned(fPSecPkginfo) then begin
    raise ESSPIException.Create(RSHTTPSSPINoPkgInfoSpecified);
  end;
  Result := fPSecPkginfo;
end;

function TSSPIPackage.GetMaxToken: ULONG;
begin
  Result := GetPSecPkgInfo^.cbMaxToken;
end;

function TSSPIPackage.GetName: {$IFDEF SSPI_UNICODE}TIdUnicodeString{$ELSE}AnsiString{$ENDIF};
begin
  Result := GetPSecPkgInfo^.Name;
end;

{ TCustomSSPIPackage }

constructor TCustomSSPIPackage.Create(const aPkgName: {$IFDEF SSPI_UNICODE}TIdUnicodeString{$ELSE}AnsiString{$ENDIF});
begin
  gSSPIInterface.RaiseIfError(
    {$IFDEF SSPI_UNICODE}
    gSSPIInterface.FunctionTable.QuerySecurityPackageInfoW(PWideChar(aPkgName), @fInfo),
    'QuerySecurityPackageInfoW' {Do not translate}
    {$ELSE}
    gSSPIInterface.FunctionTable.QuerySecurityPackageInfoA(PAnsiChar(aPkgName), @fInfo),
    'QuerySecurityPackageInfoA' {Do not translate}
    {$ENDIF}
    );
  inherited Create(fInfo);
end;

destructor TCustomSSPIPackage.Destroy;
begin
  if fInfo <> nil then begin
    gSSPIInterface.RaiseIfError(
      gSSPIInterface.FunctionTable.FreeContextBuffer(fInfo), 'FreeContextBuffer');  {Do not localize}
  end;
  inherited Destroy;
end;

{ TSSPINTLMPackage }

constructor TSSPINTLMPackage.Create;
begin
  inherited Create(NTLMSP_NAME);
end;

{ TSSPICredentials }

constructor TSSPICredentials.Create(aPackage: TSSPIPackage);
begin
  inherited Create;
  fPackage := aPackage;
  fUse := scuOutBound;
  fAcquired := False;
end;

procedure TSSPICredentials.CheckAcquired;
begin
  if not fAcquired then begin
    raise ESSPIException.Create(RSHTTPSSPINoCredentialHandle);
  end;
end;

procedure TSSPICredentials.CheckNotAcquired;
begin
  if fAcquired then begin
    raise ESSPIException.Create(RSHTTPSSPICanNotChangeCredentials);
  end;
end;

procedure TSSPICredentials.DoAcquire
  (pszPrincipal: {$IFDEF SSPI_UNICODE}PSEC_WCHAR{$ELSE}PSEC_CHAR{$ENDIF}; pvLogonId, pAuthData: PVOID);
var
  cu: ULONG;
begin
  Release;
  case Use of
    scuInBound:
      cu := SECPKG_CRED_INBOUND;
    scuOutBound:
      cu := SECPKG_CRED_OUTBOUND;
    scuBoth:
      cu := SECPKG_CRED_BOTH;
  else
    raise ESSPIException.Create(RSHTTPSSPIUnknwonCredentialUse);
  end;
  gSSPIInterface.RaiseIfError(
    gSSPIInterface.FunctionTable.{$IFDEF SSPI_UNICODE}AcquireCredentialsHandleW{$ELSE}AcquireCredentialsHandleA{$ENDIF}(
    pszPrincipal, {$IFDEF SSPI_UNICODE}PSEC_WCHAR{$ELSE}PSEC_CHAR{$ENDIF}(Package.Name), cu, pvLogonId, pAuthData, nil, nil,
    @fHandle, @fExpiry),
    {$IFDEF SSPI_UNICODE}
    'AcquireCredentialsHandleW' {Do not translater}
    {$ELSE}
    'AcquireCredentialsHandleA' {Do not translater}
    {$ENDIF}
    );
  fAcquired := True;
end;

procedure TSSPICredentials.DoRelease;
begin
  gSSPIInterface.RaiseIfError(
    gSSPIInterface.FunctionTable.FreeCredentialsHandle(@fHandle),
    'FreeCredentialsHandle');      {Do not translate}
  SecInvalidateHandle(fHandle);
end;

procedure TSSPICredentials.Release;
begin
  if fAcquired then begin
    DoRelease;
    fAcquired := False;
  end;
end;

function TSSPICredentials.GetHandle: PCredHandle;
begin
  CheckAcquired;
  Result := @fHandle;
end;

procedure TSSPICredentials.SetUse(aValue: TSSPICredentialsUse);
begin
  if fUse <> aValue then begin
    CheckNotAcquired;
    fUse := aValue;
  end;
end;

destructor TSSPICredentials.Destroy;
begin
  Release;
  inherited Destroy;
end;

{ TSSPIWinNTCredentials }

procedure TSSPIWinNTCredentials.Acquire(aUse: TSSPICredentialsUse);
begin
  Acquire(aUse, '', '', '');          {Do not translate}
end;

procedure TSSPIWinNTCredentials.Acquire(aUse: TSSPICredentialsUse;
  const aDomain, aUserName, aPassword: {$IFDEF SSPI_UNICODE}TIdUnicodeString{$ELSE}AnsiString{$ENDIF});
var
  ai: SEC_WINNT_AUTH_IDENTITY;
  pai: PVOID;
begin
  Use := aUse;
  if (Length(aDomain) > 0) and (Length(aUserName) > 0) then begin
    {$IFDEF SSPI_UNICODE}
    ai.User := PUSHORT(PWideChar(aUserName));
    ai.UserLength := Length(aUserName);
    ai.Domain := PUSHORT(PWideChar(aDomain));
    ai.DomainLength := Length(aDomain);
    ai.Password := PUSHORT(PWideChar(aPassword));
    ai.PasswordLength := Length(aPassword);
    ai.Flags := SEC_WINNT_AUTH_IDENTITY_UNICODE;
    {$ELSE}
    ai.User := PUCHAR(PAnsiChar(aUserName));
    ai.UserLength := Length(aUserName);
    ai.Domain := PUCHAR(PAnsiChar(aDomain));
    ai.DomainLength := Length(aDomain);
    ai.Password := PUCHAR(PAnsiChar(aPassword));
    ai.PasswordLength := Length(aPassword);
    ai.Flags := SEC_WINNT_AUTH_IDENTITY_ANSI;
    {$ENDIF}
    pai := @ai;
  end else
  begin
    pai := nil;
  end;
  DoAcquire(nil, nil, pai);
end;

{ TSSPIContext }

constructor TSSPIContext.Create(aCredentials: TSSPICredentials);
begin
  inherited Create;
  fCredentials := aCredentials;
  fHasHandle := False;
end;

destructor TSSPIContext.Destroy;
begin
  Release;
  inherited Destroy;
end;

procedure TSSPIContext.UpdateHasContextAndCheckForError(
  const aFuncResult: SECURITY_STATUS; const aFuncName: string;
  const aErrorsToIgnore: array of SECURITY_STATUS);
var
  doRaise: Boolean;
  i: Integer;
begin
  doRaise := not SEC_SUCCESS(aFuncResult);
  if doRaise then begin
    for i := Low(aErrorsToIgnore) to High(aErrorsToIgnore) do begin
      if aFuncResult = aErrorsToIgnore[i] then begin
        doRaise := False;
        Break;
      end;
    end;
  end;
  if doRaise then begin
    raise ESSPIException.CreateError(aFuncResult, aFuncName);
  end;
  fHasHandle := True;
end;

function TSSPIContext.DoInitialize(const aTokenSourceName: {$IFDEF SSPI_UNICODE}TIdUnicodeString{$ELSE}AnsiString{$ENDIF};
  var aIn, aOut: SecBufferDesc;
  const errorsToIgnore: array of SECURITY_STATUS): SECURITY_STATUS;
var
  tmp: PCtxtHandle;
  tmp2: PSecBufferDesc;
  r: ULONG;
begin
  if fHasHandle then begin
    tmp := @fHandle;
    tmp2 := @aIn;
  end else begin
    tmp := nil;
    tmp2 := nil;
  end;
  Result :=
    gSSPIInterface.FunctionTable.{$IFDEF SSPI_UNICODE}InitializeSecurityContextW{$ELSE}InitializeSecurityContextA{$ENDIF}(
    Credentials.Handle, tmp,
    {$IFDEF SSPI_UNICODE}PWideChar{$ELSE}PAnsiChar{$ENDIF}(aTokenSourceName),
    GetRequestedFlags, 0, SECURITY_NATIVE_DREP, tmp2, 0,
    @fHandle, @aOut, @r, @fExpiry
    );
  UpdateHasContextAndCheckForError(Result,
    {$IFDEF SSPI_UNICODE}'InitializeSecurityContextW'{$ELSE}'InitializeSecurityContextA'{$ENDIF}, {Do not translate}
    errorsToIgnore);
  SetEstablishedFlags(r);
end;

procedure TSSPIContext.DoRelease;
begin
  gSSPIInterface.RaiseIfError(
    gSSPIInterface.FunctionTable.DeleteSecurityContext(@fHandle), 'DeleteSecurityContext'); {Do not translate}
end;

procedure TSSPIContext.Release;
begin
  if HasHandle then begin
    DoRelease;
    fHasHandle := False;
  end;
end;

procedure TSSPIContext.CheckHasHandle;
begin
  if not HasHandle then begin
    raise ESSPIException.Create(RSHTTPSSPINoCredentialHandle);
  end;
end;

procedure TSSPIContext.CheckCredentials;
begin
  if (not Assigned(Credentials)) or (not Credentials.Acquired) then begin
    raise ESSPIException.Create(RSHTTPSSPIDoAuquireCredentialHandle);
  end;
end;

function TSSPIContext.GetExpiry: TimeStamp;
begin
  CheckHasHandle;
  Result := fExpiry;
end;

function TSSPIContext.GetHandle: PCtxtHandle;
begin
  CheckHasHandle;
  Result := @fHandle;
end;

{ TCustomSSPIConnectionContext }

procedure TCustomSSPIConnectionContext.DoRelease;
begin
  inherited DoRelease;
  fStatus := SEC_E_INVALID_HANDLE; // just to put something other then SEC_E_OK
end;

function TCustomSSPIConnectionContext.GetAuthenticated: Boolean;
begin
  CheckHasHandle;
  Result := fStatus = SEC_E_OK;
end;

function TCustomSSPIConnectionContext.UpdateAndGenerateReply
  (const aFromPeerToken: TIdBytes; var aToPeerToken: TIdBytes): Boolean;
var
  fOutBuff: SecBuffer;
begin
  Result := False;

  { check credentials }
  CheckCredentials;
  { prepare input buffer }

  fInBuff.cbBuffer := Length(aFromPeerToken);

  //Assert(Length(aFromPeerToken)>0);
  if fInBuff.cbBuffer > 0 then begin
    fInBuff.pvBuffer := @aFromPeerToken[0];
  end;

  { prepare output buffer }
  fOutBuff.BufferType := SECBUFFER_TOKEN;
  fOutBuff.cbBuffer := Credentials.Package.MaxToken;
  fOutBuff.pvBuffer := AllocMem(fOutBuff.cbBuffer);

  fOutBuffDesc.ulVersion := SECBUFFER_VERSION;
  fOutBuffDesc.cBuffers := 1;
  fOutBuffDesc.pBuffers := @fOutBuff;

  try
    { do processing }
    fStatus := DoUpdateAndGenerateReply(fInBuffDesc, fOutBuffDesc, []);
    { complete token if applicable }
    case fStatus of
      SEC_I_COMPLETE_NEEDED,
        SEC_I_COMPLETE_AND_CONTINUE:
        begin
          if not Assigned(gSSPIInterface.FunctionTable.CompleteAuthToken) then begin
            raise ESSPIException.Create(RSHTTPSSPICompleteTokenNotSupported);
          end;
          fStatus := gSSPIInterface.FunctionTable.CompleteAuthToken(Handle, @fOutBuffDesc);
          gSSPIInterface.RaiseIfError(fStatus, 'CompleteAuthToken');   {Do not translate}
        end;
    end;
    Result :=
      (fStatus = SEC_I_CONTINUE_NEEDED) or
      (fStatus = SEC_I_COMPLETE_AND_CONTINUE) or
      (fOutBuff.cbBuffer > 0);
    if Result then begin
      aToPeerToken := RawToBytes(fOutBuff.pvBuffer^, fOutBuff.cbBuffer);
    end;
  finally
    FreeMem(fOutBuff.pvBuffer);
  end;
end;

constructor TCustomSSPIConnectionContext.Create(aCredentials: TSSPICredentials);
begin
  inherited Create(aCredentials);

  fInBuff.BufferType := SECBUFFER_TOKEN;

  fInBuffDesc.ulVersion := SECBUFFER_VERSION;
  fInBuffDesc.cBuffers := 1;
  fInBuffDesc.pBuffers := @fInBuff;

  fOutBuffDesc.ulVersion := SECBUFFER_VERSION;
  fOutBuffDesc.cBuffers := 1;
end;

{ TSSPIClientConnectionContext }

constructor TSSPIClientConnectionContext.Create(aCredentials: TSSPICredentials);
begin
  inherited Create(aCredentials);
  fTargetName := '';   {Do not translate}
end;

function TSSPIClientConnectionContext.GetRequestedFlags: ULONG;
begin
  Result := fReqReguested;
end;

procedure TSSPIClientConnectionContext.SetEstablishedFlags(aFlags: ULONG);
begin
  fReqEstablished := aFlags;
end;

function TSSPIClientConnectionContext.DoUpdateAndGenerateReply
  (var aIn, aOut: SecBufferDesc;
  const aErrorsToIgnore: array of SECURITY_STATUS): SECURITY_STATUS;
begin
  Result := DoInitialize(fTargetName, aIn, aOut, []);
end;

function TSSPIClientConnectionContext.GenerateInitialChallenge
  (const aTargetName: string; var aToPeerToken: TIdBytes): Boolean;
begin
  Release;
  fTargetName := aTargetName;
  Result := UpdateAndGenerateReply(nil, aToPeerToken);   {Do not translate}
end;

{ TIndySSPINTLMClient }

constructor TIndySSPINTLMClient.Create;
begin
  inherited Create;
  fNTLMPackage := TSSPINTLMPackage.Create;
  fCredentials := TSSPIWinNTCredentials.Create(fNTLMPackage);
  fContext := TSSPIClientConnectionContext.Create(fCredentials);
end;

destructor TIndySSPINTLMClient.Destroy;
begin
  FreeAndNil(fContext);
  FreeAndNil(fCredentials);
  FreeAndNil(fNTLMPackage);
  inherited Destroy;
end;

procedure TIndySSPINTLMClient.SetCredentials(const aDomain, aUserName, aPassword: string);
begin
  fCredentials.Acquire(scuOutBound, aDomain, aUserName, aPassword);
end;

procedure TIndySSPINTLMClient.SetCredentialsAsCurrentUser;
begin
  fCredentials.Acquire(scuOutBound);
end;

function TIndySSPINTLMClient.InitAndBuildType1Message: TIdBytes;
begin
  fContext.GenerateInitialChallenge('', Result);
end;

function TIndySSPINTLMClient.UpdateAndBuildType3Message(const aServerType2Message: TIdBytes): TIdBytes;
begin
  fContext.UpdateAndGenerateReply(aServerType2Message, Result);
end;

{ TIdSSPINTLMAuthentication }

constructor TIdSSPINTLMAuthentication.Create;
begin
  inherited Create;
  FSSPIClient := TIndySSPINTLMClient.Create;
  Domain := IndyComputerName;
end;

function TIdSSPINTLMAuthentication.DoNext: TIdAuthWhatsNext;
begin
  Result := wnDoRequest;
  case FCurrentStep of
    0:
      begin
        {if (Length(Username) > 0) and (Length(Password) > 0) then
        begin}
        Result := wnDoRequest;
        FCurrentStep := 1;
        {end
        else begin
          result := wnAskTheProgram;
        end;}
      end;
    1:
      begin
        FCurrentStep := 2;
        Result := wnDoRequest;
      end;
    //Authentication does the 2>3 progression
    3:
      begin
        FCurrentStep := 4;
        Result := wnDoRequest;
      end;
    4:
      begin
        FCurrentStep := 0;
        if Username = '' then begin
          Result := wnAskTheProgram;
        end else begin
          Result := wnFail;
          Username := '';
          Password := '';
          Domain := IndyComputerName;
        end;
      end;
  end;
end;

function TIdSSPINTLMAuthentication.Authentication: string;
var
  buf: TIdBytes;
begin
  Result := '';
  buf := nil;
  case FCurrentStep of
    1:
      begin
        if Length(Username) = 0 then begin
          FSSPIClient.SetCredentialsAsCurrentUser;
        end else begin
          FSSPIClient.SetCredentials(Domain, Username, Password);
        end;
        Result := 'NTLM ' + TIdEncoderMIME.EncodeBytes(FSSPIClient.InitAndBuildType1Message);  {Do not translate}
        FNTLMInfo := '';    {Do not translate}
      end;
    2:
      begin
        if Length(FNTLMInfo) = 0 then begin
          FNTLMInfo := ReadAuthInfo('NTLM');  {Do not translate}
          Fetch(FNTLMInfo);
        end;

        if Length(FNTLMInfo) = 0 then begin
          Reset;
          Abort;
        end;

        buf := TIdDecoderMIME.DecodeBytes(FNTLMInfo);
        Result := 'NTLM ' + TIdEncoderMIME.EncodeBytes(FSSPIClient.UpdateAndBuildType3Message(buf));  {Do not translate}

        FCurrentStep := 3;
      end;
    3: begin
        FCurrentStep := 4;
      end;
  end;
end;

function TIdSSPINTLMAuthentication.KeepAlive: Boolean;
begin
  Result := FCurrentStep >= 1;
end;

function TIdSSPINTLMAuthentication.GetSteps: Integer;
begin
  Result := 3;
end;

procedure TIdSSPINTLMAuthentication.SetDomain(const Value: String);
begin
  Params.Values['Domain'] := Value; {do not localize}
end;

function TIdSSPINTLMAuthentication.GetDomain: String;
begin
  Result := Params.Values['Domain']; {do not localize}
end;

procedure TIdSSPINTLMAuthentication.SetUserName(const Value: String);
Var
  S: String;
begin
  S := Value;
  if IndyPos('\', S) > 0 then begin
    Domain := Copy(S, 1, IndyPos('\', S) - 1);
    Delete(S, 1, Length(Domain) + 1);
  end;
  inherited SetUserName(S);
end;

destructor TIdSSPINTLMAuthentication.Destroy;
begin
  FreeAndNil(FSSPIClient);
  inherited;
end;

initialization
  gSSPIInterface := TSSPIInterface.Create;
  if gSSPIInterface.IsAvailable then begin
    RegisterAuthenticationMethod('NTLM', TIdSSPINTLMAuthentication); {do not localize}
    RegisterAuthenticationMethod('Negotiate', TIdSSPINTLMAuthentication); {do not localize}
    gAuthRegistered := True;
  end;
finalization
  if gAuthRegistered then begin
    UnregisterAuthenticationMethod('NTLM'); {do not localize}
    UnregisterAuthenticationMethod('Negotiate'); {do not localize}
  end;
  FreeAndNil(gSSPIInterface);

end.