From b6c580f9ae2d57c51cdf20e535a5453850f68ed9 Mon Sep 17 00:00:00 2001 From: Ryan Potts Date: Wed, 8 Aug 2018 00:14:42 -0400 Subject: [PATCH] Force TLS 1.2 Instead of relying on Windows having necessary TLS version setup properly. Force correct version at run-time. bump version 1.5.3 force btnBrowse to be active control Without defining active control btnCancel was being selected at run-time. Pressing enter would cause installer to exit. replace literals with enumerated values Remove Check TLS Version code add exception handler if RESTRequest1 should raise an exception lets capture it and allow the installer to exit gracefully instead of appearing to be hung. --- Delphi/Project/ExercismCLIInstaller.dproj | 7 +- Delphi/Project/Source/uClientDownloadFrm.pas | 33 +++-- Delphi/Project/Source/uInstallLocationFrm.dfm | 65 +-------- Delphi/Project/Source/uInstallLocationFrm.pas | 136 +----------------- 4 files changed, 32 insertions(+), 209 deletions(-) diff --git a/Delphi/Project/ExercismCLIInstaller.dproj b/Delphi/Project/ExercismCLIInstaller.dproj index e429480..667d427 100644 --- a/Delphi/Project/ExercismCLIInstaller.dproj +++ b/Delphi/Project/ExercismCLIInstaller.dproj @@ -100,10 +100,13 @@ true true Win32\Release - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.5.2.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.5.2.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.5.3.2;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.5;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) Win32\Release 5 - 2 + 3 + 2 + true + true DEBUG;$(DCC_Define) diff --git a/Delphi/Project/Source/uClientDownloadFrm.pas b/Delphi/Project/Source/uClientDownloadFrm.pas index ec99c18..b848c2c 100644 --- a/Delphi/Project/Source/uClientDownloadFrm.pas +++ b/Delphi/Project/Source/uClientDownloadFrm.pas @@ -192,8 +192,13 @@ procedure TfrmDownload.btnStopDownloadClick(Sender: TObject); end; procedure TfrmDownload.FormCreate(Sender: TObject); +var + TLSProts: THTTPSecureProtocols; begin + TLSProts := [THTTPSecureProtocol.TLS12]; + RESTClient1.SecureProtocols := TLSProts; FClient := THTTPClient.Create; + FClient.SecureProtocols := TLSProts; FClient.OnReceiveData := ReceiveDataEvent; NextClicked := false; FinishClicked := false; @@ -221,17 +226,25 @@ function TfrmDownload.DetermineArchitecture(var aStatus: TResultStatus): Boolean procedure TfrmDownload.FetchRESTRequest(var aStatus: TResultStatus); begin aStatus := rsCancel; - RESTRequest1.Execute; - if RESTResponse1.StatusCode = 200 then - aStatus := rsNext - else - begin - mStatus.Lines.Add('Failed to establish connection'); - if MessageDlg('Failed to establish connection. Confirm internet connection then Retry or Cancel.', - mtError, [mbRetry, mbCancel], 0) = mrRetry then + try + RESTRequest1.Execute; + if RESTResponse1.StatusCode = 200 then + aStatus := rsNext + else begin - aStatus := rsRepeat; - mStatus.Lines.Add(''); + mStatus.Lines.Add('Failed to establish connection'); + if MessageDlg('Failed to establish connection. Confirm internet connection then Retry or Cancel.', + mtError, [mbRetry, mbCancel], 0) = mrRetry then + begin + aStatus := rsRepeat; + mStatus.Lines.Add(''); + end; + end; + except + on E: Exception do + begin + messagedlg(format('%s',[E.Message]),mtError,[mbOk],0); + close; end; end; end; diff --git a/Delphi/Project/Source/uInstallLocationFrm.dfm b/Delphi/Project/Source/uInstallLocationFrm.dfm index 0b6c8ff..bae30c9 100644 --- a/Delphi/Project/Source/uInstallLocationFrm.dfm +++ b/Delphi/Project/Source/uInstallLocationFrm.dfm @@ -1,6 +1,7 @@ object frmInstallLocation: TfrmInstallLocation Left = 0 Top = 0 + ActiveControl = btnBrowse BorderIcons = [] BorderStyle = bsDialog Caption = 'Exercism CLI Install' @@ -14,7 +15,6 @@ object frmInstallLocation: TfrmInstallLocation Font.Style = [] OldCreateOrder = False Position = poScreenCenter - OnActivate = FormActivate OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 @@ -70,31 +70,6 @@ object frmInstallLocation: TfrmInstallLocation ShowHint = True Transparent = True end - object lblUpdateTLS: TOvcURL - Left = 127 - Top = 248 - Width = 386 - Height = 19 - Hint = - 'https://support.microsoft.com/en-us/help/3140245/update-to-enabl' + - 'e-tls-1-1-and-tls-1-2-as-a-default-secure-protocols-in' - Caption = 'Microsoft instructions for updating default TLS settings' - URL = - 'https://support.microsoft.com/en-us/help/3140245/update-to-enabl' + - 'e-tls-1-1-and-tls-1-2-as-a-default-secure-protocols-in' - Color = clRed - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'Tahoma' - Font.Style = [fsUnderline] - ParentColor = False - ParentFont = False - ParentShowHint = False - ShowHint = True - Transparent = True - Visible = False - end object Panel1: TPanel Left = 0 Top = 0 @@ -6365,7 +6340,6 @@ object frmInstallLocation: TfrmInstallLocation Width = 75 Height = 25 Caption = '&Next >' - Enabled = False TabOrder = 2 OnClick = btnNextClick end @@ -6392,41 +6366,4 @@ object frmInstallLocation: TfrmInstallLocation TabOrder = 4 OnClick = btnBrowseClick end - object rcCheckTLSVersion: TRESTClient - Accept = 'application/json, text/plain; q=0.9, text/html;q=0.8,' - AcceptCharset = 'UTF-8, *;q=0.8' - BaseURL = 'https://www.howsmyssl.com/a/check' - Params = <> - HandleRedirects = True - RaiseExceptionOn500 = False - Left = 248 - Top = 48 - end - object rrCheckTLSVersion: TRESTRequest - Client = rcCheckTLSVersion - Params = <> - Response = rResponseCheckTLSVersion - SynchronizedEvents = False - Left = 328 - Top = 52 - end - object rResponseCheckTLSVersion: TRESTResponse - ContentType = 'application/json' - RootElement = 'tls_version' - Left = 416 - Top = 48 - end - object tmrCheckTLS: TTimer - Enabled = False - Interval = 200 - OnTimer = tmrCheckTLSTimer - Left = 76 - Top = 200 - end - object tmrToggler: TTimer - Enabled = False - OnTimer = tmrTogglerTimer - Left = 508 - Top = 192 - end end diff --git a/Delphi/Project/Source/uInstallLocationFrm.pas b/Delphi/Project/Source/uInstallLocationFrm.pas index cf08523..dcd6a6a 100644 --- a/Delphi/Project/Source/uInstallLocationFrm.pas +++ b/Delphi/Project/Source/uInstallLocationFrm.pas @@ -1,47 +1,14 @@ unit uInstallLocationFrm; {_define SimTLSCheckFailure} +{$define SkipTLSCheck} interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, uTypes, Vcl.StdCtrls, Vcl.ExtCtrls, - Vcl.Imaging.pngimage, System.UITypes, ovcurl, IPPeerClient, REST.Client, - Data.Bind.Components, Data.Bind.ObjectScope; + Vcl.Imaging.pngimage, System.UITypes, ovcurl; type - ICheckTLS = interface(IInvokable) - ['{2AED8C0C-BF88-4A06-A3B2-418799CD28EF}'] - function GetTLSOK: boolean; - function GetStatusCode: integer; - function GetTLSVersion: string; - function GetMessageStr: string; - property TLSok: boolean read GetTLSOK; - property StatusCode: integer read GetStatusCode; - property TLSVersion: string read GetTLSVersion; - property ErrMessage: string read GetMessageStr; - end; - - TCheckTLS = class(TInterfacedObject, ICheckTLS) - strict private - const - cDesiredVersion: double = 1.2; - var - fTLSVersion: string; - fTLSOK: boolean; - fStatusCode: integer; - fMessageStr: string; - function GetTLSOK: boolean; - function GetStatusCode: integer; - function GetTLSVersion: string; - function GetMessageStr: string; - public - constructor Create(aRESTRequest: TRestRequest; aRESTResponse: TRESTResponse); - property TLSok: boolean read GetTLSOK; - property StatusCode: integer read GetStatusCode; - property TLSVersion: string read GetTLSVersion; - property ErrMessage: string read GetMessageStr; - end; - TfrmInstallLocation = class(TForm) Panel1: TPanel; Label1: TLabel; @@ -55,20 +22,11 @@ TfrmInstallLocation = class(TForm) Label5: TLabel; OvcURL4: TOvcURL; Image1: TImage; - rcCheckTLSVersion: TRESTClient; - rrCheckTLSVersion: TRESTRequest; - rResponseCheckTLSVersion: TRESTResponse; - lblUpdateTLS: TOvcURL; - tmrCheckTLS: TTimer; imgV2Logo: TImage; - tmrToggler: TTimer; procedure btnCancelClick(Sender: TObject); procedure btnNextClick(Sender: TObject); procedure btnBrowseClick(Sender: TObject); procedure FormCreate(Sender: TObject); - procedure FormActivate(Sender: TObject); - procedure tmrCheckTLSTimer(Sender: TObject); - procedure tmrTogglerTimer(Sender: TObject); private { Private declarations } public @@ -80,14 +38,12 @@ TfrmInstallLocation = class(TForm) implementation uses - Vcl.FileCtrl, - System.IOUtils; + Vcl.FileCtrl; {$R *.dfm} var thisForm: TfrmInstallLocation; - function ShowInstallLocationForm(var aInstallInfo: TInstallInfo): TResultStatus; begin result := rsCancel; @@ -154,96 +110,10 @@ procedure TfrmInstallLocation.btnNextClick(Sender: TObject); end; end; -procedure TfrmInstallLocation.FormActivate(Sender: TObject); -begin - tmrCheckTLS.Enabled := true; -end; - procedure TfrmInstallLocation.FormCreate(Sender: TObject); begin NextClicked := false; SetWindowLong(Handle, GWL_EXSTYLE, WS_EX_APPWINDOW); end; -procedure TfrmInstallLocation.tmrCheckTLSTimer(Sender: TObject); -var - CheckTLS: ICheckTLS; -begin - tmrCheckTLS.Enabled := false; - CheckTLS := TCheckTLS.Create(rrCheckTLSVersion, rResponseCheckTLSVersion); - btnNext.Enabled := CheckTLS.TLSok; - if not btnNext.Enabled then - begin - tmrToggler.Enabled := true; - lblUpdateTLS.Visible := true; - MessageDlg(CheckTLS.ErrMessage,mtError,[mbok],0); - end; -end; - -procedure TfrmInstallLocation.tmrTogglerTimer(Sender: TObject); -begin - lblUpdateTLS.Transparent := not lblUpdateTLS.Transparent; -end; - -{ TCheckTLS } - -constructor TCheckTLS.Create(aRESTRequest: TRestRequest; aRESTResponse: TRESTResponse); -var - actualVersion: double; - lFormatSettings: TFormatSettings; -begin - fTLSOK := false; - {$ifndef SimTLSCheckFailure} - aRESTRequest.Execute; - fStatusCode := aRESTResponse.StatusCode; - fMessageStr := ''; - fTLSVersion := ''; - if fStatusCode = 200 then - begin - lFormatSettings := TFormatSettings.Create; - lFormatSettings.ThousandSeparator := ','; - lFormatSettings.DecimalSeparator := '.'; - fTLSVersion := aRESTResponse.JSONText.Replace('"TLS ',''); - fTLSVersion := fTLSVersion - .Replace('"','') - .Replace(' ',''); - actualVersion := StrToFloat(fTLSVersion, lFormatSettings); - fTLSOK := actualVersion >= cDesiredVersion; - if not fTLSOK then - fMessageStr := format('TLS Version = %s, must be %0.1f or greater.'+#13#10+ - 'GitHub requires at least version 1.2'+#13#10+ - 'Please click the blinking link for instructions from Microsoft on updating TLS.',[fTLSVersion,cDesiredVersion]); - end - else - begin - fMessageStr := format('Err: REST Status Code %d', [fStatusCode]); - fTLSOk := false; - end; - {$else} - fMessageStr := format('TLS Version = %s, must be %0.1f or greater.'+#13#10+ - 'GitHub requires at least version 1.2'+#13#10+ - 'Please click the blinking link for instructions from Microsoft on updating TLS',['1.0',cDesiredVersion]); - {$endif} -end; - -function TCheckTLS.GetMessageStr: string; -begin - result := fMessageStr; -end; - -function TCheckTLS.GetStatusCode: integer; -begin - result := fStatusCode; -end; - -function TCheckTLS.GetTLSOK: boolean; -begin - result := fTLSOk; -end; - -function TCheckTLS.GetTLSVersion: string; -begin - result := fTLSVersion; -end; - end.