From 406524ec534ced7b30f1cd1d3c4c84fb828c47f8 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Sun, 20 Apr 2025 12:14:16 +0200 Subject: [PATCH] Merge recent changes from master branch: #2101, #2103, #1986, #2119, #2123, #2128, #2123, #2132, #2133, #2139, and Unicode logic for password encryption --- source/apphelpers.pas | 100 +++++++++++++++++++++++++++++++++- source/dbconnection.pas | 54 ++++++++++-------- source/dbstructures.mysql.pas | 15 +++-- source/main.pas | 12 ++-- source/usermanager.pas | 12 ++-- 5 files changed, 152 insertions(+), 41 deletions(-) diff --git a/source/apphelpers.pas b/source/apphelpers.pas index 8e4130be..022a4ccb 100644 --- a/source/apphelpers.pas +++ b/source/apphelpers.pas @@ -345,6 +345,9 @@ type function Explode(Separator, Text: String) :TStringList; procedure ExplodeQuotedList(Text: String; var List: TStringList); function StrEllipsis(const S: String; MaxLen: Integer; FromLeft: Boolean=True): String; + function isUnicode(str: String): Boolean; + function encryptUnicode(str: String): String; + function decryptUnicode(str: String): String; function encrypt(str: String): String; function decrypt(str: String): String; function HTMLSpecialChars(str: String): String; @@ -561,6 +564,77 @@ end; +{*** + Check if string is Unicode + + @param string String to check + @return boolean +} +function isUnicode(str: String): Boolean; +var i: integer; +begin + result := false; + for i := 1 to length(str) do begin + result := ord(str[i]) > 255; + if result then exit; + end; +end; + + +{*** + Password-encryption, used to store session-passwords in registry + Unicode (UTF-16) version, support up to 0xFFFF + + @param string Text to encrypt + @return string Encrypted Text +} +function encryptUnicode(str: String): String; +var + i, salt, nr: integer; + h: String; +begin + randomize(); + result := ''; + salt := random(9) + 1; + for i := 1 to length(str) do begin + nr := (ord(str[i]) + salt) mod 65536; + h := IntToHex(nr, 4); // 4 hex-symbols + result := result + h; + end; + // Adding Unicode flag + result := result + IntToStr(salt) + '0'; +end; + + +{*** + Password-decryption, used to restore session-passwords from registry + Unicode (UTF-16) version, support up to 0xFFFF + + @param string Text to decrypt + @return string Decrypted Text +} +function decryptUnicode(str: String): String; +var + j, salt, nr: integer; +begin + result := ''; + if str = '' then exit; + salt := StrToIntDef(str[length(str)], -1); + + // Salt is NAN + if salt < 0 then exit; + + j := 1; + while j < length(str) do begin + nr := StrToInt('$' + copy(str, j, 4)) - salt; + if nr < 0 then + nr := nr + 65536; + result := result + chr(nr); + inc(j, 4); + end; +end; + + {*** Password-encryption, used to store session-passwords in registry @@ -572,6 +646,11 @@ var i, salt, nr : integer; h : String; begin + if isUnicode(str) then begin + result := encryptUnicode(str); + exit; + end; + randomize(); result := ''; salt := random(9) + 1; @@ -588,7 +667,6 @@ begin end; - {*** Password-decryption, used to restore session-passwords from registry @@ -601,9 +679,20 @@ var begin result := ''; if str = '' then exit; + salt := StrToIntDef(str[length(str)], -1); + + // Salt is NAN - error + if salt < 0 then exit; + + // Salt is Unicode flag - Unicode logic + if salt = 0 then begin + // Removing Unicode flag + result := decryptUnicode(copy(str, 1, length(str) - 1)); + exit; + end; + + // Salt is... salt - ANSI logic j := 1; - salt := StrToIntDef(str[length(str)],0); - result := ''; while j < length(str)-1 do begin nr := StrToInt('$' + str[j] + str[j+1]) - salt; if nr < 0 then @@ -1039,6 +1128,8 @@ begin Process.RunCommandInDir(path, cmd, [params], ProcessResult, [], ShowOptions); end; + + {*** Returns first word of a given text @param string Given text @@ -1232,6 +1323,9 @@ procedure SaveUnicodeFile(Filename: String; Text: String; Encoding: TEncoding); var Writer: TStringList; begin + // Encoding may be nil when previously loaded via auto-detection + if not Assigned(Encoding) then + Encoding := UTF8NoBOMEncoding; Writer := TStringList.Create; Writer.Text := Text; Writer.SaveToFile(Filename, Encoding); diff --git a/source/dbconnection.pas b/source/dbconnection.pas index 83c027f4..eca5b1ae 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -660,7 +660,7 @@ type FLastRawResults: TMySQLRawResults; FStatementNum: Cardinal; procedure SetActive(Value: Boolean); override; - procedure SetOption(Option: Integer; Arg: PAnsiChar); + procedure SetOption(Option: Integer; Arg: Pointer); procedure DoBeforeConnect; override; procedure DoAfterConnect; override; function GetThreadId: Int64; override; @@ -2457,7 +2457,7 @@ procedure TMySQLConnection.SetActive( Value: Boolean ); var Connected: PMYSQL; ClientFlags, FinalPort, SSLoption: Integer; - VerifyServerCert: Byte; + VerifyServerCert: Integer; Error, StatusName: String; FinalHost, FinalSocket, FinalUsername, FinalPassword: String; ErrorHint: String; @@ -2496,7 +2496,7 @@ begin SetOption(FLib.MYSQL_OPT_SSL_CA, PAnsiChar(AnsiString(FParameters.SSLCACertificate))); if FParameters.SSLCipher <> '' then SetOption(FLib.MYSQL_OPT_SSL_CIPHER, PAnsiChar(AnsiString(FParameters.SSLCipher))); - if FLib.MYSQL_OPT_SSL_MODE <> TMySQLLib.INVALID_OPT then begin + if not FLib.IsLibMariadb then begin // MySQL Log(lcInfo, 'SSL parameters for MySQL'); case FParameters.SSLVerification of @@ -2562,7 +2562,7 @@ begin or CLIENT_PLUGIN_AUTH_LENENC_CLIENT_DATA; if Parameters.Compressed then ClientFlags := ClientFlags or CLIENT_COMPRESS; - if Parameters.WantSSL then + if Parameters.WantSSL and (not FLib.IsLibMariadb) then ClientFlags := ClientFlags or CLIENT_SSL; {$IfDef WINDOWS} @@ -2662,8 +2662,6 @@ begin end; // mysql_character_set_name() reports utf8* if in fact we're on some latin* charset on v5.1 servers // See https://www.heidisql.com/forum.php?t=39278 - FIsUnicode := CharacterSet.StartsWith('utf', True) and (ServerVersionInt >= 50500); - if not IsUnicode then try CharacterSet := 'utf8mb4'; except @@ -2951,7 +2949,7 @@ begin ConnectOptions.Free; ConnectionString := ConnectionString.TrimRight; - FHandle := FLib.PQconnectdb(PAnsiChar(AnsiString(ConnectionString))); + FHandle := FLib.PQconnectdb(PAnsiChar(UTF8Encode(ConnectionString))); if FLib.PQstatus(FHandle) = CONNECTION_BAD then begin Error := LastErrorMsg; Log(lcError, Error); @@ -2993,7 +2991,8 @@ begin DoAfterConnect; end else begin try - FLib.PQfinish(FHandle); + if FActive then + FLib.PQfinish(FHandle); except on E:EAccessViolation do; end; @@ -3233,7 +3232,7 @@ begin end;} -procedure TMySQLConnection.SetOption(Option: Integer; Arg: PAnsiChar); +procedure TMySQLConnection.SetOption(Option: Integer; Arg: Pointer); var SetOptionResult: Integer; RttiContext: TRttiContext; @@ -3242,23 +3241,25 @@ var FieldName: String; begin // Set one of the MYSQL_* option and log a warning if that failed - SetOptionResult := FLib.mysql_options(FHandle, Option, Arg); - if SetOptionResult <> 0 then begin - FieldName := Option.ToString; - // Attempt to find readable name of option constant - {RttiContext := TRttiContext.Create; - LibType := RttiContext.GetType(TypeInfo(TMySQLLib)); - for LibField in LibType.GetFields do begin - // Skip assigned procedures - if LibField.FieldType = nil then - Continue; - if LibField.DataType.TypeKind = tkInteger then begin - if LibField.GetValue(FLib).AsInteger = Option then begin - FieldName := LibField.Name; - end; + FieldName := Option.ToString; + // Attempt to find readable name of option constant + {RttiContext := TRttiContext.Create; + LibType := RttiContext.GetType(TypeInfo(TMySQLLib)); + for LibField in LibType.GetFields do begin + // Skip assigned procedures + if LibField.FieldType = nil then + Continue; + if LibField.DataType.TypeKind = tkInteger then begin + if LibField.GetValue(FLib).AsInteger = Option then begin + FieldName := LibField.Name; end; end; - RttiContext.Free;} + end; + RttiContext.Free;} + + Log(lcDebug, Format('Calling mysql_options(%s, ...)', [FieldName])); + SetOptionResult := FLib.mysql_options(FHandle, Option, Arg); + if SetOptionResult <> 0 then begin Log(lcError, _(SLogPrefixWarning) + ': mysql_options(' + FieldName + ', ...) failed!'); end; end; @@ -3764,6 +3765,11 @@ begin if Reconnect then Active := True; end; + end + else begin + // Not active currently, reconnect + if Reconnect then + Active := True; end; Result := FActive; // Restart keep-alive timer diff --git a/source/dbstructures.mysql.pas b/source/dbstructures.mysql.pas index fba02fd2..d57badb6 100644 --- a/source/dbstructures.mysql.pas +++ b/source/dbstructures.mysql.pas @@ -278,7 +278,7 @@ type mysql_info: function(Handle: PMYSQL): PAnsiChar; stdcall; mysql_num_fields: function(Result: PMYSQL_RES): Integer; stdcall; mysql_num_rows: function(Result: PMYSQL_RES): Int64; stdcall; - mysql_options: function(Handle: PMYSQL; Option: Integer; arg: PAnsiChar): Integer; stdcall; + mysql_options: function(Handle: PMYSQL; Option: Integer; arg: Pointer): Integer; stdcall; mysql_optionsv: function(Handle: PMYSQL; Option: Integer; arg, val: PAnsiChar): Integer; stdcall; mysql_ping: function(Handle: PMYSQL): Integer; stdcall; mysql_real_connect: function(Handle: PMYSQL; const Host, User, Passwd, Db: PAnsiChar; Port: Cardinal; const UnixSocket: PAnsiChar; ClientFlag: Cardinal): PMYSQL; stdcall; @@ -293,8 +293,8 @@ type mysql_warning_count: function(Handle: PMYSQL): Cardinal; stdcall; const INVALID_OPT = -1; - MYBOOL_FALSE: Byte = 0; - MYBOOL_TRUE: Byte = 1; + MYBOOL_FALSE: Integer = 0; + MYBOOL_TRUE: Integer = 1; protected procedure AssignProcedures; override; public @@ -317,6 +317,7 @@ type SSL_MODE_VERIFY_CA, SSL_MODE_VERIFY_IDENTITY: Integer; constructor Create(UsedDllFile, HintDefaultDll: String); override; + function IsLibMariadb: Boolean; end; var MySQLKeywords: TStringList; @@ -3155,7 +3156,7 @@ begin SSL_MODE_REQUIRED := 3; SSL_MODE_VERIFY_CA := 4; SSL_MODE_VERIFY_IDENTITY := 5; - if String(ExtractFileName(FDllFile)).StartsWith('libmariadb', True) then begin + if IsLibMariadb then begin // Differences in libmariadb MYSQL_OPT_SSL_VERIFY_SERVER_CERT := 21; MARIADB_OPT_TLS_VERSION := 7005; @@ -3174,6 +3175,12 @@ begin end; end; +function TMySQLLib.IsLibMariadb: Boolean; +begin + // libmariadb used (not libmysql) ? + Result := LowerCase(ExtractFileName(FDllFile)).IndexOf('libmariadb') > -1; +end; + procedure TMySQLLib.AssignProcedures; begin AssignProc(@mysql_affected_rows, 'mysql_affected_rows'); diff --git a/source/main.pas b/source/main.pas index d2e60c6d..8fbe0ba1 100644 --- a/source/main.pas +++ b/source/main.pas @@ -2777,7 +2777,7 @@ var var MaxPixels: Integer; begin - MaxPixels := StatusBar.Canvas.TextWidth(SampleText) + VirtualImageListMain.Width + 20; + MaxPixels := StatusBar.Canvas.TextWidth(SampleText) + VirtualImageListMain.Width + 30; Result := Round(Min(MaxPixels, Width / 100 * MaxPercentage)); end; begin @@ -2789,11 +2789,11 @@ begin Exit; // Super intelligent calculation of status bar panel width - w1 := CalcPanelWidth('r10 : c10 (10 KiB)', 10); - w2 := CalcPanelWidth('Connected: 1 day, 00:00 h', 10); - w3 := CalcPanelWidth('MariaDB or MySQL 5.7.6', 15); - w4 := CalcPanelWidth('Uptime: 13 days, 00:00 h', 15); - w5 := CalcPanelWidth('Server time: 20:00 ', 10); + w1 := CalcPanelWidth('r10 : c10 (10 KiB)', 12); + w2 := CalcPanelWidth('Connected: 1 day, 00:00 h', 12); + w3 := CalcPanelWidth('MariaDB or MySQL 5.7.6', 12); + w4 := CalcPanelWidth('Uptime: 13 days, 00:00 h', 12); + w5 := CalcPanelWidth('Server time: 20:00 PM', 12); w6 := CalcPanelWidth('DummyDummyDummyDummyDummy', 20); w0 := StatusBar.Width - w1 - w2 - w3 - w4 - w5 - w6; //logsql(format('IconWidth:%d 0:%d 1:%d 2:%d 3:%d 4:%d 5:%d 6:%d', [VirtualImageListMain.Width, w0, w1, w2, w3, w4, w5, w6])); diff --git a/source/usermanager.pas b/source/usermanager.pas index 6e84dead..c32eaf31 100644 --- a/source/usermanager.pas +++ b/source/usermanager.pas @@ -1319,15 +1319,19 @@ begin 0: RequireClause := RequireClause + 'NONE'; 1: RequireClause := RequireClause + 'SSL'; 2: RequireClause := RequireClause + 'X509'; - 3: RequireClause := RequireClause + 'CIPHER '+FConnection.EscapeString(editCipher.Text)+' ISSUER '+FConnection.EscapeString(editIssuer.Text)+' SUBJECT '+FConnection.EscapeString(editSubject.Text); + 3: RequireClause := RequireClause + 'CIPHER '+FConnection.EscapeString(editCipher.Text)+' AND ISSUER '+FConnection.EscapeString(editIssuer.Text)+' AND SUBJECT '+FConnection.EscapeString(editSubject.Text); end; if (FocusedUser.SSL = comboSSL.ItemIndex) and (FocusedUser.Cipher = editCipher.Text) and (FocusedUser.Issuer = editIssuer.Text) and (FocusedUser.Subject = editSubject.Text) - then + then begin RequireClause := ''; - Grant := Grant + RequireClause; + end; + if not RequireClause.IsEmpty then begin + FConnection.Query('ALTER USER ' + UserHost + RequireClause); + FConnection.ShowWarnings; + end; end; WithClauses := TStringList.Create; @@ -1347,7 +1351,7 @@ begin if WithClauses.Count > 0 then Grant := Grant + ' WITH ' + Implode(' ', WithClauses); - if P.Added or (P.AddedPrivs.Count > 0) or (WithClauses.Count > 0) or (RequireClause <> '') then begin + if P.Added or (P.AddedPrivs.Count > 0) or (WithClauses.Count > 0) then begin FConnection.Query(Grant); FConnection.ShowWarnings; end;