From 967f8df3532e2d0391ea4e271817f5d33dcb700d Mon Sep 17 00:00:00 2001 From: Marc Durdin Date: Mon, 6 Jul 2020 09:15:03 +1000 Subject: [PATCH] feat(windows): Replace http downloader and bug fixes Uses THTTPClient standard library instead of (very old) THTTPUploader, and prepare to remove UfrmDownloadProgress in a future PR. --- ...eyman.Setup.System.OnlineResourceCheck.pas | 105 +++++++++--------- ...Keyman.Setup.System.ResourceDownloader.pas | 77 +++++++------ windows/src/desktop/setup/RunTools.pas | 21 +++- .../desktop/setup/UfrmDownloadProgress.pas | 14 +-- windows/src/desktop/setup/UfrmRunDesktop.pas | 1 + windows/src/desktop/setup/setup.dpr | 2 - windows/src/desktop/setup/setup.dproj | 2 - 7 files changed, 117 insertions(+), 105 deletions(-) diff --git a/windows/src/desktop/setup/Keyman.Setup.System.OnlineResourceCheck.pas b/windows/src/desktop/setup/Keyman.Setup.System.OnlineResourceCheck.pas index f6a9eccd58..46fd6b1477 100644 --- a/windows/src/desktop/setup/Keyman.Setup.System.OnlineResourceCheck.pas +++ b/windows/src/desktop/setup/Keyman.Setup.System.OnlineResourceCheck.pas @@ -13,8 +13,11 @@ type implementation uses + System.Net.HttpClient, + System.Net.URLClient, + System.SysUtils, + GlobalProxySettings, - httpuploader, Keyman.System.UpdateCheckResponse, KeymanVersion, PackageInfo, @@ -23,7 +26,7 @@ uses class procedure TOnlineResourceCheck.QueryServer(ASilent: Boolean; AInstallInfo: TInstallInfo); var - http: THTTPUploader; + http: THTTPClient; pack: TInstallInfoPackage; ucr: TUpdateCheckResponse; ucrpack: TUpdateCheckResponsePackage; @@ -32,71 +35,65 @@ var currentVersion: string; lang: TUpdateCheckResponseLanguage; iipl: TInstallInfoPackageLanguage; + url: TURI; + response: IHTTPResponse; + u: AnsiString; begin currentVersion := AInstallInfo.MsiLocations.LatestVersion(SKeymanVersion_Min_Evergreen); - http := THTTPUploader.Create(nil); + url := TURI.Create(MakeAPIURL(API_Path_UpdateCheck_Windows)); + url.AddParameter('version', currentVersion); + url.AddParameter('tier', KeymanVersion.CKeymanVersionInfo.Tier); + for pack in AInstallInfo.Packages do + url.AddParameter('package_'+pack.ID, pack.Locations.LatestVersion); + http := THTTPClient.Create; try - http.ShowUI := not ASilent; - http.Fields.Add('version', ansistring(currentVersion)); - // TODO: allow override of this tier with a command line parameter or filename rename - http.Fields.Add('tier', ansistring(KeymanVersion.CKeymanVersionInfo.Tier)); - for pack in AInstallInfo.Packages do - http.Fields.Add(ansistring('package_'+pack.ID), ansistring(pack.Locations.LatestVersion)); - - http.Proxy.Server := GetProxySettings.Server; - http.Proxy.Port := GetProxySettings.Port; - http.Proxy.Username := GetProxySettings.Username; - http.Proxy.Password := GetProxySettings.Password; - - http.Request.HostName := API_Server; - http.Request.Protocol := API_Protocol; - http.Request.UrlPath := API_Path_UpdateCheck_Windows; - - http.Upload; - if http.Response.StatusCode <> 200 then + response := http.Get(url.ToString); + if response.StatusCode <> 200 then begin // TODO: log failed response //raise EOnlineUpdateCheck.Create('Error '+IntToStr(Response.StatusCode)); Exit; end; - if ucr.Parse(http.Response.MessageBodyAsString, 'msi', currentVersion) then - begin - for ucrpack in ucr.Packages do - begin - pack := AInstallInfo.Packages.FindById(ucrpack.ID, False); - if Assigned(pack) then - begin - packLocation := TInstallInfoPackageFileLocation.Create(iilOnline); - pack.Locations.Add(packLocation); - packLocation.Name := ucrpack.Name; - packLocation.Path := ucrpack.FileName; - packLocation.URL := ucrpack.DownloadURL; - packLocation.Version := ucrpack.NewVersion; - packLocation.Size := ucrpack.DownloadSize; - - for lang in ucrpack.Languages do - begin - iipl := TInstallInfoPackageLanguage.Create(lang.ID, lang.displayName); - packLocation.Languages.Add(iipl); - end; - end; - end; - - if ucr.Status = ucrsUpdateReady then - begin - location := TInstallInfoFileLocation.Create(iilOnline); - location.URL := ucr.InstallURL; - location.Path := ucr.FileName; - location.Version := ucr.NewVersion; - location.Size := ucr.InstallSize; - AInstallInfo.MsiLocations.Add(location); - end; - end; + u := UTF8Encode(Response.ContentAsString(TEncoding.UTF8)); finally http.Free; end; + + if ucr.Parse(u, 'msi', currentVersion) then + begin + for ucrpack in ucr.Packages do + begin + pack := AInstallInfo.Packages.FindById(ucrpack.ID, False); + if Assigned(pack) then + begin + packLocation := TInstallInfoPackageFileLocation.Create(iilOnline); + pack.Locations.Add(packLocation); + packLocation.Name := ucrpack.Name; + packLocation.Path := ucrpack.FileName; + packLocation.URL := ucrpack.DownloadURL; + packLocation.Version := ucrpack.NewVersion; + packLocation.Size := ucrpack.DownloadSize; + + for lang in ucrpack.Languages do + begin + iipl := TInstallInfoPackageLanguage.Create(lang.ID, lang.displayName); + packLocation.Languages.Add(iipl); + end; + end; + end; + + if ucr.Status = ucrsUpdateReady then + begin + location := TInstallInfoFileLocation.Create(iilOnline); + location.URL := ucr.InstallURL; + location.Path := ucr.FileName; + location.Version := ucr.NewVersion; + location.Size := ucr.InstallSize; + AInstallInfo.MsiLocations.Add(location); + end; + end; end; end. diff --git a/windows/src/desktop/setup/Keyman.Setup.System.ResourceDownloader.pas b/windows/src/desktop/setup/Keyman.Setup.System.ResourceDownloader.pas index e079316988..8cb5f35843 100644 --- a/windows/src/desktop/setup/Keyman.Setup.System.ResourceDownloader.pas +++ b/windows/src/desktop/setup/Keyman.Setup.System.ResourceDownloader.pas @@ -12,11 +12,14 @@ type FDownloadURL: string; FDownloadFilename: string; FInstallInfo: TInstallInfo; + frmDownloadProgress: TfrmDownloadProgress; function DownloadFile(const ADownloadURL, ADownloadFilename: string): Boolean; procedure DownloadFileCallback(AOwner: TfrmDownloadProgress; var Result: Boolean); constructor Create(AInstallInfo: TInstallInfo); + procedure HttpReceiveData(const Sender: TObject; AContentLength, + AReadCount: Int64; var Abort: Boolean); public class function Execute(AInstallInfo: TInstallInfo; ALocation: TInstallInfoFileLocation): Boolean; end; @@ -25,10 +28,11 @@ implementation uses System.Classes, + System.Net.HttpClient, System.SysUtils, Vcl.Controls, + Winapi.Windows, - httpuploader, RunTools, SetupStrings, Upload_Settings; @@ -68,54 +72,57 @@ begin FDownloadFilename := ADownloadFilename; { Download the redistributable } - with TfrmDownloadProgress.Create(nil) do + frmDownloadProgress := TfrmDownloadProgress.Create(nil); try - Caption := 'Downloading '+ExtractFileName(ADownloadFilename); // TODO: localize - Callback := DownloadFileCallback; - Result := ShowModal = mrOk; + frmDownloadProgress.Caption := 'Downloading '+ExtractFileName(ADownloadFilename); // TODO: localize + frmDownloadProgress.Callback := DownloadFileCallback; + Result := frmDownloadProgress.ShowModal = mrOk; finally - Free; + frmDownloadProgress.Free; end; end; +procedure TResourceDownloader.HttpReceiveData(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var Abort: Boolean); +begin + // TODO: stop using this form and report back to main form instead + frmDownloadProgress.HTTPStatus(nil, 'Downloading '+ExtractFileName(FDownloadFilename), AReadCount, AContentLength); + frmDownloadProgress.HTTPCheckCancel(nil, Abort); +end; + procedure TResourceDownloader.DownloadFileCallback(AOwner: TfrmDownloadProgress; var Result: Boolean); +var + Client: THTTPClient; + Stream: TStream; + Response: IHTTPResponse; + FTempFilename: string; begin Result := False; + FTempFilename := FDownloadFilename + '.download'; + Client := THTTPClient.Create; try - with THTTPUploader.Create(AOwner) do + Client.OnReceiveData := HttpReceiveData; + + Stream := TFileStream.Create(FTempFilename, fmCreate); try - OnCheckCancel := AOwner.HTTPCheckCancel; - OnStatus := AOwner.HTTPStatus; - Request.Agent := API_UserAgent; - //Request.Protocol := Upload_Protocol; - //Request.HostName := Upload_Server; - Request.SetURL(FDownloadURL);// UrlPath := URL; - Upload; - if Response.StatusCode = 200 then + Response := Client.Get(FDownloadURL, Stream); + Result := Response.StatusCode = 200; + finally + Stream.Free; + end; + + if FileExists(FTempFilename) then + begin + if Result then begin - with TFileStream.Create(FDownloadFilename, fmCreate) do // I3476 - try - Write(Response.PMessageBody^, Response.MessageBodyLength); - finally - Free; - end; - Result := True; + if FileExists(FDownloadFilename) then + System.SysUtils.DeleteFile(FDownloadFilename); + RenameFile(FTempFilename, FDownloadFilename); end else - // TODO: Deal with circular dependency - GetRunTools.LogError(FInstallInfo.Text(ssErrorDownloadingUpdate, [Response.StatusCode])); - finally - Free; - end; - except - on E:EHTTPUploader do - begin - // TODO: Deal with circular dependency - if (E.ErrorCode = 12007) or (E.ErrorCode = 12029) - then GetRunTools.LogError(FInstallInfo.Text(ssErrorUnableToContactServer)) - else GetRunTools.LogError(FInstallInfo.Text(ssErrorUnableToContactServerDetailed, [E.Message])); - Result := False; + System.SysUtils.DeleteFile(FTempFilename); end; + finally + Client.Free; end; end; diff --git a/windows/src/desktop/setup/RunTools.pas b/windows/src/desktop/setup/RunTools.pas index d1895a74e2..9e9b995c08 100644 --- a/windows/src/desktop/setup/RunTools.pas +++ b/windows/src/desktop/setup/RunTools.pas @@ -92,7 +92,8 @@ type procedure RunVersion10Upgrade(const KMShellPath: WideString); procedure CloseKeymanApplications; // I2740 procedure DeleteBackupPath; // I2747 - procedure WaitFor(hProcess: THandle; var Waiting, Cancelled: Boolean); // I3349 + procedure WaitFor(hProcess: THandle; var Waiting, Cancelled: Boolean); + procedure WriteToLog(const msg: string); // I3349 public destructor Destroy; override; procedure CheckInternetConnectedState; @@ -100,6 +101,7 @@ type StartAfterInstall, StartWithWindows, CheckForUpdates, StartDisabled, StartWithConfiguration, AutomaticallyReportUsage: Boolean): Boolean; procedure LogError(const msg: WideString; ShowDialogIfNotSilent: Boolean = True); + procedure LogInfo(const msg: string); class procedure CheckInstalledVersion(msiLocation: TInstallInfoFileLocation); @@ -223,13 +225,18 @@ begin end; procedure TRunTools.LogError(const msg: WideString; ShowDialogIfNotSilent: Boolean = True); +begin + WriteToLog('ERROR: '+msg); + if not FSilent and ShowDialogIfNotSilent then + ShowMessageW(msg); +end; + +procedure TRunTools.WriteToLog(const msg: string); const nl: WideString = #13#10; var path: WideString; begin - if not FSilent and ShowDialogIfNotSilent then - ShowMessageW(msg); if not Assigned(FErrorLog) then begin path := TKeymanPaths.ErrorLogPath + 'setup.log'; // I2314 @@ -246,6 +253,11 @@ begin FErrorLog.Write(PWideChar(msg+nl)^, Length(msg+nl)*2); end; +procedure TRunTools.LogInfo(const msg: string); +begin + WriteToLog('INFO: '+msg); +end; + function TRunTools.IsNewerVersionInstalled(const NewVersion: WideString): Boolean; begin Result := (FInstallInfo.InstalledVersion.Version <> '') and @@ -451,7 +463,7 @@ var begin if not Assigned(msiLocation) or (msiLocation.LocationType = iilOnline) then begin - UpgradeCode := '{c70af17c-8b9e-47a1-a099-b65aee3dc8b4}'; // Keyman 11+ + UpgradeCode := '{c70af17c-8b9e-47a1-a099-b65aee3dc8b4}'; // Keyman 11+ // TODO: move constant somewhere else end else begin @@ -595,6 +607,7 @@ begin if Assigned(packLocation) then begin // TODO: need to make sure remote file is downloaded before this + LogInfo('Downloading '+packLocation.Url); if packLocation.LocationType = iilOnline then if not TResourceDownloader.Execute(FInstallInfo, packLocation) then begin diff --git a/windows/src/desktop/setup/UfrmDownloadProgress.pas b/windows/src/desktop/setup/UfrmDownloadProgress.pas index fce84e99ab..e4de35ca13 100644 --- a/windows/src/desktop/setup/UfrmDownloadProgress.pas +++ b/windows/src/desktop/setup/UfrmDownloadProgress.pas @@ -26,7 +26,7 @@ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, ComCtrls, httpuploader; + Dialogs, StdCtrls, ComCtrls; type TfrmDownloadProgress = class; @@ -46,9 +46,8 @@ type procedure WMUserFormShown(var Message: TMessage); message WM_USER; public - procedure HTTPCheckCancel(Sender: THTTPUploader; var Cancel: Boolean); - //procedure HTTPFileProgress(Sender: THTTPUploader; const FileName: string; dwFileBytesSent, dwLocalFileSize, dwSecondsToFileCompletion, dwOverallBytesSent, dwOverallBytesTotal, dwSecondsToOverallCompletion, dwBytesPerSecond: DWord); - procedure HTTPStatus(Sender: THTTPUploader; const Message: string; Position, Total: Int64); // I2855 + procedure HTTPCheckCancel(Sender: TObject; var Cancel: Boolean); + procedure HTTPStatus(Sender: TObject; const Message: string; Position, Total: Int64); // I2855 property Callback: TDownloadProgressCallback read FCallback write FCallback; property Cancel: Boolean read FCancel; end; @@ -74,12 +73,12 @@ begin PostMessage(Handle, WM_USER, 0, 0); // Starts process after form displays end; -procedure TfrmDownloadProgress.HTTPCheckCancel(Sender: THTTPUploader; var Cancel: Boolean); +procedure TfrmDownloadProgress.HTTPCheckCancel(Sender: TObject; var Cancel: Boolean); begin Cancel := FCancel; end; -procedure TfrmDownloadProgress.HTTPStatus(Sender: THTTPUploader; +procedure TfrmDownloadProgress.HTTPStatus(Sender: TObject; const Message: string; Position, Total: Int64); // I2855 begin if Total = 0 @@ -105,8 +104,7 @@ begin then ModalResult := mrOk else ModalResult := mrCancel; except - on EHTTPUploaderCancel do ModalResult := mrCancel; - on E:EHTTPUploader do + on E:Exception do begin ShowMessage(E.Message); ModalResult := mrCancel; diff --git a/windows/src/desktop/setup/UfrmRunDesktop.pas b/windows/src/desktop/setup/UfrmRunDesktop.pas index 04416a318f..e3a1f57193 100644 --- a/windows/src/desktop/setup/UfrmRunDesktop.pas +++ b/windows/src/desktop/setup/UfrmRunDesktop.pas @@ -156,6 +156,7 @@ end; procedure TfrmRunDesktop.cmdExitClick(Sender: TObject); begin + // TODO: we should use a boolean flag here rather than comparing caption if cmdExit.Caption = FInstallInfo.Text(ssCancelButton) then // I2644 begin if MessageDlg(FInstallInfo.Text(ssCancelQuery), mtConfirmation, mbOkCancel, 0) = mrCancel then Exit; diff --git a/windows/src/desktop/setup/setup.dpr b/windows/src/desktop/setup/setup.dpr index 2d50271797..c0fc32f075 100644 --- a/windows/src/desktop/setup/setup.dpr +++ b/windows/src/desktop/setup/setup.dpr @@ -5,14 +5,12 @@ uses UfrmDownloadProgress in 'UfrmDownloadProgress.pas', CommonControls in 'CommonControls.pas', VersionInfo in '..\..\global\delphi\general\VersionInfo.pas', - httpuploader in '..\..\global\delphi\general\httpuploader.pas', RegistryKeys in '..\..\global\delphi\general\RegistryKeys.pas', klog in '..\..\global\delphi\general\klog.pas', Upload_Settings in '..\..\global\delphi\general\Upload_Settings.pas', DebugPaths in '..\..\global\delphi\general\DebugPaths.pas', GetOsVersion in '..\..\global\delphi\general\GetOsVersion.pas', TntDialogHelp in 'TntDialogHelp.pas', - httpuploader_messageprocessor_windows in 'httpuploader_messageprocessor_windows.pas', SetupForm in 'SetupForm.pas', resource in 'resource.pas', SetupStrings in 'SetupStrings.pas', diff --git a/windows/src/desktop/setup/setup.dproj b/windows/src/desktop/setup/setup.dproj index e3268082b5..d136b196af 100644 --- a/windows/src/desktop/setup/setup.dproj +++ b/windows/src/desktop/setup/setup.dproj @@ -100,14 +100,12 @@ - -