diff --git a/source/connections.dfm b/source/connections.dfm index e5cb9b7b..71ad13f2 100644 --- a/source/connections.dfm +++ b/source/connections.dfm @@ -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 diff --git a/source/connections.pas b/source/connections.pas index f0f71694..db55bed8 100644 --- a/source/connections.pas +++ b/source/connections.pas @@ -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; diff --git a/source/const.inc b/source/const.inc index aa2b2501..1acf2f89 100644 --- a/source/const.inc +++ b/source/const.inc @@ -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'; diff --git a/source/main.pas b/source/main.pas index d1489bed..e899f53c 100644 --- a/source/main.pas +++ b/source/main.pas @@ -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] diff --git a/source/mysql_connection.pas b/source/mysql_connection.pas index b0735755..817bbf11 100644 --- a/source/mysql_connection.pas +++ b/source/mysql_connection.pas @@ -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)),