Introduce SSL support on session manager. Code parts from SuperNiFF. Fixes issue #518.

This commit is contained in:
Ansgar Becker
2010-02-26 00:13:17 +00:00
parent f9ea5dc1ec
commit 4e84c99a72
5 changed files with 221 additions and 59 deletions

View File

@ -4,10 +4,10 @@ object connform: Tconnform
Top = 129
BorderIcons = [biSystemMenu]
Caption = 'Session manager'
ClientHeight = 303
ClientHeight = 378
ClientWidth = 494
Color = clBtnFace
Constraints.MinHeight = 310
Constraints.MinHeight = 360
Constraints.MinWidth = 510
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
@ -25,7 +25,7 @@ object connform: Tconnform
OnShow = FormShow
DesignSize = (
494
303)
378)
PixelsPerInch = 96
TextHeight = 13
object lblSession: TLabel
@ -49,7 +49,7 @@ object connform: Tconnform
end
object btnSave: TButton
Left = 64
Top = 270
Top = 345
Width = 50
Height = 25
Anchors = [akLeft, akBottom]
@ -60,7 +60,7 @@ object connform: Tconnform
object btnOpen: TButton
Tag = 15
Left = 320
Top = 270
Top = 345
Width = 80
Height = 25
Anchors = [akRight, akBottom]
@ -73,7 +73,7 @@ object connform: Tconnform
object btnCancel: TButton
Tag = 16
Left = 406
Top = 270
Top = 345
Width = 80
Height = 25
Anchors = [akRight, akBottom]
@ -86,7 +86,7 @@ object connform: Tconnform
Left = 9
Top = 27
Width = 162
Height = 235
Height = 310
Anchors = [akLeft, akTop, akBottom]
EditDelay = 250
Header.AutoSizeIndex = 0
@ -121,7 +121,7 @@ object connform: Tconnform
end
object btnNew: TButton
Left = 8
Top = 270
Top = 345
Width = 50
Height = 25
Anchors = [akLeft, akBottom]
@ -131,7 +131,7 @@ object connform: Tconnform
end
object btnDelete: TButton
Left = 120
Top = 270
Top = 345
Width = 50
Height = 25
Anchors = [akLeft, akBottom]
@ -143,14 +143,14 @@ object connform: Tconnform
Left = 177
Top = 10
Width = 309
Height = 254
Height = 329
Anchors = [akLeft, akTop, akRight, akBottom]
Caption = 'Details'
TabOrder = 1
Visible = False
DesignSize = (
309
254)
329)
object lblHost: TLabel
Tag = 6
Left = 8
@ -189,28 +189,28 @@ object connform: Tconnform
end
object lblLastConnectLeft: TLabel
Left = 8
Top = 191
Top = 271
Width = 65
Height = 13
Caption = 'Last connect:'
end
object lblLastConnectRight: TLabel
Left = 99
Top = 191
Left = 110
Top = 271
Width = 5
Height = 13
Caption = '?'
end
object lblCreatedLeft: TLabel
Left = 8
Top = 227
Top = 307
Width = 43
Height = 13
Caption = 'Created:'
end
object lblCreatedRight: TLabel
Left = 99
Top = 227
Left = 110
Top = 307
Width = 5
Height = 13
Caption = '?'
@ -224,48 +224,75 @@ object connform: Tconnform
end
object lblCounterLeft: TLabel
Left = 8
Top = 209
Top = 289
Width = 43
Height = 13
Caption = 'Counter:'
end
object lblCounterRight: TLabel
Left = 99
Top = 209
Left = 110
Top = 289
Width = 5
Height = 13
Caption = '?'
end
object lblStartupScript: TLabel
Left = 8
Top = 168
Top = 243
Width = 69
Height = 13
Caption = 'Startup script:'
FocusControl = editStartupScript
end
object lblSSLPrivateKey: TLabel
Tag = 6
Left = 8
Top = 168
Width = 78
Height = 13
Caption = 'SSL private key:'
FocusControl = editSSLPrivateKey
end
object lblSSLCACertificate: TLabel
Tag = 6
Left = 8
Top = 193
Width = 89
Height = 13
Caption = 'SSL CA certificate:'
FocusControl = editSSLCACertificate
end
object lblSSLCertificate: TLabel
Tag = 6
Left = 8
Top = 218
Width = 72
Height = 13
Caption = 'SSL certificate:'
FocusControl = editSSLCertificate
end
object editHost: TEdit
Left = 99
Left = 110
Top = 42
Width = 205
Width = 194
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 2
OnChange = Modification
end
object editUsername: TEdit
Left = 99
Left = 110
Top = 67
Width = 205
Width = 194
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 3
OnChange = Modification
end
object editPassword: TEdit
Left = 99
Left = 110
Top = 92
Width = 205
Width = 194
Height = 21
Anchors = [akLeft, akTop, akRight]
PasswordChar = '*'
@ -273,7 +300,7 @@ object connform: Tconnform
OnChange = Modification
end
object editPort: TEdit
Left = 99
Left = 110
Top = 117
Width = 60
Height = 21
@ -283,9 +310,9 @@ object connform: Tconnform
end
object chkCompressed: TCheckBox
Tag = 12
Left = 99
Left = 110
Top = 142
Width = 205
Width = 194
Height = 17
Anchors = [akLeft, akTop, akRight]
Caption = 'Compressed client/server protocol'
@ -293,7 +320,7 @@ object connform: Tconnform
OnClick = Modification
end
object radioTypeTCPIP: TRadioButton
Left = 99
Left = 110
Top = 19
Width = 67
Height = 17
@ -304,7 +331,7 @@ object connform: Tconnform
OnClick = radioNetTypeClick
end
object radioTypeNamedPipe: TRadioButton
Left = 172
Left = 183
Top = 19
Width = 113
Height = 17
@ -313,7 +340,7 @@ object connform: Tconnform
OnClick = radioNetTypeClick
end
object updownPort: TUpDown
Left = 159
Left = 170
Top = 117
Width = 17
Height = 21
@ -323,25 +350,66 @@ object connform: Tconnform
OnChangingEx = updownPortChangingEx
end
object editStartupScript: TButtonedEdit
Left = 99
Left = 110
Top = 240
Width = 194
Height = 21
Anchors = [akLeft, akTop, akRight]
Images = MainForm.ImageListMain
RightButton.ImageIndex = 52
RightButton.Visible = True
TabOrder = 11
OnChange = Modification
OnDblClick = PickFile
OnRightButtonClick = PickFile
end
object editSSLPrivateKey: TButtonedEdit
Left = 110
Top = 165
Width = 205
Width = 194
Height = 21
Anchors = [akLeft, akTop, akRight]
Images = MainForm.ImageListMain
RightButton.ImageIndex = 52
RightButton.Visible = True
TabOrder = 8
TextHint = 'Select SQL file ...'
OnChange = Modification
OnDblClick = editStartupScriptRightButtonClick
OnRightButtonClick = editStartupScriptRightButtonClick
OnDblClick = PickFile
OnRightButtonClick = PickFile
end
object editSSLCACertificate: TButtonedEdit
Left = 110
Top = 190
Width = 194
Height = 21
Anchors = [akLeft, akTop, akRight]
Images = MainForm.ImageListMain
RightButton.ImageIndex = 52
RightButton.Visible = True
TabOrder = 9
OnChange = Modification
OnDblClick = PickFile
OnRightButtonClick = PickFile
end
object editSSLCertificate: TButtonedEdit
Left = 110
Top = 215
Width = 194
Height = 21
Anchors = [akLeft, akTop, akRight]
Images = MainForm.ImageListMain
RightButton.ImageIndex = 52
RightButton.Visible = True
TabOrder = 10
OnChange = Modification
OnDblClick = PickFile
OnRightButtonClick = PickFile
end
end
object popupSessions: TPopupMenu
Images = MainForm.ImageListMain
Left = 176
Top = 267
Top = 347
object Save1: TMenuItem
Caption = 'Save'
ImageIndex = 10
@ -365,6 +433,6 @@ object connform: Tconnform
Interval = 60000
OnTimer = TimerStatisticsTimer
Left = 208
Top = 267
Top = 347
end
end

View File

@ -50,6 +50,12 @@ type
lblHelp: TLabel;
lblStartupScript: TLabel;
editStartupScript: TButtonedEdit;
lblSSLPrivateKey: TLabel;
editSSLPrivateKey: TButtonedEdit;
lblSSLCACertificate: TLabel;
editSSLCACertificate: TButtonedEdit;
editSSLCertificate: TButtonedEdit;
lblSSLCertificate: TLabel;
procedure FormCreate(Sender: TObject);
procedure btnOpenClick(Sender: TObject);
procedure FormShow(Sender: TObject);
@ -81,13 +87,14 @@ type
Direction: TUpDownDirection);
procedure editPortChange(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure editStartupScriptRightButtonClick(Sender: TObject);
procedure PickFile(Sender: TObject);
private
{ Private declarations }
FLoaded: Boolean;
FSessionNames: TStringlist;
FSessionModified, FSessionAdded: Boolean;
FOrgNetType: Byte;
FOrgSSL_Key, FOrgSSL_Cert, FOrgSSL_CA,
FOrgHost, FOrgUser, FOrgPassword, FOrgStartupScript: String;
FOrgCompressed: Boolean;
FOrgPort: Integer;
@ -193,6 +200,9 @@ begin
Params.Username := editUsername.Text;
Params.Password := editPassword.Text;
Params.Port := MakeInt(editPort.Text);
Params.SSLPrivateKey := editSSLPrivateKey.Text;
Params.SSLCertificate := editSSLCertificate.Text;
Params.SSLCACertificate := editSSLCACertificate.Text;
Params.StartupScriptFilename := editStartupScript.Text;
if chkCompressed.Checked then
Params.Options := Params.Options + [opCompress]
@ -223,6 +233,9 @@ begin
MainReg.WriteString(REGNAME_STARTUPSCRIPT, editStartupScript.Text);
if IsNew then
MainReg.WriteString(REGNAME_SESSIONCREATED, DateTimeToStr(Now));
MainReg.WriteString(REGNAME_SSL_KEY, editSSLPrivateKey.Text);
MainReg.WriteString(REGNAME_SSL_CERT, editSSLCertificate.Text);
MainReg.WriteString(REGNAME_SSL_CA, editSSLCACertificate.Text);
FSessionModified := False;
FSessionAdded := False;
RefreshSessionList(True);
@ -381,6 +394,9 @@ begin
FOrgPort := StrToIntDef(GetRegValue(REGNAME_PORT, '', SelectedSession), DEFAULT_PORT);
FOrgCompressed := GetRegValue(REGNAME_COMPRESSED, DEFAULT_COMPRESSED, SelectedSession);
FOrgStartupScript := GetRegValue(REGNAME_STARTUPSCRIPT, '', SelectedSession);
FOrgSSL_Key := GetRegValue(REGNAME_SSL_KEY, '', SelectedSession);
FOrgSSL_Cert := GetRegValue(REGNAME_SSL_CERT, '', SelectedSession);
FOrgSSL_CA := GetRegValue(REGNAME_SSL_CA, '', SelectedSession);
end else begin
// Editing a new session, not saved yet
FOrgNetType := NETTYPE_TCPIP;
@ -390,6 +406,9 @@ begin
FOrgPort := DEFAULT_PORT;
FOrgCompressed := DEFAULT_COMPRESSED;
FOrgStartupScript := DEFAULT_STARTUPSCRIPT;
FOrgSSL_Key := '';
FOrgSSL_Cert := '';
FOrgSSL_CA := '';
end;
FLoaded := False;
@ -402,6 +421,9 @@ begin
editUsername.Text := FOrgUser;
editPassword.Text := FOrgPassword;
editPort.Text := IntToStr(FOrgPort);
editSSLPrivateKey.Text := FOrgSSL_Key;
editSSLCertificate.Text := FOrgSSL_Cert;
editSSLCACertificate.Text := FOrgSSL_CA;
chkCompressed.Checked := FOrgCompressed;
editStartupScript.Text := FOrgStartupScript;
FLoaded := True;
@ -530,11 +552,17 @@ begin
if FLoaded then begin
if radioTypeTCPIP.Checked then NetType := NETTYPE_TCPIP
else NetType := NETTYPE_NAMEDPIPE;
FSessionModified := (FOrgHost <> editHost.Text) or (FOrgUser <> editUsername.Text)
or (FOrgPassword <> editPassword.Text) or (FOrgPort <> updownPort.Tag)
FSessionModified := (FOrgHost <> editHost.Text)
or (FOrgUser <> editUsername.Text)
or (FOrgPassword <> editPassword.Text)
or (FOrgPort <> updownPort.Tag)
or (FOrgCompressed <> chkCompressed.Checked)
or (FOrgNetType <> NetType)
or (FOrgStartupScript <> editStartupScript.Text);
or (FOrgStartupScript <> editStartupScript.Text)
or (FOrgSSL_Key <> editSSLPrivateKey.Text)
or (FOrgSSL_Cert <> editSSLCertificate.Text)
or (FOrgSSL_CA <> editSSLCACertificate.Text);
ListSessions.Repaint;
ValidateControls;
end;
@ -542,15 +570,24 @@ end;
procedure Tconnform.radioNetTypeClick(Sender: TObject);
var
IsTCP: Boolean;
begin
// Toggle between TCP/IP and named pipes mode
if radioTypeTCPIP.Checked then
IsTCP := radioTypeTCPIP.Checked;
if IsTCP then
lblHost.Caption := 'Hostname / IP:'
else
lblHost.Caption := 'Socket name:';
editPort.Enabled := radioTypeTCPIP.Checked;
lblPort.Enabled := editPort.Enabled;
updownPort.Enabled := editPort.Enabled;
lblPort.Enabled := IsTCP;
editPort.Enabled := lblPort.Enabled;
updownPort.Enabled := lblPort.Enabled;
lblSSLPrivateKey.Enabled := IsTCP;
editSSLPrivateKey.Enabled := lblSSLPrivateKey.Enabled;
lblSSLCACertificate.Enabled := IsTCP;
editSSLCACertificate.Enabled := lblSSLCACertificate.Enabled;
lblSSLCertificate.Enabled := IsTCP;
editSSLCertificate.Enabled := lblSSLCertificate.Enabled;
Modification(Sender);
end;
@ -623,16 +660,32 @@ begin
end;
procedure Tconnform.editStartupScriptRightButtonClick(Sender: TObject);
procedure Tconnform.PickFile(Sender: TObject);
var
Selector: TOpenDialog;
Edit: TButtonedEdit;
i: Integer;
Control: TControl;
begin
// Select startup SQL file
// Select startup SQL file, SSL file or whatever button clicked
Edit := Sender as TButtonedEdit;
Selector := TOpenDialog.Create(Self);
Selector.FileName := editStartupScript.Text;
Selector.Filter := 'SQL-files (*.sql)|*.sql|All files (*.*)|*.*';
if Edit = editStartupScript then
Selector.Filter := 'SQL-files (*.sql)|*.sql|All files (*.*)|*.*'
else
Selector.Filter := 'Privacy Enhanced Mail certificates (*.pem)|*.pem|Certificates (*.crt)|*.crt|All files (*.*)|*.*';
// Find relevant label and set open dialog's title
for i:=0 to Edit.Parent.ControlCount - 1 do begin
Control := Edit.Parent.Controls[i];
if (Control is TLabel) and ((Control as TLabel).FocusControl = Edit) then begin
Selector.Title := 'Select ' + (Control as TLabel).Caption;
break;
end;
end;
if Selector.Execute then begin
editStartupScript.Text := Selector.FileName;
Edit.Text := Selector.FileName;
Modification(Selector);
end;
Selector.Free;

View File

@ -122,6 +122,9 @@ const
DEFAULT_PASSWORD = '';
REGNAME_PORT = 'Port';
DEFAULT_PORT = 3306;
REGNAME_SSL_KEY = 'SSL_Key';
REGNAME_SSL_CERT = 'SSL_Cert';
REGNAME_SSL_CA = 'SSL_CA';
REGNAME_NETTYPE = 'NetType';
DEFAULT_NETTYPE = NETTYPE_TCPIP;
REGNAME_COMPRESSED = 'Compressed';

View File

@ -1527,6 +1527,9 @@ begin
LoadedParams.Username := GetRegValue(REGNAME_USER, DEFAULT_USER, LastSession);
LoadedParams.Password := decrypt(GetRegValue(REGNAME_PASSWORD, DEFAULT_PASSWORD, LastSession));
LoadedParams.Port := StrToIntDef(GetRegValue(REGNAME_PORT, '', LastSession), DEFAULT_PORT);
LoadedParams.SSLPrivateKey := GetRegValue(REGNAME_SSL_KEY, '', LastSession);
LoadedParams.SSLCertificate := GetRegValue(REGNAME_SSL_CERT, '', LastSession);
LoadedParams.SSLCACertificate := GetRegValue(REGNAME_SSL_CA, '', LastSession);
LoadedParams.StartupScriptFilename := GetRegValue(REGNAME_STARTUPSCRIPT, DEFAULT_STARTUPSCRIPT, LastSession);
if GetRegValue(REGNAME_COMPRESSED, DEFAULT_COMPRESSED, LastSession) then
LoadedParams.Options := LoadedParams.Options + [opCompress]
@ -1614,6 +1617,9 @@ begin
FCmdlineConnectionParams.Username := GetRegValue(REGNAME_USER, DEFAULT_USER, FCmdlineSessionName);
FCmdlineConnectionParams.Password := decrypt(GetRegValue(REGNAME_PASSWORD, DEFAULT_PASSWORD, FCmdlineSessionName));
FCmdlineConnectionParams.Port := StrToIntDef(GetRegValue(REGNAME_PORT, '', FCmdlineSessionName), DEFAULT_PORT);
FCmdlineConnectionParams.SSLPrivateKey := GetRegValue(REGNAME_SSL_KEY, '', FCmdlineSessionName);
FCmdlineConnectionParams.SSLCertificate := GetRegValue(REGNAME_SSL_CERT, '', FCmdlineSessionName);
FCmdlineConnectionParams.SSLCACertificate := GetRegValue(REGNAME_SSL_CA, '', FCmdlineSessionName);
FCmdlineConnectionParams.StartupScriptFilename := GetRegValue(REGNAME_STARTUPSCRIPT, DEFAULT_STARTUPSCRIPT, FCmdlineSessionName);
if GetRegValue(REGNAME_COMPRESSED, DEFAULT_COMPRESSED, FCmdlineSessionName) then
FCmdlineConnectionParams.Options := FCmdlineConnectionParams.Options + [opCompress]
@ -2447,6 +2453,9 @@ begin
Params.Username := GetRegValue(REGNAME_USER, '', Session);
Params.Password := decrypt(GetRegValue(REGNAME_PASSWORD, '', Session));
Params.Port := StrToIntDef(GetRegValue(REGNAME_PORT, '', Session), DEFAULT_PORT);
Params.SSLPrivateKey := GetRegValue(REGNAME_SSL_KEY, '', Session);
Params.SSLCertificate := GetRegValue(REGNAME_SSL_CERT, '', Session);
Params.SSLCACertificate := GetRegValue(REGNAME_SSL_CA, '', Session);
Params.StartupScriptFilename := GetRegValue(REGNAME_STARTUPSCRIPT, '', Session);
if GetRegValue(REGNAME_COMPRESSED, DEFAULT_COMPRESSED, Session) then
Params.Options := Params.Options + [opCompress]

View File

@ -47,7 +47,8 @@ type
TConnectionParameters = class(TObject)
strict private
FHostname, FSocketname, FUsername, FPassword, FStartupScriptFilename: String;
FHostname, FSocketname, FUsername, FPassword, FStartupScriptFilename,
FSSLPrivateKey, FSSLCertificate, FSSLCACertificate: String;
FPort: Integer;
FOptions: TMySQLClientOptions;
public
@ -60,6 +61,9 @@ type
property Password: String read FPassword write FPassword;
property StartupScriptFilename: String read FStartupScriptFilename write FStartupScriptFilename;
property Options: TMySQLClientOptions read FOptions write FOptions;
property SSLPrivateKey: String read FSSLPrivateKey write FSSLPrivateKey;
property SSLCertificate: String read FSSLCertificate write FSSLCertificate;
property SSLCACertificate: String read FSSLCACertificate write FSSLCACertificate;
end;
@ -216,6 +220,9 @@ begin
FUsername := DEFAULT_USER;
FPassword := '';
FPort := DEFAULT_PORT;
FSSLPrivateKey := '';
FSSLCertificate := '';
FSSLCACertificate := '';
FStartupScriptFilename := DEFAULT_STARTUPSCRIPT;
FOptions := [opCompress, opLocalFiles, opInteractive, opProtocol41, opMultiStatements];
end;
@ -254,7 +261,9 @@ var
Connected: PMYSQL;
ClientFlags: Integer;
Error, tmpdb: String;
SSLResult: Byte;
UsingPass, Protocol, CurCharset: String;
IsNamedPipe: Boolean;
begin
FActive := Value;
@ -262,6 +271,32 @@ begin
// Get handle
FHandle := mysql_init(nil);
// Prepare connection
IsNamedPipe := FParameters.Hostname = '.';
if IsNamedPipe then Protocol := 'named pipe' else Protocol := 'TCP/IP';
if FParameters.Password <> '' then UsingPass := 'Yes' else UsingPass := 'No';
Log(lcInfo, 'Connecting to '+FParameters.Hostname+' via '+Protocol+
', username '+FParameters.Username+
', using password: '+UsingPass+' ...');
// Be sure we don't pass mutually exclusive options
if not IsNamedPipe and
(FParameters.SSLPrivateKey <> '') and
(FParameters.SSLCertificate <> '') and
(FParameters.SSLCACertificate <> '') then begin
FParameters.Options := FParameters.Options + [opSSL];
{ TODO : Use Cipher and CAPath parameters }
SSLResult := mysql_ssl_set(
FHandle,
PansiChar(AnsiString(FParameters.SSLPrivateKey)),
PansiChar(AnsiString(FParameters.SSLCertificate)),
PansiChar(AnsiString(FParameters.SSLCACertificate)),
{PansiChar(AnsiString(FParameters.CApath))}nil,
{PansiChar(AnsiString(FParameters.Cipher))}nil);
if SSLresult <> 0 then
raise Exception.CreateFmt('Could not connect using SSL (Error %d)', [SSLresult]);
end;
// Gather client options
ClientFlags := 0;
if opRememberOptions in FParameters.Options then ClientFlags := ClientFlags or CLIENT_REMEMBER_OPTIONS;
@ -285,12 +320,6 @@ begin
if opMultiResults in FParameters.Options then ClientFlags := ClientFlags or CLIENT_MULTI_RESULTS;
if opRememberOptions in FParameters.Options then ClientFlags := ClientFlags or CLIENT_REMEMBER_OPTIONS;
// Prepare connection
if FParameters.Hostname = '.' then Protocol := 'named pipe' else Protocol := 'TCP/IP';
if FParameters.Password <> '' then UsingPass := 'Yes' else UsingPass := 'No';
Log(lcInfo, 'Connecting to '+FParameters.Hostname+' via '+Protocol+
', username '+FParameters.Username+
', using password: '+UsingPass+' ...');
Connected := mysql_real_connect(
FHandle,
PAnsiChar(Utf8Encode(FParameters.Hostname)),