Skip to content

Commit

Permalink
- Removing hard-coded OpenSSL dependencies from IdAllAuthentications,…
Browse files Browse the repository at this point in the history
… IdAuthenticationNTLM, and IdNTLM units (#376).

  Will remove them from IdRegister and IdDsnRegister units when the new IndyTLSOpenSSL package has been released.

- Adding additional function pointers in IdFIPS unit to load an external Hashing library and to create NTLM challenge responses.

- Moving functions that use OpenSSL to create NTLM challenge responses into IdSSLOpenSSLHeaders unit.
  • Loading branch information
rlebeau committed Aug 14, 2024
1 parent 8dfed3d commit bd2d88f
Show file tree
Hide file tree
Showing 6 changed files with 248 additions and 205 deletions.
2 changes: 0 additions & 2 deletions Lib/Protocols/IdAllAuthentications.pas
Original file line number Diff line number Diff line change
Expand Up @@ -26,9 +26,7 @@ implementation

uses
{$IFNDEF DOTNET}
{$IFDEF USE_OPENSSL}
IdAuthenticationNTLM,
{$ENDIF}
{$IFDEF USE_SSPI}
IdAuthenticationSSPI,
{$ENDIF}
Expand Down
18 changes: 8 additions & 10 deletions Lib/Protocols/IdAuthenticationNTLM.pas
Original file line number Diff line number Diff line change
Expand Up @@ -80,11 +80,7 @@ implementation
IdGlobalProtocols,
IdException,
IdCoderMIME,
{.$IFDEF USE_OPENSSL}
IdResourceStringsOpenSSL,
IdSSLOpenSSLHeaders,
IdSSLOpenSSL,
{.$ENDIF}
IdFIPS,
IdNTLM,
SysUtils;

Expand All @@ -93,13 +89,15 @@ implementation
constructor TIdNTLMAuthentication.Create;
begin
inherited Create;
{.$IFDEF USE_OPENSSL}
if not LoadOpenSSLLibrary then begin
raise EIdOSSLCouldNotLoadSSLLibrary.Create(RSOSSLCouldNotLoadSSLLibrary);

if not LoadNTLMLibrary then begin
// TODO: create a new Exception class for this
// TODO: move this into IdResourceStringsProtocols
raise EIdException.Create('Could not load NTLM library'); {do not localize}
end;
{.$ENDIF}

{TODO: add this?
if not NTLMFunctionsLoaded then begin
if not IsNTLMFuncsAvail then begin
raise ...;
end;
}
Expand Down
61 changes: 54 additions & 7 deletions Lib/Protocols/IdFIPS.pas
Original file line number Diff line number Diff line change
Expand Up @@ -7,12 +7,12 @@ interface
{
IMPORTANT!!!
This unit does not directly provide FIPS support. It centalizes some Indy
This unit does not directly provide FIPS support. It centralizes some Indy
encryption functions and exposes a function to get and set a FIPS mode that is
implemented by the library that hooks this unit.
The idea is that Indy will not have a FIPS certification per se but will be
able to utilize cryptographic modules that are FIPS complient.
able to utilize cryptographic modules that are FIPS compliant.
In addition, this unit provides a way of centralizing all hashing and HMAC
functions and to control dependancies in Indy.
Expand All @@ -34,6 +34,7 @@ interface
{$ENDIF}

EIdFIPSAlgorithmNotAllowed = class(EIdException);

TGetFIPSMode = function: Boolean;
TSetFIPSMode = function(const AMode: Boolean): Boolean;
TIsHashingIntfAvail = function: Boolean;
Expand All @@ -46,6 +47,13 @@ EIdFIPSAlgorithmNotAllowed = class(EIdException);
TUpdateHMACInst = procedure(ACtx : TIdHMACIntCtx; const AIn: TIdBytes);
TFinalHMACInst = function(ACtx: TIdHMACIntCtx): TIdBytes;

TLoadHashLibrary = function: Boolean;

TLoadNTLMLibrary = function: Boolean;
TIsNTLMFuncsAvail = function: Boolean;
TNTLMGetLmChallengeResponse = function(const APassword: String; const ANonce: TIdBytes): TIdBytes;
TNTLMGetNtChallengeResponse = function(const APassword: String; const ANonce: TIdBytes): TIdBytes;

var
GetFIPSMode: TGetFIPSMode;
SetFIPSMode: TSetFIPSMode;
Expand Down Expand Up @@ -84,6 +92,13 @@ EIdFIPSAlgorithmNotAllowed = class(EIdException);
UpdateHMACInst : TUpdateHMACInst;
FinalHMACInst : TFinalHMACInst;

LoadHashLibrary : TLoadHashLibrary;

LoadNTLMLibrary : TLoadNTLMLibrary;
IsNTLMFuncsAvail : TIsNTLMFuncsAvail;
NTLMGetLmChallengeResponse: TNTLMGetLmChallengeResponse;
NTLMGetNtChallengeResponse: TNTLMGetNtChallengeResponse;

procedure CheckMD2Permitted;
procedure CheckMD4Permitted;
procedure CheckMD5Permitted;
Expand Down Expand Up @@ -183,6 +198,31 @@ function DefFinalHMACInst(ACtx: TIdHMACIntCtx): TIdBytes;
SetLength(Result, 0);
end;

function DefLoadHashLibrary: Boolean;
begin
Result := False;
end;

function DefLoadNTLMLibrary: Boolean;
begin
Result := False;
end;

function DefIsNTLMFuncsAvail: Boolean;
begin
Result := False;
end;

function DefNTLMGetLmChallengeResponse(const APassword: String; const ANonce: TIdBytes): TIdBytes;
begin
SetLength(Result, 0);
end;

function DefNTLMGetNtChallengeResponse(const APassword: String; const ANonce: TIdBytes): TIdBytes;
begin
SetLength(Result, 0);
end;

initialization

GetFIPSMode := DefGetFIPSMode;
Expand Down Expand Up @@ -212,18 +252,25 @@ initialization
IsHMACAvail := DefIsHMACAvail;
IsHMACMD5Avail := DefIsHMACIntfAvail;
GetHMACMD5HashInst := DefGetHMACInst;
IsHMACSHA1Avail := DefIsHMACIntfAvail;
IsHMACSHA1Avail := DefIsHMACIntfAvail;
GetHMACSHA1HashInst := DefGetHMACInst;
IsHMACSHA224Avail := DefIsHMACIntfAvail;
IsHMACSHA224Avail := DefIsHMACIntfAvail;
GetHMACSHA224HashInst := DefGetHMACInst;
IsHMACSHA256Avail := DefIsHMACIntfAvail;
IsHMACSHA256Avail := DefIsHMACIntfAvail;
GetHMACSHA256HashInst := DefGetHMACInst;
IsHMACSHA384Avail := DefIsHMACIntfAvail;
IsHMACSHA384Avail := DefIsHMACIntfAvail;
GetHMACSHA384HashInst := DefGetHMACInst;
IsHMACSHA512Avail := DefIsHMACIntfAvail;
IsHMACSHA512Avail := DefIsHMACIntfAvail;
GetHMACSHA512HashInst := DefGetHMACInst;

UpdateHMACInst := DefUpdateHMACInst;
FinalHMACInst := DefFinalHMACInst;

LoadHashLibrary := DefLoadHashLibrary;

LoadNTLMLibrary := DefLoadNTLMLibrary;
IsNTLMFuncsAvail := DefIsNTLMFuncsAvail;
NTLMGetLmChallengeResponse := DefNTLMGetLmChallengeResponse;
NTLMGetNtChallengeResponse := DefNTLMGetNtChallengeResponse;

end.
143 changes: 6 additions & 137 deletions Lib/Protocols/IdNTLM.pas
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,7 @@
{
Implementation of the NTLM authentication as specified in
http://www.innovation.ch/java/ntlm.html with some fixes
Author: Doychin Bondzhev ([email protected])
Copyright: (c) Chad Z. Hower and The Winshoes Working Group.
}
Expand Down Expand Up @@ -285,21 +285,13 @@ implementation
IdHash,
IdHashMessageDigest,
IdCoderMIME
{$IFNDEF DOTNET}
{.$IFDEF USE_OPENSSL}
, IdSSLOpenSSLHeaders
{.$ENDIF}
{$ENDIF}
{$IFDEF HAS_GENERICS_TArray_Copy}
{$IFDEF HAS_UNIT_Generics_Collections}
, System.Generics.Collections
{$ENDIF}
{$ENDIF}
;

type
Pdes_key_schedule = ^des_key_schedule;

const
cProtocolStr: array[1..8] of Byte = (Ord('N'),Ord('T'),Ord('L'),Ord('M'),Ord('S'),Ord('S'),Ord('P'),$0); {Do not Localize}

Expand Down Expand Up @@ -328,109 +320,15 @@ function NTLMFunctionsLoaded : Boolean;
end;
{$ELSE}
function NTLMFunctionsLoaded : Boolean;
//{$IFNDEF USE_OPENSSL}{$IFDEF USE_INLINE} inline; {$ENDIF}{$ENDIF}
begin
{.$IFDEF USE_OPENSSL}
Result := IdSSLOpenSSLHeaders.Load;
Result := LoadNTLMLibrary;
if Result then begin
Result := Assigned(DES_set_odd_parity) and
Assigned(DES_set_key) and
Assigned(DES_ecb_encrypt);
Result := IsNTLMFuncsAvail;
end;
{.$ELSE}
//Result := False;
{.$ENDIF}
end;
{$ENDIF}

{$IFNDEF DOTNET}
{/*
* turns a 56 bit key into the 64 bit, odd parity key and sets the key.
* The key schedule ks is also set.
*/}
procedure setup_des_key(key_56: des_cblock; Var ks: des_key_schedule);
Var
key: des_cblock;
begin
key[0] := key_56[0];

key[1] := ((key_56[0] SHL 7) and $FF) or (key_56[1] SHR 1);
key[2] := ((key_56[1] SHL 6) and $FF) or (key_56[2] SHR 2);
key[3] := ((key_56[2] SHL 5) and $FF) or (key_56[3] SHR 3);
key[4] := ((key_56[3] SHL 4) and $FF) or (key_56[4] SHR 4);
key[5] := ((key_56[4] SHL 3) and $FF) or (key_56[5] SHR 5);
key[6] := ((key_56[5] SHL 2) and $FF) or (key_56[6] SHR 6);
key[7] := (key_56[6] SHL 1) and $FF;

DES_set_odd_parity(@key);
DES_set_key(@key, ks);
end;

{/*
* takes a 21 byte array and treats it as 3 56-bit DES keys. The
* 8 byte plaintext is encrypted with each key and the resulting 24
* bytes are stored in the results array.
*/}
procedure calc_resp(keys: PDES_cblock; const ANonce: TIdBytes; results: Pdes_key_schedule);
Var
ks: des_key_schedule;
nonce: des_cblock;
begin
setup_des_key(keys^, ks);
Move(ANonce[0], nonce, 8);
des_ecb_encrypt(@nonce, Pconst_DES_cblock(results), ks, DES_ENCRYPT);

setup_des_key(PDES_cblock(PtrUInt(keys) + 7)^, ks);
des_ecb_encrypt(@nonce, Pconst_DES_cblock(PtrUInt(results) + 8), ks, DES_ENCRYPT);

setup_des_key(PDES_cblock(PtrUInt(keys) + 14)^, ks);
des_ecb_encrypt(@nonce, Pconst_DES_cblock(PtrUInt(results) + 16), ks, DES_ENCRYPT);
end;

Const
Magic: des_cblock = ($4B, $47, $53, $21, $40, $23, $24, $25 );

//* setup LanManager password */
function SetupLanManagerPassword(const APassword: String; const ANonce: TIdBytes): TIdBytes;
var
lm_hpw: array[0..20] of Byte;
lm_pw: array[0..13] of Byte;
idx, len: Integer;
ks: des_key_schedule;
lm_resp: array [0..23] of Byte;
lPassword: {$IFDEF STRING_IS_UNICODE}TIdBytes{$ELSE}AnsiString{$ENDIF};
begin
{$IFDEF STRING_IS_UNICODE}
lPassword := IndyTextEncoding_OSDefault.GetBytes(UpperCase(APassword));
{$ELSE}
lPassword := UpperCase(APassword);
{$ENDIF}

len := IndyMin(Length(lPassword), 14);
if len > 0 then begin
Move(lPassword[{$IFDEF STRING_IS_UNICODE}0{$ELSE}1{$ENDIF}], lm_pw[0], len);
end;
if len < 14 then begin
for idx := len to 13 do begin
lm_pw[idx] := $0;
end;
end;

//* create LanManager hashed password */

setup_des_key(pdes_cblock(@lm_pw[0])^, ks);
des_ecb_encrypt(@magic, Pconst_DES_cblock(@lm_hpw[0]), ks, DES_ENCRYPT);

setup_des_key(pdes_cblock(PtrUInt(@lm_pw[0]) + 7)^, ks);
des_ecb_encrypt(@magic, Pconst_DES_cblock(PtrUInt(@lm_hpw[0]) + 8), ks, DES_ENCRYPT);

FillChar(lm_hpw[16], 5, 0);

calc_resp(PDes_cblock(@lm_hpw[0]), ANonce, Pdes_key_schedule(@lm_resp[0]));

SetLength(Result, SizeOf(lm_resp));
Move(lm_resp[0], Result[0], SizeOf(lm_resp));
end;

function BuildUnicode(const S: String): TIdBytes;
{$IFDEF STRING_IS_UNICODE}
Expand All @@ -443,7 +341,7 @@ function BuildUnicode(const S: String): TIdBytes;
{$IFDEF STRING_IS_UNICODE}
Result := IndyTextEncoding_UTF16LE.GetBytes(S);
{$ELSE}
// RLebeau: TODO - should this use encUTF16LE as well? This logic will
// RLebeau: TODO - should this use UTF-16 as well? This logic will
// not produce a valid Unicode string if non-ASCII characters are present!
SetLength(Result, Length(S) * SizeOf(WideChar));
for i := 0 to Length(S)-1 do begin
Expand All @@ -453,35 +351,6 @@ function BuildUnicode(const S: String): TIdBytes;
{$ENDIF}
end;

//* create NT hashed password */
function CreateNTPassword(const APassword: String; const ANonce: TIdBytes): TIdBytes;
var
nt_hpw: array [1..21] of Byte;
nt_hpw128: TIdBytes;
nt_resp: array [1..24] of Byte;
LMD4: TIdHashMessageDigest4;
begin
CheckMD4Permitted;
LMD4 := TIdHashMessageDigest4.Create;
try
{$IFDEF STRING_IS_UNICODE}
nt_hpw128 := LMD4.HashString(APassword, IndyTextEncoding_UTF16LE);
{$ELSE}
nt_hpw128 := LMD4.HashBytes(BuildUnicode(APassword));
{$ENDIF}
finally
LMD4.Free;
end;

Move(nt_hpw128[0], nt_hpw[1], 16);
FillChar(nt_hpw[17], 5, 0);

calc_resp(pdes_cblock(@nt_hpw[1]), ANonce, Pdes_key_schedule(@nt_resp[1]));

SetLength(Result, SizeOf(nt_resp));
Move(nt_resp[1], Result[0], SizeOf(nt_resp));
end;

function BuildType1Message(const ADomain, AHost: String): String;
var
LEncoding: IIdTextEncoding;
Expand Down Expand Up @@ -547,8 +416,8 @@ function BuildType3Message(const ADomain, AHost, AUsername: TIdUnicodeString;
lHost: TIdBytes;
lUsername: TIdBytes;
begin
lm_password := SetupLanManagerPassword(APassword, ANonce);
nt_password := CreateNTPassword(APassword, ANonce);
lm_password := IdFIPS.NTLMGetLmChallengeResponse(APassword, ANonce);
nt_password := IdFIPS.NTLMGetNtChallengeResponse(APassword, ANonce);

lDomain := BuildUnicode(UpperCase(ADomain));
lHost := BuildUnicode(UpperCase(AHost));
Expand Down
Loading

0 comments on commit bd2d88f

Please sign in to comment.