Issue #2046: support 4 different SSL verification levels on PostgreSQL

This commit is contained in:
Ansgar Becker
2024-12-18 18:08:33 +01:00
parent 1a7e529907
commit c312f6325a

View File

@ -2862,16 +2862,10 @@ end;
procedure TPgConnection.SetActive(Value: Boolean); procedure TPgConnection.SetActive(Value: Boolean);
var var
dbname, ConnInfo, Error: String; dbname, ConnectionString, OptionValue, Error: String;
ConnectOptions: TStringList;
FinalHost, ErrorHint: String; FinalHost, ErrorHint: String;
FinalPort: Integer; FinalPort, i: Integer;
function EscapeConnectOption(Option: String): String;
begin
// See issue #704 and #1417, and docs: https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING
Result := StringReplace(Option, '\', '\\', [rfReplaceAll]);
Result := StringReplace(Result, '''', '\''', [rfReplaceAll]);
end;
begin begin
if Value then begin if Value then begin
DoBeforeConnect; DoBeforeConnect;
@ -2887,25 +2881,44 @@ begin
StartSSHTunnel(FinalHost, FinalPort); StartSSHTunnel(FinalHost, FinalPort);
ConnInfo := 'host='''+EscapeConnectOption(FinalHost)+''' '+ // Compose connection string
'port='''+IntToStr(FinalPort)+''' '+ ConnectOptions := TStringList.Create;
'user='''+EscapeConnectOption(FParameters.Username)+''' ' + ConnectOptions.Duplicates := dupIgnore;
'password='''+EscapeConnectOption(FParameters.Password)+''' '+ ConnectOptions
'dbname='''+EscapeConnectOption(dbname)+''' '+ .AddPair('host', FinalHost)
'application_name='''+EscapeConnectOption(APPNAME)+''''; .AddPair('port', IntToStr(FinalPort))
.AddPair('user', FParameters.Username)
.AddPair('password', FParameters.Password)
.AddPair('dbname', dbname)
.AddPair('application_name', APPNAME)
.AddPair('sslmode', 'disable');
if FParameters.WantSSL then begin if FParameters.WantSSL then begin
ConnInfo := ConnInfo + ' sslmode=''require'''; // Be aware .AddPair would add duplicates
case FParameters.SSLVerification of
0: ConnectOptions.Values['sslmode'] := 'require';
1: ConnectOptions.Values['sslmode'] := 'verify-ca';
2: ConnectOptions.Values['sslmode'] := 'verify-full';
end;
if FParameters.SSLPrivateKey <> '' then if FParameters.SSLPrivateKey <> '' then
ConnInfo := ConnInfo + ' sslkey='''+EscapeConnectOption(FParameters.SSLPrivateKey)+''''; ConnectOptions.AddPair('sslkey', FParameters.SSLPrivateKey);
if FParameters.SSLCertificate <> '' then if FParameters.SSLCertificate <> '' then
ConnInfo := ConnInfo + ' sslcert='''+EscapeConnectOption(FParameters.SSLCertificate)+''''; ConnectOptions.AddPair('sslcert', FParameters.SSLCertificate);
if FParameters.SSLCACertificate <> '' then if FParameters.SSLCACertificate <> '' then
ConnInfo := ConnInfo + ' sslrootcert='''+EscapeConnectOption(FParameters.SSLCACertificate)+''''; ConnectOptions.AddPair('sslrootcert', FParameters.SSLCACertificate);
//if FParameters.SSLCipher <> '' then ?? //if FParameters.SSLCipher <> '' then ??
end; end;
ConnectionString := '';
for i:=0 to ConnectOptions.Count-1 do begin
// Escape values. See issue #704 and #1417, and docs: https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING
OptionValue := ConnectOptions.ValueFromIndex[i];
OptionValue := StringReplace(OptionValue, '\', '\\', [rfReplaceAll]);
OptionValue := StringReplace(OptionValue, '''', '\''', [rfReplaceAll]);
ConnectionString := ConnectionString + ConnectOptions.Names[i] + '=''' + OptionValue + ''' ';
end;
ConnectOptions.Free;
ConnectionString := ConnectionString.TrimRight;
FHandle := FLib.PQconnectdb(PAnsiChar(AnsiString(ConnectionString)));
FHandle := FLib.PQconnectdb(PAnsiChar(AnsiString(ConnInfo)));
if FLib.PQstatus(FHandle) = CONNECTION_BAD then begin if FLib.PQstatus(FHandle) = CONNECTION_BAD then begin
Error := LastErrorMsg; Error := LastErrorMsg;
Log(lcError, Error); Log(lcError, Error);