Skip to content
Permalink
Browse files

Issue #704: Add basic SSL support for PostgreSQL connections.

  • Loading branch information...
ansgarbecker committed Jul 29, 2019
1 parent b2a3551 commit 6839c827c4b78cfac7643262ef5d2687637b513f
Showing with 18 additions and 2 deletions.
  1. +1 −1 source/connections.pas
  2. +17 −1 source/dbconnection.pas
@@ -1271,7 +1271,7 @@ procedure Tconnform.ValidateControls;
lblDatabase.Caption := _('Database')+':'
else
lblDatabase.Caption := _('Databases')+':';
chkWantSSL.Enabled := Params.NetType in [ntMySQL_TCPIP, ntMySQL_SSHtunnel];
chkWantSSL.Enabled := Params.NetType in [ntMySQL_TCPIP, ntMySQL_SSHtunnel, ntPgSQL_TCPIP, ntPgSQL_SSHtunnel];
lblSSLPrivateKey.Enabled := Params.WantSSL;
editSSLPrivateKey.Enabled := Params.WantSSL;
lblSSLCACertificate.Enabled := Params.WantSSL;
@@ -2071,12 +2071,28 @@ procedure TPgConnection.SetActive(Value: Boolean);
'password='''+FParameters.Password+''' '+
'dbname='''+dbname+''' '+
'application_name='''+APPNAME+'''';
if FParameters.WantSSL then begin
ConnInfo := ConnInfo + ' sslmode=''require''';
if FParameters.SSLPrivateKey <> '' then
ConnInfo := ConnInfo + ' sslkey='''+FParameters.SSLPrivateKey+'''';
if FParameters.SSLCertificate <> '' then
ConnInfo := ConnInfo + ' sslcert='''+FParameters.SSLCertificate+'''';
if FParameters.SSLCACertificate <> '' then
ConnInfo := ConnInfo + ' sslrootcert='''+FParameters.SSLCACertificate+'''';
//if FParameters.SSLCipher <> '' then ??
end;


FHandle := FLib.PQconnectdb(PAnsiChar(AnsiString(ConnInfo)));
if FLib.PQstatus(FHandle) = CONNECTION_BAD then begin
Error := LastErrorMsg;
Log(lcError, Error);
FConnectionStarted := 0;
FLib.PQfinish(FHandle); // free the memory
try
FLib.PQfinish(FHandle); // free the memory
except
on E:EAccessViolation do;
end;
FHandle := nil;
if FPlink <> nil then
FPlink.Free;

0 comments on commit 6839c82

Please sign in to comment.
You can’t perform that action at this time.