Реализация MD5Crypt на Delphi, crypt_md5.c, md5_crypt(), /etc/shadow, PHP crypt() Опции

[OCTAGRAM]

По работе потребовалось заводить пользователей в ISPConfig, а там пароли выглядят в базе так:

Код

$1$D955A9D4$wqySvFGhG5V9KsWxo0BvN0

Производятся такие зашифрованные пароли, например, используя PHP так:

php -r 'echo crypt("d8fgysdihgik34uj", '\''$1$D955A9D4$'\'')."\n";'

Впервые этот алгоритм появился в FreeBSD для защиты от брутфорса паролей в /etc/shadow на замену методу, основанному на DES. Затем его многократно скопипастили, в том числе, он попал в GNU libc и стал практически системным вызовом, его использовали самые разные программы. Вот и в PHP он доступен через фунцию crypt(), в отличие от php-mcrypt, которую ещё нужно установить, а на shared хостинге этого может просто и не быть. Таким образом, несмотря на возражения автора, встретить это шифрование можно нередко.

Нашёл для разных языков реализации, но для Delphi только на одном форуме некто похвастался, что у него такое есть, и не опубликовал.


В текущей реализации для MD5 используется Indy. Также у меня применяется подход, который принуждает к использованию Юникода даже неюникодные Delphi. Для этого в старых Delphi объявляется UnicodeString = WideString, и предоставляются некоторые недостающие функции из более новых Delphi для конвертации из UnicodeString в UTF8String и обратно. Вам потребуется, например, этот модуль, только я его переименовываю каждый раз для очередного проекта.

Если требуется не только генерить, но и проверять пароль, то надо Salt вычленять между $1$ и $, принимать в качестве ещё одного параметра, как в PHP и GNU libc, а не генерить случайную строку, как сейчас.

uses
  SysUtils, ComObj, ActiveX, IdGlobal, IdHash, IdHashMessageDigest, IdCoderMIME;

const
  L = UnicodeString('');
  // to make strings Unicode
  // in C++: L"abcd"
  // in Delphi: L+'abcd'
  // otherwise 'nonunicode literal' + UnicodeFunction(Arg1, Arg2) becomes
  // converted to screwed ANSI

function RandomString: UnicodeString;
var
  GUID: TGUID;
begin
  OleCheck(CreateGUID(GUID));
  Result := Copy(GUIDToString(GUID), 2, 36);
end;

const
  MD5CryptAlphabet : UnicodeString =
    UnicodeString('./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz');

function MyMD5(const InputString: UTF8String): UTF8String;
var
  Input, Output: TIdBytes;
  X_Hash_Alg: TIdHash;
begin
  SetLength(Input, Length(InputString));
  Move(InputString[1], Input[0], Length(InputString));
  X_Hash_Alg := nil;
  try
    X_Hash_Alg := TIdHashMessageDigest5.Create;
    Output := X_Hash_Alg.HashBytes(Input);
    SetString(Result, PAnsiChar(@Output[0]), Length(Output));
  finally
    FreeAndNil(X_Hash_Alg);
  end;
end;

function MD5Crypt(const Password: UnicodeString): UnicodeString;
var
  Salt: UTF8String;
  PasswordUTF8: UTF8String;
  Len: Integer;
  I: Integer;
  FinalString: UTF8String;
  Final: TIdBytes;
  CTXString: UTF8String;
  CTX1String: UTF8String;
  procedure To64(Value, Len: Integer);
  var
    J: Integer;
  begin
    for J := 1 to Len do
    begin
      Result := Result + MD5CryptAlphabet[Value and $3f + 1];
      Value := Value shr 6;
    end;
  end;
begin
  Salt := Copy(UTF8Encode(RandomString), 1, 8);
  // Salt := 'D955A9D4';
  PasswordUTF8 := UTF8Encode(Password);

  CTXString := PasswordUTF8 + UTF8String('$1$') + Salt;

  FinalString := MyMD5(PasswordUTF8 + Salt + PasswordUTF8);

  // Add as many characters of Final to CTX
  Len := Length(PasswordUTF8);
  while Len > 0 do
  begin
    if Len >= Length(FinalString) then
    begin
      CTXString := CTXString + FinalString;
      Dec(Len, Length(FinalString));
    end
    else
    begin
      CTXString := CTXString + Copy(FinalString, 1, Len);
      Len := 0;
    end;
  end;

  // Then something really weird...
  I := Length(PasswordUTF8);
  while I > 0 do
  begin
    if I and 1 = 1 then
    begin
      CTXString := CTXString + UTF8String(#0);
    end
    else
    begin
      CTXString := CTXString + PasswordUTF8[1];
    end;
    I := I shr 1;
  end;

  FinalString := MyMD5(CTXString);

  // Do additional mutations
  for I := 0 to 999 do
  begin
    CTX1String := '';
    if I and 1 > 0 then
    begin
      CTX1String := CTX1String + PasswordUTF8;
    end
    else
    begin
      CTX1String := CTX1String + FinalString;
    end;

    if I mod 3 > 0 then
    begin
      CTX1String := CTX1String + Salt;
    end;

    if I mod 7 > 0 then
    begin
      CTX1String := CTX1String + PasswordUTF8;
    end;

    if I and 1 > 0 then
    begin
      CTX1String := CTX1String + FinalString;
    end
    else
    begin
      CTX1String := CTX1String + PasswordUTF8;
    end;

    FinalString := MyMD5(CTX1String);
  end;

  Result := L+'$1$' + UTF8ToUnicodeString(Salt) + '$';

  SetLength(Final, Length(FinalString));
  Move(FinalString[1], Final[0], Length(FinalString));
  To64(((Integer(Final[ 0]) and $FF) shl 16) or ((Integer(Final[ 6]) and $FF) shl 8) or (Integer(Final[12]) and $FF), 4);
  To64(((Integer(Final[ 1]) and $FF) shl 16) or ((Integer(Final[ 7]) and $FF) shl 8) or (Integer(Final[13]) and $FF), 4);
  To64(((Integer(Final[ 2]) and $FF) shl 16) or ((Integer(Final[ 8]) and $FF) shl 8) or (Integer(Final[14]) and $FF), 4);
  To64(((Integer(Final[ 3]) and $FF) shl 16) or ((Integer(Final[ 9]) and $FF) shl 8) or (Integer(Final[15]) and $FF), 4);
  To64(((Integer(Final[ 4]) and $FF) shl 16) or ((Integer(Final[10]) and $FF) shl 8) or (Integer(Final[ 5]) and $FF), 4);
  To64(                                           Integer(Final[11]) and $FF                                        , 2);
end;

Сообщение отредактировано: OCTAGRAM - 9.10.2016 20:52