restemplate/indy/Protocols/IdSASL_NTLM.pas

116 lines
3.8 KiB
Plaintext

unit IdSASL_NTLM;
interface
{$i IdCompilerDefines.inc}
uses
IdGlobal,
IdSASL,
IdSASLUserPass;
const
DEF_LMCompatibility = 0;
type
TIdSASLNTLM = class(TIdSASLUserPass)
protected
FDomain : String;
FLMCompatibility : UInt32;
procedure InitComponent; override;
public
class function ServiceName: TIdSASLServiceName; override;
function TryStartAuthenticate(const AHost, AProtocolName: string; var VInitialResponse: string): Boolean; override;
function StartAuthenticate(const AChallenge, AHost, AProtocolName:string) : String; override;
function ContinueAuthenticate(const ALastResponse, AHost, AProtocolName: String): string; override;
function IsReadyToStart: Boolean; override;
property Domain : String read FDomain write FDomain;
{
The LMCompatibility property is designed to work directly with the "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\LSA\LMCompatibilityLevel"
and will act as this key is documented. This effects how NTLM authentication
is done on the server. We do not pull the value from the registry because other systems
don't have a registry and you may want to set this to a value that's different from
your registry.
http://davenport.sourceforge.net/ntlm.html describes these like this:
=======================================================================
Level | Sent by Client | Accepted by Server
=======================================================================
0 | LM NTLM | LM NTLM /LMv2 NTLMv2
1 | LM NTLM | LM NTLM /LMv2 NTLMv2
2 | NTLM (is sent in both feilds) | LM NTLM /LMv2 NTLMv2
3 | LMv2 NTLMv2 | LM NTLM /LMv2 NTLMv2
4 | LMv2 NTLMv2 | NTLM /LMv2 NTLMv2
5 | LMv2 NTLMv2 | LMv2 NTLMv2
}
property LMCompatibility : UInt32 read FLMCompatibility write FLMCompatibility default DEF_LMCompatibility;
end;
implementation
uses
IdFIPS, IdNTLMv2;
//uses IdNTLM;
{ TIdSASLNTLM }
function TIdSASLNTLM.ContinueAuthenticate(const ALastResponse, AHost,
AProtocolName: String): string;
var
LMsg : TIdBytes;
LNonce : TIdBytes; //this is also called the challange
LTargetName, LTargetInfo : TIdBytes;
LFlags : UInt32;
LDomain, LUserName : String;
LEncoding: IIdTextEncoding;
begin
LEncoding := IndyTextEncoding_8Bit;
LMsg := ToBytes(ALastResponse, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF});
IdNTLMv2.ReadType2Msg(LMsg, LFlags, LTargetName, LTargetInfo, LNonce);
IdGlobal.DebugOutput('Type 2 Flags = '+ DumpFlags(LFlags));
GetDomain(GetUsername, LUsername, LDomain);
Result := BytesToStringRaw( BuildType3Msg(LDomain, LDomain, GetUsername, GetPassword,
LFlags, LNonce, LTargetName, LTargetInfo, FLMCompatibility) );
end;
procedure TIdSASLNTLM.InitComponent;
begin
inherited InitComponent;
Self.FLMCompatibility := DEF_LMCompatibility;
end;
function TIdSASLNTLM.IsReadyToStart: Boolean;
begin
Result := (not GetFIPSMode) and (inherited IsReadyToStart) and
NTLMFunctionsLoaded;
end;
class function TIdSASLNTLM.ServiceName: TIdSASLServiceName;
begin
Result := 'NTLM'; {Do not localize}
end;
function TIdSASLNTLM.TryStartAuthenticate(const AHost, AProtocolName: string;
var VInitialResponse: string): Boolean;
var
LDomain, LUsername : String;
begin
GetDomain(GetUsername, LUsername, LDomain);
if LDomain = '' then begin
LDomain := FDomain;
end;
VInitialResponse := BytesToStringRaw(IdNTLMv2.BuildType1Msg(LDomain, LDomain, FLMCompatibility));
Result := True;
end;
function TIdSASLNTLM.StartAuthenticate(const AChallenge, AHost, AProtocolName: string): String;
begin
TryStartAuthenticate(AHost, AProtocolName, Result);
end;
end.