Updating IdFIPS unit in main Indy library to allow IndyTLSOpenSSL package to use OpenSSL when creating NTLM challenge responses.

Trimming IdCompilerDefines.inc to remove things IndyTLSOpenSSL doesn't use.

Author: rlebeau

IdCompilerDefines.inc

@@ -0,0 +1,160 @@
+{
+  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-2024, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
+}
+
+unit IdNTLMOpenSSL;
+
+interface
+
+implementation
+
+uses
+  IdGlobal, IdFIPS, IdSSLOpenSSLHeaders, IdHashMessageDigest,
+  SysUtils;
+
+{$I IdCompilerDefines.inc}
+
+function LoadOpenSSL: Boolean;
+begin
+  Result := IdSSLOpenSSLHeaders.Load;
+end;
+
+function IsNTLMFuncsAvail: Boolean;
+begin
+  Result := Assigned(DES_set_odd_parity) and
+    Assigned(DES_set_key) and
+    Assigned(DES_ecb_encrypt);
+end;
+
+type
+  Pdes_key_schedule = ^des_key_schedule;
+
+{/*
+ * 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;
+
+//* 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;
+
+initialization
+  IdFIPS.LoadNTLMLibrary := LoadOpenSSL;
+  IdFIPS.IsNTLMFuncsAvail := IsNTLMFuncsAvail;
+  IdFIPS.NTLMGetLmChallengeResponse := SetupLanManagerPassword;
+  IdFIPS.NTLMGetNtChallengeResponse := CreateNTPassword;
+
+end.

IdNTLMOpenSSL.pas

@@ -1,148 +1,10 @@
 {
-  $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.40    03/11/2009 09:04:00  AWinkelsdorf
-  Implemented fix for Vista+ SSL_Read and SSL_Write to allow connection
-  timeout.
-
-  Rev 1.39    16/02/2005 23:26:08  CCostelloe
-  Changed OnVerifyPeer.  Breaks existing implementation of OnVerifyPeer.  See
-  long comment near top of file.
-
-  Rev 1.38    1/31/05 6:02:28 PM  RLebeau
-  Updated _GetThreadId() callback to reflect changes in IdGlobal unit
-
-  Rev 1.37    7/27/2004 1:54:26 AM  JPMugaas
-  Now should use the Intercept property for sends.
-
-  Rev 1.36    2004-05-18 21:38:36  Mattias
-  Fixed unload bug
-
-  Rev 1.35    2004-05-07 16:34:26  Mattias
-  Implemented  OpenSSL locking callbacks
-
-  Rev 1.34    27/04/2004 9:38:48  HHariri
-  Added compiler directive so it works in BCB
-
-  Rev 1.33    4/26/2004 12:41:10 AM  BGooijen
-  Fixed WriteDirect
-
-  Rev 1.32    2004.04.08 10:55:30 PM  czhower
-  IOHandler changes.
-
-  Rev 1.31    3/7/2004 9:02:58 PM  JPMugaas
-  Fixed compiler warning about visibility.
-
-  Rev 1.30    2004.03.07 11:46:40 AM  czhower
-  Flushbuffer fix + other minor ones found
-
-  Rev 1.29    2/7/2004 5:50:50 AM  JPMugaas
-  Fixed Copyright.
-
-  Rev 1.28    2/6/2004 3:45:56 PM  JPMugaas
-  Only a start on NET porting.  This is not finished and will not compile on
-  DotNET>
-
-  Rev 1.27    2004.02.03 5:44:24 PM  czhower
-  Name changes
-
-  Rev 1.26    1/21/2004 4:03:48 PM  JPMugaas
-  InitComponent
-
-  Rev 1.25    1/14/2004 11:39:10 AM  JPMugaas
-  Server IOHandler now works.  Accept was commented out.
-
-  Rev 1.24    2003.11.29 10:19:28 AM  czhower
-  Updated for core change to InputBuffer.
-
-  Rev 1.23    10/21/2003 10:09:14 AM  JPMugaas
-  Intercept enabled.
-
-  Rev 1.22    10/21/2003 09:41:38 AM  JPMugaas
-  Updated for new API.  Verified with TIdFTP with active and passive transfers
-  as well as clear and protected data channels.
-
-  Rev 1.21    10/21/2003 07:32:38 AM  JPMugaas
-  Checked in what I have.  Porting still continues.
-
-  Rev 1.20    10/17/2003 1:08:08 AM  DSiders
-  Added localization comments.
-
-  Rev 1.19    2003.10.12 6:36:44 PM  czhower
-  Now compiles.
-
-  Rev 1.18    9/19/2003 11:24:58 AM  JPMugaas
-  Should compile.
-
-  Rev 1.17    9/18/2003 10:20:32 AM  JPMugaas
-  Updated for new API.
-
-  Rev 1.16    2003.07.16 3:26:52 PM  czhower
-  Fixed for a core change.
-
-  Rev 1.15    6/30/2003 1:52:22 PM  BGooijen
-  Changed for new buffer interface
-
-  Rev 1.14    6/29/2003 5:42:02 PM  BGooijen
-  fixed problem in TIdSSLIOHandlerSocketOpenSSL.SetPassThrough that Henrick
-  Hellstrom reported
-
-  Rev 1.13    5/7/2003 7:13:00 PM  BGooijen
-  changed Connected to BindingAllocated in ReadFromSource
-
-  Rev 1.12    3/30/2003 12:16:40 AM  BGooijen
-  bugfixed+ added MakeFTPSvrPort/MakeFTPSvrPasv
-
-  Rev 1.11    3/14/2003 06:56:08 PM  JPMugaas
-  Added a clone method to the SSLContext.
-
-  Rev 1.10    3/14/2003 05:29:10 PM  JPMugaas
-  Change to prevent an AV when shutting down the FTP Server.
-
-  Rev 1.9    3/14/2003 10:00:38 PM  BGooijen
-  Removed TIdServerIOHandlerSSLBase.PeerPassthrough, the ssl is now enabled in
-  the server-protocol-files
-
-  Rev 1.8    3/13/2003 11:55:38 AM  JPMugaas
-  Updated registration framework to give more information.
-
-  Rev 1.7    3/13/2003 11:07:14 AM  JPMugaas
-  OpenSSL classes renamed.
-
-  Rev 1.6    3/13/2003 10:28:16 AM  JPMugaas
-  Forgot the reegistration - OOPS!!!
-
-  Rev 1.5    3/13/2003 09:49:42 AM  JPMugaas
-  Now uses an abstract SSL base class instead of OpenSSL so 3rd-party vendors
-  can plug-in their products.
-
-  Rev 1.4    3/13/2003 10:20:08 AM  BGooijen
-  Server side fibers
-
-  Rev 1.3    2003.02.25 3:56:22 AM  czhower
-
-  Rev 1.2    2/5/2003 10:27:46 PM  BGooijen
-  Fixed bug in OpenEncodedConnection
-
-  Rev 1.1    2/4/2003 6:31:22 PM  BGooijen
-  Fixed for Indy 10
-
-  Rev 1.0    11/13/2002 08:01:24 AM  JPMugaas
+   (c) 1993-2024, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
 }
 unit IdSSLOpenSSL;
 {
@@ -201,10 +63,6 @@ interface
 
 {$I IdCompilerDefines.inc}
 
-{$IFNDEF USE_OPENSSL}
-  {$message error Should not compile if USE_OPENSSL is not defined!!!}
-{$ENDIF}
-
 {$TYPEDADDRESS OFF}
 
 uses
@@ -4274,13 +4132,10 @@ function TIdSSLCipher.GetVersion:String;
   Result := String(SSL_CIPHER_get_version(SSL_get_current_cipher(FSSLSocket.fSSL)));
 end;
 
-{$I IdSymbolDeprecatedOff.inc}
-
 initialization
   Assert(SSLIsLoaded=nil);
   SSLIsLoaded := TIdThreadSafeBoolean.Create;
 
-  {$I IdSymbolDeprecatedOff.inc}
   RegisterSSL('OpenSSL','Indy Pit Crew',                                  {do not localize}
     'Copyright '+Char(169)+' 1993 - 2023'#10#13 +                         {do not localize}
     'Chad Z. Hower (Kudzu) and the Indy Pit Crew. All rights reserved.',  {do not localize}
@@ -4289,7 +4144,6 @@ initialization
     'Original Author - Gregor Ibic',                                      {do not localize}
     TIdSSLIOHandlerSocketOpenSSL,
     TIdServerIOHandlerSSLOpenSSL);
-  {$I IdSymbolDeprecatedOn.inc}
 
   TIdSSLIOHandlerSocketOpenSSL.RegisterIOHandler;
 finalization

IdSSLOpenSSL.pas

@@ -155,9 +155,6 @@ interface
 
 {$I IdCompilerDefines.inc}
 
-{$IFNDEF USE_OPENSSL}
-  {$message error Should not compile if USE_OPENSSL is not defined!!!}
-{$ENDIF}
 {$WRITEABLECONST OFF}
 
 {$IFNDEF FPC}
@@ -19392,6 +19389,11 @@ function OpenSSLFinalHMACInst(ACtx: TIdHMACIntCtx): TIdBytes;
   FreeMem(ACtx,SizeOf(HMAC_CTX));
 end;
 
+function LoadOpenSSL: Boolean;
+begin
+  Result := Load;
+end;
+
 //****************************************************
 function FIPS_mode_set(onoff : TIdC_INT) : TIdC_INT;  {$IFDEF INLINE}inline;{$ENDIF}
 begin
@@ -26965,6 +26967,7 @@ initialization
   GetHMACSHA512HashInst:= OpenSSLGetHMACSHA512Inst;
   UpdateHMACInst := OpenSSLUpdateHMACInst;
   FinalHMACInst := OpenSSLFinalHMACInst;
+  LoadHashLibrary := LoadOpenSSL;
 {$IFNDEF STATICLOAD_OPENSSL}
 finalization
   FreeAndNil(FFailedLoadList);

IdSSLOpenSSLHeaders.pas

@@ -28,6 +28,7 @@ requires
 
 contains
   IdResourceStringsOpenSSL in 'IdResourceStringsOpenSSL.pas',
+  IdNTLMOpenSSL in 'IdNTLMOpenSSL.pas',
   IdSSLOpenSSL in 'IdSSLOpenSSL.pas',
   IdSSLOpenSSLHeaders in 'IdSSLOpenSSLHeaders.pas';
 

IndyTLSOpenSSL100.dpk

@@ -28,6 +28,7 @@ requires
 
 contains
   IdResourceStringsOpenSSL in 'IdResourceStringsOpenSSL.pas',
+  IdNTLMOpenSSL in 'IdNTLMOpenSSL.pas',
   IdSSLOpenSSL in 'IdSSLOpenSSL.pas',
   IdSSLOpenSSLHeaders in 'IdSSLOpenSSLHeaders.pas';
 

IndyTLSOpenSSL110.dpk

@@ -28,6 +28,7 @@ requires
 
 contains
   IdResourceStringsOpenSSL in 'IdResourceStringsOpenSSL.pas',
+  IdNTLMOpenSSL in 'IdNTLMOpenSSL.pas',
   IdSSLOpenSSL in 'IdSSLOpenSSL.pas',
   IdSSLOpenSSLHeaders in 'IdSSLOpenSSLHeaders.pas';