Hilfe bei Umstellung Unit DEC5.1 zu DEC6.0

[Kas Ob.]

Yes, it is tricky to add IDECHashAuthentication because the class methods, and to solve this either add the same naming methods in TDECHash, so you can redirect all these methods to the class ones in TDECHashAuthentication, or introduce new global function ValidPasswordHash just like ValidHash that return TDECHashAuthentication.

Both approaches are not ideals, the best or the better is MAY BE dropping the class methods and making them simple local methods, but i have no idea what this might break in current build, as these class methods popular or even needed as class methods ?
I can't tell, and believe you have better inside knowledge in DEC design.

[Kas Ob.]

I see this discrepancy in the implementation

Code:

// in DECHash.pas
  THashBaseMD4 = class(TDECHashAuthentication)
  THash_SHA0 = class(THashBaseMD4)
  THash_SHA256 = class(THash_SHA0)

// while in DECHashAuthentication.pas
  TDECHashAuthentication = class(TDECHash)

// but in DECHashBase.pas
  TDECHash = class(TDECObject, IDECHash)

Now we left with TDECHash without visibility to TDECHashAuthentication and its class methods, while all the derived class has full functionality of HashAuthentication,

What is misleading is the naming in TDECHashAuthentication, as the main class (core type) to be used is TDECHashAuthenticationClass from DECHashAuthentication.pas, not TDECHashClass from DECHashBase.

With current implementation, de facto the base class is TDECHashAuthentication !

and that why i suggest to not change anything for now, just add documented global function (like ValidPasswordHash) to serve this functionality where the result is TDECHashAuthenticationClass , but the input is TDECHashClass !!

[Kas Ob.]

Here this is the smallest workaround the problem for this case like what OP presented.

the modification are only in DECHashAuthentication.pas

Code:

function ValidAuthHash(HashClass: TDECHashClass): TDECHashAuthenticationClass;
procedure SetDefaultAuthHashClass(HashClass: TDECHashClass);

implementation

uses
  DECUtil;

resourcestring
  sAuthHashNoDefault          = 'No default hash has been registered';

var

  FDefaultAutheticationHashClass: TDECHashAuthenticationClass = nil;

function ValidAuthHash(HashClass: TDECHashClass): TDECHashAuthenticationClass;
begin
  if Assigned(HashClass) then
    Result := TDECHashAuthenticationClass(HashClass)
  else
    Result := FDefaultAutheticationHashClass;

  if not Assigned(Result) then
    raise EDECHashException.CreateRes(@sAuthHashNoDefault);
end;

procedure SetDefaultAuthHashClass(HashClass: TDECHashClass);
begin
  Assert(Assigned(HashClass), 'Do not set a nil default hash class!');

  FDefaultAutheticationHashClass := TDECHashAuthenticationClass(HashClass);
end;

For (legacy) code like haentschman the need is to add DECHashAuthentication in uses clause and use ValidAuthHash instead ValidHash.

BUT, they are named/called AuthHash while in fact they are just key deriving methods/algorithms, so.... (i am lousy at naming) ... find a better naming as i took the class name only while the functionality has nothing to do with authentication though.

[TurboMagic]

Hello,

I copied your implementation now and renamed it.
We now have

function ValidAuthenticationHash(HashClass: TDECHashClass): TDECHashAuthenticationClass;
procedure SetDefaultAuthenticationHashClass

Best regards

TurboMagic

[haentschman]

Hallöle...8-)

@Kas Ob. / TurboMagic
Könntet ihr bitte die technischen Details im Thred zum DEC erörtern? https://www.delphipraxis.net/206973-...fentlicht.html
Danke... :zwinker:

Ich habe am Freitag die neue Unit ins Release reingenommen... Ich habe die SQL Statements in Ressourcen verschlüsselt in der EXE drin. Bei jedem Aufruf zur Datenbank wird das verschlüsselte SQL genommen, entschlüsselt und der Query zugewiesen. Wenn das schiefläuft, dann ist das SQL = ''.
Dann kommt das raus...(Bild) Bei gefühlten 100+ Aufrufen kommt das richtige Ergebnis raus...dann kommt irgendwann der Fehler. Mein Postfach ist gestresst. :zwinker:
PS: es fällt erst mal auf, daß immer Threads involviert sind...:gruebel:

Ich werde zurückrudern, bis auch mein Tool (SQLCreator), was noch auf V5 läuft, umgestellt ist. Wenn das dann immer noch der Fall ist, kann man sich nicht drauf verlassen...:cry:

[Kas Ob.]

Can you capture/log the exact SQL query when the exception happen ?

I am sorry, can't understand the exception !, is it a fail to find parameter or something, like the there is SQL but broken !?

Anyway, i suspect the use of RawByteString is and as always the root of evil, so i will adjust your code a little to remove this dependency as much as i can.

ps: i asked for specific test vector to guarantee the migration of your code, and you didn't answer with one specific value, the one with strange Unicode would be helpful, yet from my understanding it is working fine, mostly !,
again does the exception due to broken/corrupted SQL or truncated SQL.... only after that we can guess if some combination of Unicode chars lost.

More details will remove the guessing game, and only you can get these details.

[Kas Ob.]

Please try this:

Code:

unit Tools.Crypt;

interface

uses
  System.SysUtils, DECUtil, DECHash, DECCipherBase, DECCiphers, DECHashBase,
  DECFormatBase, DECFormat, DECRandom, DECHashAuthentication;

const
  conKey = 'aYr14iaz8u)xO7Ok';

var
  //CipherAlgo: TCipher_Rijndael;
  CipherMode: TCipherMode = cmCBCx;
  HashClass : TDECHashClass = THash_SHA256;
  TextFormat: TDECFormatClass = TFormat_Base64;
  KDFIndex  : Integer = 1;  // Iterations

type
  TToolsCrypt = class
  public
    class function Decrypt(aHash: string; aKey: string = ''): string;
    class function Encrypt(aText: string; aKey: string = ''): string;
  end;

implementation

{ TToolsCrypt }

class function TToolsCrypt.Decrypt(aHash, aKey: string): string;
var
  Cipher: TCipher_Rijndael;
  //Cipher: TDECCipher;
  Salt, Data, Check, Pass, Mac: TBytes;
  MacLength, SaltLen, DataLen: Integer;
begin
  if aKey = '' then
  begin
    aKey := conKey;
  end;

  //Cipher:=ValidCipher(TCipher_Rijndael).Create;       // the way it should be used ! but it fail now with DecodeBytes
  Cipher := TCipher_Rijndael.Create;
  try
    MacLength := Cipher.Context.BlockSize;
    SaltLen := Cipher.InitVectorSize;

    Salt := ValidFormat(TextFormat).Decode(BytesOf(aHash));
    DataLen := Length(Salt) - MacLength - Cipher.Context.BufferSize;

    Data := Copy(Salt, MacLength, DataLen);
    Check := Copy(Salt, DataLen + SaltLen, Cipher.Context.BufferSize);

    SetLength(Salt, SaltLen);
    Pass := ValidAuthenticationHash(HashClass).KDFx(aKey[Low(aKey)], Length(aKey) * SizeOf(Char), Salt[Low(Salt)], Length(Salt), Cipher.Context.KeySize, KDFIndex);

    Cipher.Mode := CipherMode;
    Cipher.Init(Pass, nil);
    SetLength(Result, DataLen div SizeOf(Char));

    Cipher.Decode(Data[Low(Data)], Result[Low(Result)], DataLen);
    //Result := StringOf(Cipher.DecodeBytes(Data,TFormat_Copy));
    Mac := BytesOf(Cipher.CalcMAC);
    if MacLength < Length(Check) then
      MacLength := Length(Check);

    if (MacLength <> Cipher.Context.BlockSize) or (not CompareMem(Check, Mac, MacLength)) then
    begin
      Result := '';
    end;

  finally
    Cipher.Free;
    ProtectBytes(Salt);
    ProtectBytes(Check);
    ProtectBytes(Data);
    ProtectBytes(Pass);
    ProtectBytes(Mac);
  end;
end;

class function TToolsCrypt.Encrypt(aText, aKey: string): string;
var
  Cipher: TCipher_Rijndael;
  Salt, Pass, Data, Mac: TBytes;
begin
  if aKey = '' then
  begin
    aKey := conKey;
  end;

  Cipher := TCipher_Rijndael.Create;
  try
    Salt := RandomBytes(Cipher.InitVectorSize);
    Pass := ValidAuthenticationHash(HashClass).KDFx(aKey[Low(aKey)], Length(aKey) * SizeOf(Char), Salt[Low(Salt)], Length(Salt), Cipher.Context.KeySize, KDFIndex);
    Cipher.Mode := CipherMode;

    Cipher.Mode := cmCBCx;
    Cipher.Init(Pass, nil);

    SetLength(Data, Length(aText) * SizeOf(Char));
    Cipher.Encode(aText[Low(aText)], Data[Low(Data)], Length(Data));

    Mac := BytesOf(Cipher.CalcMAC);
    Result := StringOf(ValidFormat(TextFormat).Encode(Salt + Data + Mac));
  finally
    Cipher.Free;
    ProtectBytes(Salt);
    ProtectBytes(Pass);
    ProtectBytes(Data);
    ProtectBytes(Mac);
  end;
end;

end.

[haentschman]

Hallo...8-)

Zum Verständnis:
Der Fehler kommt NICHT sofort, sondern nach hunderten Aufrufen des GLEICHEN SQL aus der Ressource. :? (Bild + SQL)
Das SQL wird JEDE Minute im Execute des Threads ausgeführt. Im Fehlerfalle (Fehlermeldung von einem anderen SQL) ist das SQL leer = beschädigt.
"[FireDAC][Phys][MSSQL]-306. Anweisungstext [] darf nicht leer sein."
Damit kann er auch den Parameter nicht finden...:roll:

Delphi-Quellcode:

procedure TDatabaseState.OfflineTime(Workstation: string; InstanzID: Integer; TimeStamp: TDateTime);
var
  Qry: TFDQuery;
begin
  Qry := CreateQuery;
  try
    Qry.SQL.Text := GetSQLByName('COM_OFFLINE_TIME');
    Qry.ParamByName('HAN').AsInteger := InstanzID; //<-
    Qry.ParamByName('TIM').AsDateTime := TimeStamp;
    Qry.ParamByName('WOR').AsString := Workstation;
    Qry.ExecSQL;
  finally
    Qry.Free;
  end;
end;
...
function TDatabaseBase.GetSQLByName(SQLName: string): string;
var
  SQLStream: TResourceStream;
  SQLStrings: TStringList;
  SQLStringsDecrypt: TStringList;
begin
  Result := '';
  SQLStrings := TStringList.Create;
  try
    SQLStringsDecrypt := TStringList.Create;
    try
      SQLStream := TResourceStream.Create(HInstance, SQLName, PWideChar(conDatabaseResourceGroupString));
      try
        try
          SQLStrings.LoadFromStream(SQLStream);
          SQLStringsDecrypt.Text := TToolsCrypt.Decrypt(SQLStrings.Text, conKey); //<-
          SQLStringsDecrypt.Delete(0); // Kommentar entfernen
          Result := SQLStringsDecrypt.Text;
        except
          Result := '';
        end;
      finally
        SQLStream.Free;
      end;
    finally
      SQLStringsDecrypt.Free;
    end;
  finally
    SQLStrings.Free;
  end;
end;

Zitat:

i asked for specific test vector to guarantee the migration of your code, and you didn't answer with one specific value

siehe hier: https://www.delphipraxis.net/1531964-post9.html

PS: Nach Umstellung wieder auf V5.2, ist bei den Usern wieder Ruhe...:wink:

[Kas Ob.]

Hard bug to catch !, i can't reproduce this so will move to divide and conquer, for that we need to separate the decryption from MAC calculation.

Please try this, if you are in the mood to test deeper or you have time, this will show if the MAC is the failed point or not:

Code:

unit Tools.Crypt;

interface

uses
  System.SysUtils, DECUtil, DECHash, DECCipherBase, DECCiphers, DECHashBase,
  DECFormatBase, DECFormat, DECRandom, DECHashAuthentication;

const
  conKey = 'aYr14iaz8u)xO7Ok';

var
  CipherMode: TCipherMode = cmCBCx;
  HashClass: TDECHashClass = THash_SHA256;
  TextFormat: TDECFormatClass = TFormat_Base64;
  KDFIndex: Integer = 1;  // Iterations

type
  TToolsCrypt = class
  public
    class function Decrypt(const aHash: string; out NoAuthResult: string; aKey: string = ''): string;
    class function Encrypt(const aText: string; aKey: string = ''): string;
  end;

implementation

{ TToolsCrypt }

class function TToolsCrypt.Decrypt(const aHash: string; out NoAuthResult: string; aKey: string): string;
var
  Cipher: TCipher_Rijndael;
  Salt, Data, Check, Pass, Mac: TBytes;
  MacLength, SaltLen, DataLen: Integer;
begin
  if aKey = '' then
  begin
    aKey := conKey;
  end;

  Cipher := TCipher_Rijndael.Create;
  try
    MacLength := Cipher.Context.BlockSize;
    SaltLen := Cipher.InitVectorSize;

    Salt := ValidFormat(TextFormat).Decode(BytesOf(aHash));
    DataLen := Length(Salt) - MacLength - Cipher.Context.BufferSize;

    Data := Copy(Salt, MacLength, DataLen);
    Check := Copy(Salt, DataLen + SaltLen, Cipher.Context.BufferSize);

    SetLength(Salt, SaltLen);
    Pass := ValidAuthenticationHash(HashClass).KDFx(aKey[Low(aKey)], Length(aKey) * SizeOf(Char), Salt[Low(Salt)], Length(Salt), Cipher.Context.KeySize, KDFIndex);

    Cipher.Mode := CipherMode;
    Cipher.Init(Pass, nil);
    SetLength(Result, DataLen div SizeOf(Char));

    Cipher.Decode(Data[Low(Data)], Result[Low(Result)], DataLen);
    NoAuthResult := Result;

    Mac := BytesOf(Cipher.CalcMAC);
    if MacLength < Length(Check) then
      MacLength := Length(Check);

    if (MacLength <> Cipher.Context.BlockSize) or (not CompareMem(Check, Mac, MacLength)) then
    begin
      Result := '';
    end;

  finally
    Cipher.Free;
    ProtectBytes(Salt);
    ProtectBytes(Check);
    ProtectBytes(Data);
    ProtectBytes(Pass);
    ProtectBytes(Mac);
  end;
end;

class function TToolsCrypt.Encrypt(const aText: string; aKey: string): string;
var
  Cipher: TCipher_Rijndael;
  Salt, Pass, Data, Mac: TBytes;
begin
  if aKey = '' then
  begin
    aKey := conKey;
  end;

  Cipher := TCipher_Rijndael.Create;
  try
    Salt := RandomBytes(Cipher.InitVectorSize);
    Pass := ValidAuthenticationHash(HashClass).KDFx(aKey[Low(aKey)], Length(aKey) * SizeOf(Char), Salt[Low(Salt)], Length(Salt), Cipher.Context.KeySize, KDFIndex);
    Cipher.Mode := CipherMode;

    Cipher.Mode := cmCBCx;
    Cipher.Init(Pass, nil);

    SetLength(Data, Length(aText) * SizeOf(Char));
    Cipher.Encode(aText[Low(aText)], Data[Low(Data)], Length(Data));

    Mac := BytesOf(Cipher.CalcMAC);
    Result := StringOf(ValidFormat(TextFormat).Encode(Salt + Data + Mac));
  finally
    Cipher.Free;
    ProtectBytes(Salt);
    ProtectBytes(Pass);
    ProtectBytes(Data);
    ProtectBytes(Mac);
  end;
end;

end.

When the result is empty check and log the content of NoAuthResult, please if possible log it in plain text and in HEX formatted form.

[haentschman]

Hi...8-)

Zitat:

Hard bug to catch !

...du sagst es. :?

Zitat:

or you have time

:cheer: Guter Witz. Welcher Entwickler, der nicht allein ist, hat schon Zeit...:zwinker:

Ich werde das Thema wieder angehen, wenn die großen Themen des Jahres (neuer Quelltext) in Sack und Tüten sind.
In der Entwicklung kann ich über Nacht, im exception Block von GetSQLByName, ein Log schreiben das das Result aus TToolsCrypt protokoliert. In der Hoffnung, daß der Fehler dann auftritt. Das stelle ich dann zur Verfügung.
Im Release kann ich mich leider nicht darum kümmern...:(

Danke erstmal...8-)