Skip to content

Commit

Permalink
Force TLS 1.2
Browse files Browse the repository at this point in the history 
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.
  • Loading branch information
@rpottsoh
rpottsoh committed Aug 8, 2018
1 parent 9c9cbf7 commit b6c580f
Show file tree
Hide file tree
Showing 4 changed files with 32 additions and 209 deletions.
7 changes: 5 additions & 2 deletions Delphi/Project/ExercismCLIInstaller.dproj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -100,10 +100,13 @@
<AppEnableHighDPI>true</AppEnableHighDPI>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<DCC_ExeOutput>Win32\Release</DCC_ExeOutput>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.5.2.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.5.2.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.5.3.2;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.5;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
<DCC_DcuOutput>Win32\Release</DCC_DcuOutput>
<VerInfo_MinorVer>5</VerInfo_MinorVer>
<VerInfo_Release>2</VerInfo_Release>
<VerInfo_Release>3</VerInfo_Release>
<VerInfo_Build>2</VerInfo_Build>
<VerInfo_PreRelease>true</VerInfo_PreRelease>
<VerInfo_AutoIncVersion>true</VerInfo_AutoIncVersion>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
Expand Down
33 changes: 23 additions & 10 deletions Delphi/Project/Source/uClientDownloadFrm.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -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;
Expand Down
65 changes: 1 addition & 64 deletions Delphi/Project/Source/uInstallLocationFrm.dfm
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
object frmInstallLocation: TfrmInstallLocation
Left = 0
Top = 0
ActiveControl = btnBrowse
BorderIcons = []
BorderStyle = bsDialog
Caption = 'Exercism CLI Install'
Expand All @@ -14,7 +15,6 @@ object frmInstallLocation: TfrmInstallLocation
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnActivate = FormActivate
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -6365,7 +6340,6 @@ object frmInstallLocation: TfrmInstallLocation
Width = 75
Height = 25
Caption = '&Next >'
Enabled = False
TabOrder = 2
OnClick = btnNextClick
end
Expand All @@ -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
136 changes: 3 additions & 133 deletions Delphi/Project/Source/uInstallLocationFrm.pas
View file
Original file line number Diff line number Diff line change
@@ -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;
Expand All @@ -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
Expand All @@ -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;
Expand Down Expand Up @@ -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.

0 comments on commit b6c580f

Please sign in to comment.