Merge branch 'setTLSVersion' (#49)

Delphi/Project/ExercismCLIInstaller.dproj

@@ -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>

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;

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

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.