diff --git a/common/windows/delphi/general/Keyman.System.ExecutionHistory.pas b/common/windows/delphi/general/Keyman.System.ExecutionHistory.pas new file mode 100644 index 00000000000..33dff407802 --- /dev/null +++ b/common/windows/delphi/general/Keyman.System.ExecutionHistory.pas @@ -0,0 +1,52 @@ +{ + Keyman is copyright (C) SIL Global. MIT License. + + This module provides functionality to track the execution state of the Keyman + engine. It uses a global atom to record whether Keyman has started during the + current session and checks if it has previously run. +} +unit Keyman.System.ExecutionHistory; + + +interface + +const + AtomName = 'KeymanSessionFlag'; + +function RecordKeymanStarted : Boolean; +function HasKeymanRun : Boolean; + +implementation + +uses + System.SysUtils, + Winapi.Windows, + KLog; + +function RecordKeymanStarted : Boolean; +var + atom: WORD; +begin + atom := GlobalAddAtom(AtomName); + if atom = 0 then + begin + // TODO-WINDOWS-UPDATES: #10210 log to sentry + Result := False; + end + else + Result := True; +end; + +function HasKeymanRun : Boolean; +begin + Result := GlobalFindAtom(AtomName) <> 0; + if not Result then + begin + if GetLastError <> ERROR_FILE_NOT_FOUND then + begin + // TODO-WINDOWS-UPDATES: log to Sentry + end; + end; +end; + +end. diff --git a/common/windows/delphi/general/RegistryKeys.pas b/common/windows/delphi/general/RegistryKeys.pas index e351b3860ff..bacca938c66 100644 --- a/common/windows/delphi/general/RegistryKeys.pas +++ b/common/windows/delphi/general/RegistryKeys.pas @@ -175,8 +175,10 @@ interface SRegValue_CharMapSourceData = 'charmap source data'; // LM - SRegValue_AvailableLanguages = 'available languages'; //CU - SRegValue_CurrentLanguage = 'current language'; //CU + SRegValue_AvailableLanguages = 'available languages'; // CU + SRegValue_CurrentLanguage = 'current language'; // CU + + SRegValue_Update_State = 'update state'; // CU { Privacy } @@ -312,8 +314,10 @@ interface SRegValue_ActiveProject_Filename = 'project filename'; SRegValue_ActiveProject_SourcePath = 'source path'; + SRegValue_AutomaticUpdates = 'automatic updates'; //CU SRegValue_CheckForUpdates = 'check for updates'; // CU SRegValue_LastUpdateCheckTime = 'last update check time'; // CU + SRegValue_ApplyNow = 'apply now'; // CU Start the install now even though it will require an restart SRegValue_UpdateCheck_UseProxy = 'update check use proxy'; // CU SRegValue_UpdateCheck_ProxyHost = 'update check proxy host'; // CU diff --git a/oem/firstvoices/windows/src/xml/strings.xml b/oem/firstvoices/windows/src/xml/strings.xml index fbd099c8c74..692a582dd72 100644 --- a/oem/firstvoices/windows/src/xml/strings.xml +++ b/oem/firstvoices/windows/src/xml/strings.xml @@ -388,6 +388,11 @@ Show welcome screen + + + + Automatically download updates in the background, for installation later + diff --git a/windows/src/desktop/kmshell/kmshell.dpr b/windows/src/desktop/kmshell/kmshell.dpr index 829006912a4..87f9fbf6bfc 100644 --- a/windows/src/desktop/kmshell/kmshell.dpr +++ b/windows/src/desktop/kmshell/kmshell.dpr @@ -180,7 +180,12 @@ uses Keyman.Configuration.System.Main in 'main\Keyman.Configuration.System.Main.pas', UpdateXMLRenderer in 'render\UpdateXMLRenderer.pas', Keyman.System.UpdateCheckStorage in 'main\Keyman.System.UpdateCheckStorage.pas', - Keyman.System.RemoteUpdateCheck in 'main\Keyman.System.RemoteUpdateCheck.pas'; + Keyman.System.RemoteUpdateCheck in 'main\Keyman.System.RemoteUpdateCheck.pas', + Keyman.System.UpdateStateMachine in 'main\Keyman.System.UpdateStateMachine.pas', + Keyman.System.DownloadUpdate in 'main\Keyman.System.DownloadUpdate.pas', + Keyman.System.ExecutionHistory in '..\..\..\..\common\windows\delphi\general\Keyman.System.ExecutionHistory.pas', + Keyman.Configuration.UI.UfrmStartInstallNow in 'main\Keyman.Configuration.UI.UfrmStartInstallNow.pas' {frmInstallNow}, + Keyman.Configuration.UI.UfrmStartInstall in 'main\Keyman.Configuration.UI.UfrmStartInstall.pas' {frmStartInstall}; {$R VERSION.RES} {$R manifest.res} diff --git a/windows/src/desktop/kmshell/kmshell.dproj b/windows/src/desktop/kmshell/kmshell.dproj index 45c71ffb03f..5be47294005 100644 --- a/windows/src/desktop/kmshell/kmshell.dproj +++ b/windows/src/desktop/kmshell/kmshell.dproj @@ -357,6 +357,17 @@ + + + + +
frmInstallNow
+ dfm + + +
frmStartInstall
+ dfm + Cfg_2 @@ -418,21 +429,21 @@ False - + kmshell.exe true - + kmshell.exe true - + - kmshell.rsm + kmshell.exe true @@ -1231,6 +1242,7 @@ + False 12 diff --git a/windows/src/desktop/kmshell/kmshell.res b/windows/src/desktop/kmshell/kmshell.res new file mode 100644 index 00000000000..80494425e9c Binary files /dev/null and b/windows/src/desktop/kmshell/kmshell.res differ diff --git a/windows/src/desktop/kmshell/main/BackgroundUpdateStateDiagram.md b/windows/src/desktop/kmshell/main/BackgroundUpdateStateDiagram.md new file mode 100644 index 00000000000..160d54b2c10 --- /dev/null +++ b/windows/src/desktop/kmshell/main/BackgroundUpdateStateDiagram.md @@ -0,0 +1,11 @@ +``` mermaid +stateDiagram + [*] --> Idle + Idle --> UpdateAvailable + UpdateAvailable --> Downloading + Downloading --> Installing + Downloading --> WaitingRestart + WaitingRestart --> Installing + Installing --> PostInstall + PostInstall --> Idle +``` diff --git a/windows/src/desktop/kmshell/main/Keyman.Configuration.UI.UfrmStartInstall.dfm b/windows/src/desktop/kmshell/main/Keyman.Configuration.UI.UfrmStartInstall.dfm new file mode 100644 index 00000000000..9084afe1b69 --- /dev/null +++ b/windows/src/desktop/kmshell/main/Keyman.Configuration.UI.UfrmStartInstall.dfm @@ -0,0 +1,47 @@ +object frmStartInstall: TfrmStartInstall + Left = 0 + Top = 0 + Caption = 'Keyman Update' + ClientHeight = 225 + ClientWidth = 425 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object lblInstallUpdate: TLabel + Left = 128 + Top = 96 + Width = 175 + Height = 19 + Caption = 'Keyman update available' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + end + object cmdInstall: TButton + Left = 228 + Top = 184 + Width = 75 + Height = 25 + Caption = 'Install' + ModalResult = 1 + TabOrder = 0 + end + object cmdLater: TButton + Left = 336 + Top = 184 + Width = 75 + Height = 25 + Caption = 'Close' + ModalResult = 8 + TabOrder = 1 + end +end diff --git a/windows/src/desktop/kmshell/main/Keyman.Configuration.UI.UfrmStartInstall.pas b/windows/src/desktop/kmshell/main/Keyman.Configuration.UI.UfrmStartInstall.pas new file mode 100644 index 00000000000..8571c0b5158 --- /dev/null +++ b/windows/src/desktop/kmshell/main/Keyman.Configuration.UI.UfrmStartInstall.pas @@ -0,0 +1,39 @@ +{ + Keyman is copyright (C) SIL Global. MIT License. + + // TODO-WINDOWS-UPDATES: Localise all the labels and captions. +} +unit Keyman.Configuration.UI.UfrmStartInstall; +interface + +uses + System.Classes, + System.SysUtils, + System.Variants, + Vcl.Controls, + Vcl.Dialogs, + Vcl.ExtCtrls, + Vcl.Forms, + Vcl.Graphics, + Vcl.StdCtrls, + Winapi.Messages, + Winapi.Windows, + UfrmKeymanBase, + UserMessages; + +type + TfrmStartInstall = class(TfrmKeymanBase) + cmdInstall: TButton; + cmdLater: TButton; + lblInstallUpdate: TLabel; + private + public + end; + + +implementation + +{$R *.dfm} + + +end. diff --git a/windows/src/desktop/kmshell/main/Keyman.Configuration.UI.UfrmStartInstallNow.dfm b/windows/src/desktop/kmshell/main/Keyman.Configuration.UI.UfrmStartInstallNow.dfm new file mode 100644 index 00000000000..eae54930403 --- /dev/null +++ b/windows/src/desktop/kmshell/main/Keyman.Configuration.UI.UfrmStartInstallNow.dfm @@ -0,0 +1,61 @@ +object frmStartInstallNow: TfrmStartInstallNow + Left = 0 + Top = 0 + Caption = 'Keyman Update' + ClientHeight = 225 + ClientWidth = 425 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object lblUpdateMessage: TLabel + Left = 56 + Top = 88 + Width = 274 + Height = 19 + Caption = 'Keyman and Windows will be restarted' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + WordWrap = True + end + object lblUpdateNow: TLabel + Left = 56 + Top = 40 + Width = 115 + Height = 25 + Caption = 'Update Now' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -21 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + end + object cmdInstall: TButton + Left = 228 + Top = 184 + Width = 75 + Height = 25 + Caption = 'Update' + ModalResult = 1 + TabOrder = 0 + end + object cmdLater: TButton + Left = 336 + Top = 184 + Width = 75 + Height = 25 + Caption = 'Close' + ModalResult = 8 + TabOrder = 1 + end +end diff --git a/windows/src/desktop/kmshell/main/Keyman.Configuration.UI.UfrmStartInstallNow.pas b/windows/src/desktop/kmshell/main/Keyman.Configuration.UI.UfrmStartInstallNow.pas new file mode 100644 index 00000000000..5f9c9caefc7 --- /dev/null +++ b/windows/src/desktop/kmshell/main/Keyman.Configuration.UI.UfrmStartInstallNow.pas @@ -0,0 +1,40 @@ +{ + Keyman is copyright (C) SIL Global. MIT License. + + // TODO-WINDOWS-UPDATES: Localise all the labels and captions. +} +unit Keyman.Configuration.UI.UfrmStartInstallNow; +interface + +uses + System.Classes, + System.SysUtils, + System.Variants, + Vcl.Controls, + Vcl.Dialogs, + Vcl.ExtCtrls, + Vcl.Forms, + Vcl.Graphics, + Vcl.StdCtrls, + Winapi.Messages, + Winapi.Windows, + UfrmKeymanBase, + UserMessages; + +type + TfrmStartInstallNow = class(TfrmKeymanBase) + cmdInstall: TButton; + cmdLater: TButton; + lblUpdateMessage: TLabel; + lblUpdateNow: TLabel; + private + public + end; + +implementation + +{$R *.dfm} + + + +end. diff --git a/windows/src/desktop/kmshell/main/Keyman.System.DownloadUpdate.pas b/windows/src/desktop/kmshell/main/Keyman.System.DownloadUpdate.pas new file mode 100644 index 00000000000..f91c8f6ea4d --- /dev/null +++ b/windows/src/desktop/kmshell/main/Keyman.System.DownloadUpdate.pas @@ -0,0 +1,186 @@ +(* + * Keyman is copyright (C) SIL Global. MIT License. + *) +unit Keyman.System.DownloadUpdate; + +interface +uses + System.Classes, + System.SysUtils, + httpuploader, + Keyman.System.UpdateCheckResponse, + KeymanPaths, + OnlineUpdateCheck; + +type + TDownloadUpdateParams = record + TotalSize: Integer; + TotalDownloads: Integer; + StartPosition: Integer; + end; + + TDownloadUpdate = class + private + FShowErrors: Boolean; + FDownload: TDownloadUpdateParams; + (** + * + * Performs updates download in the background. + * @params SavePath The path where the downloaded files will be saved. + * + *@returns A Boolean value indicating the overall result of the + * download process. + *) + function DoDownloadUpdates(SavePath: string; Params: TUpdateCheckResponse): Boolean; + + public + + constructor Create; + destructor Destroy; override; + + + function DownloadUpdates : Boolean; + // TODO-WINDOWS-UPDATES: verify filesizes match the ucr metadata so we know we don't have partial downloades. + //function VerifyAllFilesDownloaded : Boolean; + property ShowErrors: Boolean read FShowErrors write FShowErrors; + + end; + +implementation + + +uses + System.StrUtils, + System.Types, + ErrorControlledRegistry, + GlobalProxySettings, + keymanapi_TLB, + KeymanVersion, + Keyman.System.UpdateCheckStorage, + KLog, + kmint, + OnlineUpdateCheckMessages, + RegistryKeys, + Upload_Settings, + utilkmshell; + + // TODO-WINDOWS-UPDATES: temp wrapper for converting showmessage to logs don't know where + // if not using klog + procedure LogMessage(LogMessage: string); + begin + KL.Log(LogMessage); + end; + +constructor TDownloadUpdate.Create; +begin + inherited Create; + + FShowErrors := True; + KL.Log('TDownloadUpdate.Create'); +end; + +destructor TDownloadUpdate.Destroy; +begin + inherited Destroy; +end; + +function TDownloadUpdate.DoDownloadUpdates(SavePath: string; Params: TUpdateCheckResponse): Boolean; +var + i : Integer; + http: THttpUploader; + fs: TFileStream; + + function DownloadFile(const url, savepath: string): Boolean; + begin + try + http := THttpUploader.Create(nil); + try + http.Proxy.Server := GetProxySettings.Server; + http.Proxy.Port := GetProxySettings.Port; + http.Proxy.Username := GetProxySettings.Username; + http.Proxy.Password := GetProxySettings.Password; + http.Request.Agent := API_UserAgent; + + http.Request.SetURL(url); + http.Upload; + if http.Response.StatusCode = 200 then + begin + fs := TFileStream.Create(savepath, fmCreate); + try + fs.Write(http.Response.PMessageBody^, http.Response.MessageBodyLength); + finally + fs.Free; + end; + Result := True; + end + else // I2742 + begin + // If it fails we set to false but will try the other files + Exit(False); + end; + finally + http.Free; + end; + except + on E:EHTTPUploader do + begin + if (E.ErrorCode = 12007) or (E.ErrorCode = 12029) + then LogMessage(S_OnlineUpdate_UnableToContact) + else LogMessage(WideFormat(S_OnlineUpdate_UnableToContact_Error, [E.Message])); + Result := False; + end; + end; + end; + +begin + Result := False; + + FDownload.TotalSize := 0; + FDownload.TotalDownloads := 0; + + // Keyboard Packages + FDownload.StartPosition := 0; + for i := 0 to High(Params.Packages) do + begin + Inc(FDownload.TotalDownloads); + Inc(FDownload.TotalSize, Params.Packages[i].DownloadSize); + Params.Packages[i].SavePath := SavePath + Params.Packages[i].FileName; + if not DownloadFile(Params.Packages[i].DownloadURL, Params.Packages[i].SavePath) then // I2742 + begin + Params.Packages[i].Install := False; // Download failed but install other files + end; + FDownload.StartPosition := FDownload.StartPosition + Params.Packages[i].DownloadSize; + end; + + // Keyman Installer + Inc(FDownload.TotalDownloads); + Inc(FDownload.TotalSize, Params.InstallSize); + if not DownloadFile(Params.InstallURL, SavePath + Params.FileName) then // I2742 + begin + // TODO-WINDOWS-UPDATES: #10210 convert to error log. + LogMessage('DoDownloadUpdates Failed to download' + Params.InstallURL); + end + else + begin + // If installer has downloaded that is success even + // if zero packages were downloaded. + Result := True; + end; +end; + +function TDownloadUpdate.DownloadUpdates: Boolean; +var + DownloadBackGroundSavePath : String; + ucr: TUpdateCheckResponse; +begin + DownloadBackGroundSavePath := IncludeTrailingPathDelimiter(TKeymanPaths.KeymanUpdateCachePath); + if TUpdateCheckStorage.LoadUpdateCacheData(ucr) then + begin + Result := DoDownloadUpdates(DownloadBackGroundSavePath, ucr); + KL.Log('DownloadUpdates.DownloadUpdates: DownloadResult = '+IntToStr(Ord(Result))); + end + else + Result := False; +end; + +end. diff --git a/windows/src/desktop/kmshell/main/Keyman.System.RemoteUpdateCheck.pas b/windows/src/desktop/kmshell/main/Keyman.System.RemoteUpdateCheck.pas index 0eebd52ff93..9e4b0b007e2 100644 --- a/windows/src/desktop/kmshell/main/Keyman.System.RemoteUpdateCheck.pas +++ b/windows/src/desktop/kmshell/main/Keyman.System.RemoteUpdateCheck.pas @@ -1,10 +1,10 @@ -{ +(** * Keyman is copyright (C) SIL International. MIT License. * * Keyman.System.RemoteUpdateCheck: Checks for keyboard package and Keyman - for Windows updates. -} -unit Keyman.System.RemoteUpdateCheck; // I3306 + * for Windows updates. +*) +unit Keyman.System.RemoteUpdateCheck; // I3306 interface @@ -16,6 +16,9 @@ interface Keyman.System.UpdateCheckResponse, OnlineUpdateCheck; +const + CheckPeriod: Integer = 7; // Days between checking for updates + type ERemoteUpdateCheck = class(Exception); @@ -31,19 +34,23 @@ TRemoteUpdateCheck = class private FForce: Boolean; FRemoteResult: TRemoteUpdateCheckResult; - FErrorMessage: string; - FShowErrors: Boolean; - FDownload: TRemoteUpdateCheckDownloadParams; - FCheckOnly: Boolean; - - function DownloadUpdates(Params: TUpdateCheckResponse) : Boolean; - procedure DoDownloadUpdates(SavePath: string; Params: TUpdateCheckResponse; var Result: Boolean); + (** + * Performs an online query of both the main keyman package and + * the keyboard packages. It utilizes the kmcom API to retrieve the current + * packages. The function then performs an HTTP request to query the remote + * versions of these packages. + * The resulting information is stored in the TUpdateCheckResponse + * variable and seralized to disk. + * + * @returns A TBackgroundUpdateResult indicating the result of the update + * check. + *) function DoRun: TRemoteUpdateCheckResult; public - constructor Create(AForce : Boolean; ACheckOnly: Boolean = False); + constructor Create(AForce: Boolean); destructor Destroy; override; function Run: TRemoteUpdateCheckResult; property ShowErrors: Boolean read FShowErrors write FShowErrors; @@ -51,10 +58,19 @@ TRemoteUpdateCheck = class procedure LogMessage(LogMessage: string); +(** + * This function checks if a week or CheckPeriod time has passed since the last + * update check. + * + * @returns True if it has been longer then CheckPeriod time since last update +*) +function ConfigCheckContinue: Boolean; + implementation uses System.WideStrUtils, + System.Win.Registry, Winapi.Windows, Winapi.WinINet, @@ -72,7 +88,7 @@ implementation { TRemoteUpdateCheck } -constructor TRemoteUpdateCheck.Create(AForce, ACheckOnly: Boolean); +constructor TRemoteUpdateCheck.Create(AForce: Boolean); begin inherited Create; @@ -80,7 +96,6 @@ constructor TRemoteUpdateCheck.Create(AForce, ACheckOnly: Boolean); FRemoteResult := wucUnknown; FForce := AForce; - FCheckOnly := ACheckOnly; KL.Log('TRemoteUpdateCheck.Create'); end; @@ -90,8 +105,9 @@ destructor TRemoteUpdateCheck.Destroy; if (FErrorMessage <> '') and FShowErrors then LogMessage(FErrorMessage); - KL.Log('TRemoteUpdateCheck.Destroy: FErrorMessage = '+FErrorMessage); - KL.Log('TRemoteUpdateCheck.Destroy: FRemoteResult = '+IntToStr(Ord(FRemoteResult))); + KL.Log('TRemoteUpdateCheck.Destroy: FErrorMessage = ' + FErrorMessage); + KL.Log('TRemoteUpdateCheck.Destroy: FRemoteResult = ' + + IntToStr(Ord(FRemoteResult))); inherited Destroy; end; @@ -99,138 +115,21 @@ destructor TRemoteUpdateCheck.Destroy; function TRemoteUpdateCheck.Run: TRemoteUpdateCheckResult; begin Result := DoRun; - - if Result in [ wucSuccess] then - begin - kmcom.Keyboards.Refresh; - kmcom.Keyboards.Apply; - kmcom.Packages.Refresh; - end; - FRemoteResult := Result; end; - -procedure TRemoteUpdateCheck.DoDownloadUpdates(SavePath: string; Params: TUpdateCheckResponse; var Result: Boolean); -var - i, downloadCount: Integer; - http: THttpUploader; - fs: TFileStream; - - function DownloadFile(const url, savepath: string): Boolean; - begin - try - http := THttpUploader.Create(nil); - try - http.Proxy.Server := GetProxySettings.Server; - http.Proxy.Port := GetProxySettings.Port; - http.Proxy.Username := GetProxySettings.Username; - http.Proxy.Password := GetProxySettings.Password; - http.Request.Agent := API_UserAgent; - - http.Request.SetURL(url); - http.Upload; - if http.Response.StatusCode = 200 then - begin - fs := TFileStream.Create(savepath, fmCreate); - try - fs.Write(http.Response.PMessageBody^, http.Response.MessageBodyLength); - finally - fs.Free; - end; - Result := True; - end - else // I2742 - // If it fails we set to false but will try the other files - Result := False; - Exit; - finally - http.Free; - end; - except - on E:EHTTPUploader do - begin - if (E.ErrorCode = 12007) or (E.ErrorCode = 12029) - then LogMessage(S_OnlineUpdate_UnableToContact) - else LogMessage(WideFormat(S_OnlineUpdate_UnableToContact_Error, [E.Message])); - Result := False; - end; - end; - end; - -begin - Result := False; - - FDownload.TotalSize := 0; - FDownload.TotalDownloads := 0; - downloadCount := 0; - - // Keyboard Packages - for i := 0 to High(Params.Packages) do - begin - Inc(FDownload.TotalDownloads); - Inc(FDownload.TotalSize, Params.Packages[i].DownloadSize); - Params.Packages[i].SavePath := SavePath + Params.Packages[i].FileName; - end; - - // Add the Keyman installer - Inc(FDownload.TotalDownloads); - Inc(FDownload.TotalSize, Params.InstallSize); - - // Keyboard Packages - FDownload.StartPosition := 0; - for i := 0 to High(Params.Packages) do - begin - if not DownloadFile(Params.Packages[i].DownloadURL, Params.Packages[i].SavePath) then // I2742 - begin - Params.Packages[i].Install := False; // Download failed but install other files - end - else - Inc(downloadCount); - FDownload.StartPosition := FDownload.StartPosition + Params.Packages[i].DownloadSize; - end; - - // Keyman Installer - if not DownloadFile(Params.InstallURL, SavePath + Params.FileName) then // I2742 - begin - // TODO: #10210record fail? and log // Download failed but user wants to install other files - end - else - begin - Inc(downloadCount) - end; - - // There needs to be at least one file successfully downloaded to return - // True that files were downloaded - if downloadCount > 0 then - Result := True; -end; - -function TRemoteUpdateCheck.DownloadUpdates(Params: TUpdateCheckResponse): Boolean; -var - DownloadBackGroundSavePath : String; - DownloadResult : Boolean; -begin - DownloadBackGroundSavePath := IncludeTrailingPathDelimiter(TKeymanPaths.KeymanUpdateCachePath); - - DoDownloadUpdates(DownloadBackGroundSavePath, Params, DownloadResult); - KL.Log('TRemoteUpdateCheck.DownloadUpdatesBackground: DownloadResult = '+IntToStr(Ord(DownloadResult))); - Result := DownloadResult; - -end; - function TRemoteUpdateCheck.DoRun: TRemoteUpdateCheckResult; var flags: DWord; i: Integer; ucr: TUpdateCheckResponse; pkg: IKeymanPackage; - downloadResult: boolean; - registry: TRegistryErrorControlled; + Registry: TRegistryErrorControlled; http: THttpUploader; + proceed: Boolean; begin - {FProxyHost := ''; - FProxyPort := 0;} + { FProxyHost := ''; + FProxyPort := 0; } { Check if user is currently online } if not InternetGetConnectedState(@flags, 0) then @@ -239,53 +138,22 @@ function TRemoteUpdateCheck.DoRun: TRemoteUpdateCheckResult; Exit; end; - { Verify that it has been at least 7 days since last update check } - try - registry := TRegistryErrorControlled.Create; // I2890 - try - if registry.OpenKeyReadOnly(SRegKey_KeymanDesktop_CU) then - begin - if registry.ValueExists(SRegValue_CheckForUpdates) and not registry.ReadBool(SRegValue_CheckForUpdates) and not FForce then - begin - Result := wucNoUpdates; - Exit; - end; - if registry.ValueExists(SRegValue_LastUpdateCheckTime) and (Now - registry.ReadDateTime(SRegValue_LastUpdateCheckTime) < 7) and not FForce then - begin - Result := wucNoUpdates; - // TODO: #10210 This exit is just to remove the time check for testing. - //Exit; - end; - - {if ValueExists(SRegValue_UpdateCheck_UseProxy) and ReadBool(SRegValue_UpdateCheck_UseProxy) then - begin - FProxyHost := ReadString(SRegValue_UpdateCheck_ProxyHost); - FProxyPort := StrToIntDef(ReadString(SRegValue_UpdateCheck_ProxyPort), 80); - end;} - end; - finally - registry.Free; - end; - except - { we will not run the check if an error occurs reading the settings } - on E:Exception do - begin - Result := wucFailure; - FErrorMessage := E.Message; - Exit; - end; + proceed := ConfigCheckContinue; + if not proceed and not FForce then + begin + Result := wucNoUpdates; + Exit; end; - Result := wucNoUpdates; - try - http := THTTPUploader.Create(nil); + http := THttpUploader.Create(nil); try http.Fields.Add('version', ansistring(CKeymanVersionInfo.Version)); http.Fields.Add('tier', ansistring(CKeymanVersionInfo.Tier)); - if FForce - then http.Fields.Add('manual', '1') - else http.Fields.Add('manual', '0'); + if FForce then + http.Fields.Add('manual', '1') + else + http.Fields.Add('manual', '0'); for i := 0 to kmcom.Packages.Count - 1 do begin @@ -294,8 +162,10 @@ function TRemoteUpdateCheck.DoRun: TRemoteUpdateCheckResult; // Due to limitations in PHP parsing of query string parameters names with // space or period, we need to split the parameters up. The legacy pattern // is still supported on the server side. Relates to #4886. - http.Fields.Add(AnsiString('packageid_'+IntToStr(i)), AnsiString(pkg.ID)); - http.Fields.Add(AnsiString('packageversion_'+IntToStr(i)), AnsiString(pkg.Version)); + http.Fields.Add(ansistring('packageid_' + IntToStr(i)), + ansistring(pkg.ID)); + http.Fields.Add(ansistring('packageversion_' + IntToStr(i)), + ansistring(pkg.Version)); pkg := nil; end; @@ -307,31 +177,14 @@ function TRemoteUpdateCheck.DoRun: TRemoteUpdateCheckResult; http.Request.HostName := API_Server; http.Request.Protocol := API_Protocol; http.Request.UrlPath := API_Path_UpdateCheck_Windows; - //OnStatus := + // OnStatus := http.Upload; if http.Response.StatusCode = 200 then begin if ucr.Parse(http.Response.MessageBodyAsString, 'bundle', CKeymanVersionInfo.Version) then begin - //ResponseToParams(ucr); - - if FCheckOnly then - begin - TUpdateCheckStorage.SaveUpdateCacheData(ucr); - Result := FRemoteResult; - end - // TODO: ##10210 - // Integerate into state machine. in the download state - // the process can call LoadUpdateCacheData if needed to get the - // response result. - else if (Length(ucr.Packages) > 0) or (ucr.InstallURL <> '') then - begin - downloadResult := DownloadUpdates(ucr); - if DownloadResult then - begin - Result := wucSuccess; - end; - end; + TUpdateCheckStorage.SaveUpdateCacheData(ucr); + Result := wucSuccess; end else begin @@ -345,34 +198,71 @@ function TRemoteUpdateCheck.DoRun: TRemoteUpdateCheckResult; http.Free; end; except - on E:EHTTPUploader do + on E: EHTTPUploader do begin - if (E.ErrorCode = 12007) or (E.ErrorCode = 12029) - then FErrorMessage := S_OnlineUpdate_UnableToContact - else FErrorMessage := WideFormat(S_OnlineUpdate_UnableToContact_Error, [E.Message]); + if (E.ErrorCode = 12007) or (E.ErrorCode = 12029) then + FErrorMessage := S_OnlineUpdate_UnableToContact + else + FErrorMessage := WideFormat(S_OnlineUpdate_UnableToContact_Error, + [E.Message]); Result := wucFailure; end; - on E:Exception do + on E: Exception do begin FErrorMessage := E.Message; Result := wucFailure; end; end; - registry := TRegistryErrorControlled.Create; // I2890 + Registry := TRegistryErrorControlled.Create; // I2890 try - if registry.OpenKey(SRegKey_KeymanDesktop_CU, True) then - registry.WriteDateTime(SRegValue_LastUpdateCheckTime, Now); + if Registry.OpenKey(SRegKey_KeymanDesktop_CU, True) then + Registry.WriteDateTime(SRegValue_LastUpdateCheckTime, Now); finally - registry.Free; + Registry.Free; end; end; - // temp wrapper for converting showmessage to logs don't know where - // if nt using klog - procedure LogMessage(LogMessage: string); - begin - KL.Log(LogMessage); - end; +// temp wrapper for converting showmessage to logs don't know where +// if nt using klog +procedure LogMessage(LogMessage: string); +begin + KL.Log(LogMessage); +end; + +function ConfigCheckContinue: Boolean; +var + Registry: TRegistryErrorControlled; +begin + { Verify that it has been at least CheckPeriod days since last update check } + Result := False; + try + Registry := TRegistryErrorControlled.Create; // I2890 + try + if Registry.OpenKeyReadOnly(SRegKey_KeymanDesktop_CU) then + begin + if Registry.ValueExists(SRegValue_CheckForUpdates) and + not Registry.ReadBool(SRegValue_CheckForUpdates) then + begin + Exit; + end; + if Registry.ValueExists(SRegValue_LastUpdateCheckTime) and + (Now - Registry.ReadDateTime(SRegValue_LastUpdateCheckTime) > + CheckPeriod) then + begin + Result := True; + end; + end; + finally + Registry.Free; + end; + except + on E: ERegistryException do + begin + Result := False; + LogMessage(E.Message); + end; + end; +end; end. diff --git a/windows/src/desktop/kmshell/main/Keyman.System.UpdateStateMachine.pas b/windows/src/desktop/kmshell/main/Keyman.System.UpdateStateMachine.pas new file mode 100644 index 00000000000..a3c262d2bc1 --- /dev/null +++ b/windows/src/desktop/kmshell/main/Keyman.System.UpdateStateMachine.pas @@ -0,0 +1,1085 @@ +(* + * Keyman is copyright (C) SIL Global. MIT License. + * + * Notes: For the state diagram in mermaid ../BackgroundUpdateStateDiagram.md + *) +unit Keyman.System.UpdateStateMachine; + +interface + +uses + System.SysUtils, + System.UITypes, + System.IOUtils, + System.Types, + System.TypInfo, + + httpuploader, + KeymanPaths, + Keyman.Configuration.UI.UfrmStartInstall, + Keyman.Configuration.UI.UfrmStartInstallNow, + Keyman.System.ExecutionHistory, + Keyman.System.UpdateCheckResponse, + utilkmshell; + +type + EUpdateStateMachine = class(Exception); + + TUpdateState = (usIdle, usUpdateAvailable, usDownloading, usWaitingRestart, + usInstalling, usRetry, usPostInstall); + + // Forward declaration + TUpdateStateMachine = class; + + { State Classes Update } + + TStateClass = class of TState; + + TState = class abstract + private + bucStateContext: TUpdateStateMachine; + procedure ChangeState(newState: TStateClass); + + public + constructor Create(Context: TUpdateStateMachine); + procedure Enter; virtual; abstract; + procedure Exit; virtual; abstract; + procedure HandleCheck; virtual; abstract; + function HandleKmShell: Integer; virtual; abstract; + procedure HandleDownload; virtual; abstract; + procedure HandleAbort; virtual; abstract; + procedure HandleInstallNow; virtual; abstract; + end; + + { This class also controls the state flow see + ../BackgroundUpdateStateDiagram.md } + TUpdateStateMachine = class + private + FForce: Boolean; + FAutomaticUpdate: Boolean; + FErrorMessage: string; + FShowErrors: Boolean; + + CurrentState: TState; + // State object for performance (could lazy create?) + + FStateInstance: array [TUpdateState] of TState; + + function GetState: TStateClass; + procedure SetState(const Value: TStateClass); + procedure SetStateOnly(const enumState: TUpdateState); + function ConvertStateToEnum(const StateClass: TStateClass): TUpdateState; + function IsCurrentStateAssigned: Boolean; + + function SetRegistryState(Update: TUpdateState): Boolean; + function GetAutomaticUpdates: Boolean; + function SetApplyNow(Value: Boolean): Boolean; + function GetApplyNow: Boolean; + + protected + property State: TStateClass read GetState write SetState; + + public + constructor Create(AForce: Boolean); + destructor Destroy; override; + + procedure HandleCheck; + function HandleKmShell: Integer; + procedure HandleDownload; + procedure HandleAbort; + procedure HandleInstallNow; + function CurrentStateName: string; + + property ShowErrors: Boolean read FShowErrors write FShowErrors; + function CheckRegistryState: TUpdateState; + + end; + +implementation + +uses + + System.Win.Registry, + Winapi.Windows, + Winapi.WinINet, + ErrorControlledRegistry, + + GlobalProxySettings, + Keyman.System.DownloadUpdate, + Keyman.System.RemoteUpdateCheck, + KLog, + RegistryKeys, + utilexecute; + +const + SPackageUpgradeFilename = 'upgrade_packages.inf'; + kmShellContinue = 0; + kmShellExit = 1; + + { State Class Memebers } + +constructor TState.Create(Context: TUpdateStateMachine); +begin + inherited Create; + bucStateContext := Context; +end; + +procedure TState.ChangeState(newState: TStateClass); +begin + bucStateContext.State := newState; +end; + +type + +// Derived classes for each state + IdleState = class(TState) + public + procedure Enter; override; + procedure Exit; override; + procedure HandleCheck; override; + function HandleKmShell: Integer; override; + procedure HandleDownload; override; + procedure HandleAbort; override; + procedure HandleInstallNow; override; + end; + + UpdateAvailableState = class(TState) + private + procedure StartDownloadProcess; + public + procedure Enter; override; + procedure Exit; override; + procedure HandleCheck; override; + function HandleKmShell: Integer; override; + procedure HandleDownload; override; + procedure HandleAbort; override; + procedure HandleInstallNow; override; + end; + + DownloadingState = class(TState) + private + + function DownloadUpdatesBackground: Boolean; + procedure Enter; override; + procedure Exit; override; + procedure HandleCheck; override; + function HandleKmShell: Integer; override; + procedure HandleDownload; override; + procedure HandleAbort; override; + procedure HandleInstallNow; override; + end; + + WaitingRestartState = class(TState) + public + procedure Enter; override; + procedure Exit; override; + procedure HandleCheck; override; + function HandleKmShell: Integer; override; + procedure HandleDownload; override; + procedure HandleAbort; override; + procedure HandleInstallNow; override; + end; + + InstallingState = class(TState) + private + + (** + * Installs the Keyman setup file using separate shell. + * + * @params SavePath The path to the downloaded files. + * + * @returns True if the installation is successful, False otherwise. + *) + + function DoInstallKeyman(SavePath: string): Boolean; overload; + + public + procedure Enter; override; + procedure Exit; override; + procedure HandleCheck; override; + function HandleKmShell: Integer; override; + procedure HandleDownload; override; + procedure HandleAbort; override; + procedure HandleInstallNow; override; + end; + + RetryState = class(TState) + public + procedure Enter; override; + procedure Exit; override; + procedure HandleCheck; override; + function HandleKmShell: Integer; override; + procedure HandleDownload; override; + procedure HandleAbort; override; + procedure HandleInstallNow; override; + end; + + PostInstallState = class(TState) + private + procedure HandleMSIInstallComplete; + public + procedure Enter; override; + procedure Exit; override; + procedure HandleCheck; override; + function HandleKmShell: Integer; override; + procedure HandleDownload; override; + procedure HandleAbort; override; + procedure HandleInstallNow; override; + end; + + { TUpdateStateMachine } + +constructor TUpdateStateMachine.Create(AForce: Boolean); +begin + inherited Create; + FShowErrors := True; + + FForce := AForce; + FAutomaticUpdate := GetAutomaticUpdates; + + FStateInstance[usIdle] := IdleState.Create(Self); + FStateInstance[usUpdateAvailable] := UpdateAvailableState.Create(Self); + FStateInstance[usDownloading] := DownloadingState.Create(Self); + FStateInstance[usWaitingRestart] := WaitingRestartState.Create(Self); + FStateInstance[usInstalling] := InstallingState.Create(Self); + FStateInstance[usRetry] := RetryState.Create(Self); + FStateInstance[usPostInstall] := PostInstallState.Create(Self); + + // Check the Registry setting. + SetStateOnly(CheckRegistryState); +end; + +destructor TUpdateStateMachine.Destroy; +var + lpState: TUpdateState; +begin + if (FErrorMessage <> '') and FShowErrors then + KL.Log(FErrorMessage); // TODO: #10210 Log to Sentry + + for lpState := Low(TUpdateState) to High(TUpdateState) do + begin + FreeAndNil(FStateInstance[lpState]); + end; + + // TODO: #10210 remove debugging comments + // KL.Log('TUpdateStateMachine.Destroy: FErrorMessage = '+FErrorMessage); + // KL.Log('TUpdateStateMachine.Destroy: FParams.Result = '+IntToStr(Ord(FParams.Result))); + + inherited Destroy; +end; + +function TUpdateStateMachine.SetRegistryState(Update: TUpdateState): Boolean; +var + UpdateStr: string; + Registry: TRegistryErrorControlled; +begin + Result := False; + Registry := TRegistryErrorControlled.Create; + + try + Registry.RootKey := HKEY_CURRENT_USER; + + if not Registry.OpenKey(SRegKey_KeymanEngine_CU, True) then + begin + // TODO: #10210 Log to Sentry + KL.Log('Failed to open registry key: ' + SRegKey_KeymanEngine_CU); + Exit; + end; + + try + UpdateStr := GetEnumName(TypeInfo(TUpdateState), Ord(Update)); + Registry.WriteString(SRegValue_Update_State, UpdateStr); + Result := True; + except + on E: ERegistryException do + begin + // TODO: #10210 Log to Sentry + KL.Log('Failed to write to registry: ' + E.Message); + end; + end; + + finally + Registry.Free; + end; + +end; + +function TUpdateStateMachine.CheckRegistryState: TUpdateState; +var + UpdateState: TUpdateState; + Registry: TRegistryErrorControlled; + StateValue: string; + EnumValue: Integer; +begin + // Default to Idle state if any issues occur + UpdateState := usIdle; + Registry := TRegistryErrorControlled.Create; + + try + Registry.RootKey := HKEY_CURRENT_USER; + if Registry.OpenKeyReadOnly(SRegKey_KeymanEngine_CU) and + Registry.ValueExists(SRegValue_Update_State) then + begin + try + StateValue := Registry.ReadString(SRegValue_Update_State); + EnumValue := GetEnumValue(TypeInfo(TUpdateState), StateValue); + + // Bounds Check EnumValue against TUpdateState + if (EnumValue >= Ord(Low(TUpdateState))) and (EnumValue <= Ord(High(TUpdateState))) then + UpdateState := TUpdateState(EnumValue) + else + UpdateState := usIdle; // Default if out of bounds + except + on E: ERegistryException do + begin + // TODO: #10210 Log to Sentry + KL.Log('Failed to write to registry: ' + E.Message); + UpdateState := usIdle; + end; + end; + end; + finally + Registry.Free; + end; + + Result := UpdateState; +end; + +function TUpdateStateMachine.GetAutomaticUpdates: Boolean; // I2329 +var + Registry: TRegistryErrorControlled; + +begin + // check the registry value + Registry := TRegistryErrorControlled.Create; // I2890 + try + Registry.RootKey := HKEY_CURRENT_USER; + try + Result := not Registry.OpenKeyReadOnly(SRegKey_KeymanEngine_CU) or + not Registry.ValueExists(SRegValue_AutomaticUpdates) or + Registry.ReadBool(SRegValue_AutomaticUpdates); + except + on E: ERegistryException do + begin + // TODO: #10210 Log to Sentry + KL.Log('Failed to read registery: ' + E.Message); + Result := False; + end; + end; + finally + Registry.Free; + end; +end; + +function TUpdateStateMachine.SetApplyNow(Value: Boolean): Boolean; +var + Registry: TRegistryErrorControlled; +begin + Result := False; + Registry := TRegistryErrorControlled.Create; + + try + Registry.RootKey := HKEY_CURRENT_USER; + if not Registry.OpenKey(SRegKey_KeymanEngine_CU, True) then + begin + Exit; + end; + try + Registry.WriteBool(SRegValue_ApplyNow, Value); + Result := True; + except + on E: ERegistryException do + begin + // TODO: #10210 Log to Sentry 'Failed to write '+SRegValue_ApplyNow+' to registry: ' + E.Message + KL.Log('Failed to write to registry: ' + E.Message); + end; + end; + finally + Registry.Free; + end; +end; + +function TUpdateStateMachine.GetApplyNow: Boolean; +var + Registry: TRegistryErrorControlled; +begin + // check the registry value + Registry := TRegistryErrorControlled.Create; + try + Registry.RootKey := HKEY_CURRENT_USER; + try + Result := Registry.OpenKeyReadOnly(SRegKey_KeymanEngine_CU) and + Registry.ValueExists(SRegValue_ApplyNow) and + Registry.ReadBool(SRegValue_ApplyNow); + except + on E: ERegistryException do + begin + KL.Log('Failed to read registry: ' + E.Message); + Result := False; + end; + end; + finally + Registry.Free; + end; +end; + +function TUpdateStateMachine.GetState: TStateClass; +begin + if Assigned(CurrentState) then + Result := TStateClass(CurrentState.ClassType) + else + begin + // TODO: #10210 Log to Sentry + KL.Log('Error CurrentState was uninitiallised: ' ); + Result := nil; + end; +end; + +procedure TUpdateStateMachine.SetState(const Value: TStateClass); +begin + if Assigned(CurrentState) then + begin + CurrentState.Exit; + end; + + SetStateOnly(ConvertStateToEnum(Value)); + + if Assigned(CurrentState) then + begin + CurrentState.Enter; + end + else + begin + // TODO: #10210 Error log for Unable to set state for Value + end; + +end; + +procedure TUpdateStateMachine.SetStateOnly(const enumState: TUpdateState); +begin + CurrentState := FStateInstance[enumState]; +end; + +function TUpdateStateMachine.ConvertStateToEnum(const StateClass: TStateClass) : TUpdateState; +begin + if StateClass = IdleState then + Result := usIdle + else if StateClass = UpdateAvailableState then + Result := usUpdateAvailable + else if StateClass = DownloadingState then + Result := usDownloading + else if StateClass = WaitingRestartState then + Result := usWaitingRestart + else if StateClass = InstallingState then + Result := usInstalling + else if StateClass = RetryState then + Result := usRetry + else if StateClass = PostInstallState then + Result := usPostInstall + else + begin + // TODO: #10210 Log to Sentry + Result := usIdle; + KL.Log('Unknown StateClass'); // TODO-WINDOWS-UPDATES + end; +end; + +function TUpdateStateMachine.IsCurrentStateAssigned: Boolean; +begin + if Assigned(CurrentState) then + Result := True + else + begin + // TODO: #10210 Log to Sentry + KL.Log('Unexpected Error: Current state is not assigned.'); + Result := False; + end; +end; + +procedure TUpdateStateMachine.HandleCheck; +begin + if not IsCurrentStateAssigned then + Exit; + CurrentState.HandleCheck; +end; + +function TUpdateStateMachine.HandleKmShell: Integer; +begin + if not IsCurrentStateAssigned then + Exit(kmShellContinue); + Result := CurrentState.HandleKmShell; +end; + +procedure TUpdateStateMachine.HandleDownload; +begin + if not IsCurrentStateAssigned then + Exit; + CurrentState.HandleDownload; +end; + +procedure TUpdateStateMachine.HandleAbort; +begin + if not IsCurrentStateAssigned then + Exit; + CurrentState.HandleAbort; +end; + +procedure TUpdateStateMachine.HandleInstallNow; +begin + if not IsCurrentStateAssigned then + Exit; + CurrentState.HandleInstallNow; +end; + +function TUpdateStateMachine.CurrentStateName: string; +begin + if not IsCurrentStateAssigned then + Exit('Undefined'); + Result := CurrentState.ClassName; +end; + +{ IdleState } + +procedure IdleState.Enter; +begin + // Enter UpdateAvailableState + bucStateContext.SetRegistryState(usIdle); +end; + +procedure IdleState.Exit; +begin + +end; + +procedure IdleState.HandleCheck; +var + CheckForUpdates: TRemoteUpdateCheck; + Result : TRemoteUpdateCheckResult; +begin + + { ##### For Testing only just advancing to downloading #### } + //ChangeState(UpdateAvailableState); + // will keep here as there are more PR's #12621 + { #### End of Testing ### }; + + { // // TODO-WINDOWS-UPDATES Check how long a check takes then determine + if it needs to be broken into a seperate state of WaitngCheck RESP } + { if Response not OK stay in the idle state and return } + + + // Handle_check event force check + CheckForUpdates := TRemoteUpdateCheck.Create(True); + try + Result:= CheckForUpdates.Run; + finally + CheckForUpdates.Free; + end; + + { Response OK and Update is available } + if Result = wucSuccess then + begin + ChangeState(UpdateAvailableState); + end; + // else staty in idle state +end; + +function IdleState.HandleKmShell; +var + CheckForUpdates: TRemoteUpdateCheck; + UpdateCheckResult: TRemoteUpdateCheckResult; +begin + // Remote manages the last check time therfore + // we will allow it to return early if it hasn't reached + // the configured time between checks. + CheckForUpdates := TRemoteUpdateCheck.Create(False); + try + UpdateCheckResult := CheckForUpdates.Run; + finally + CheckForUpdates.Free; + end; + { Response OK and Update is available } + if UpdateCheckResult = wucSuccess then + begin + ChangeState(UpdateAvailableState); + end; + Result := kmShellContinue; +end; + +procedure IdleState.HandleDownload; +begin + // Do Nothing +end; + +procedure IdleState.HandleAbort; +begin + +end; + +procedure IdleState.HandleInstallNow; +begin + bucStateContext.CurrentState.HandleCheck; + // TODO: How do we notify the command line no update available +end; + +{ UpdateAvailableState } + +procedure UpdateAvailableState.StartDownloadProcess; +var + FResult: Boolean; + RootPath: string; +begin + // call seperate process + RootPath := ExtractFilePath(ParamStr(0)); + FResult := TUtilExecute.ShellCurrentUser(0, ParamStr(0), IncludeTrailingPathDelimiter(RootPath), '-bd'); + if not FResult then + // TODO: #10210 Log to Sentry + KL.Log('TrmfMain: Executing KMshell for download updated Failed'); +end; + +procedure UpdateAvailableState.Enter; +begin + // Enter UpdateAvailableState + bucStateContext.SetRegistryState(usUpdateAvailable); + if bucStateContext.FAutomaticUpdate then + begin + StartDownloadProcess; + end; +end; + +procedure UpdateAvailableState.Exit; +begin + // Exit UpdateAvailableState +end; + +procedure UpdateAvailableState.HandleCheck; +begin + +end; + +function UpdateAvailableState.HandleKmShell; +begin + if bucStateContext.FAutomaticUpdate then + begin + // we will use a new kmshell process to enable + // the download as background process. + StartDownloadProcess; + end; + Result := kmShellContinue; +end; + +procedure UpdateAvailableState.HandleDownload; +begin + ChangeState(DownloadingState); +end; + +procedure UpdateAvailableState.HandleAbort; +begin + +end; + +procedure UpdateAvailableState.HandleInstallNow; +var + frmStartInstallNow: TfrmStartInstallNow; + InstallNow: Boolean; +begin + + InstallNow := True; + if HasKeymanRun then + begin + // TODO: UI and non-UI units should be split + // if the unit launches UI then it should be a .UI. unit + // https://github.com/keymanapp/keyman/pull/12375/files#r1751041747 + frmStartInstallNow := TfrmStartInstallNow.Create(nil); + try + if frmStartInstallNow.ShowModal = mrOk then + InstallNow := True + else + InstallNow := False; + finally + frmStartInstallNow.Free; + end; + end; + // If user decides NOT to install now stay in UpdateAvailable State + if InstallNow = True then + begin + bucStateContext.SetApplyNow(True); + ChangeState(InstallingState) + end; + +end; + +{ DownloadingState } + +procedure DownloadingState.Enter; +var + DownloadResult: Boolean; +begin + // Enter DownloadingState + bucStateContext.SetRegistryState(usDownloading); + { ## for testing log that we would download } + KL.Log('DownloadingState.HandleKmshell test code continue'); + DownloadResult := True; + { End testing } + DownloadResult := DownloadUpdatesBackground; + // TODO check if keyman is running then send to Waiting Restart + if DownloadResult then + begin + if HasKeymanRun then + begin + if bucStateContext.GetApplyNow then + begin + bucStateContext.SetApplyNow(False); + ChangeState(InstallingState); + end + else + ChangeState(WaitingRestartState); + end + else + begin + bucStateContext.SetApplyNow(False); + ChangeState(InstallingState); + end; + end + else + begin + ChangeState(RetryState); + end; + +end; + +procedure DownloadingState.Exit; +begin + // Exit DownloadingState +end; + +procedure DownloadingState.HandleCheck; +begin + +end; + +function DownloadingState.HandleKmShell; +begin + // Downloading state, in other process, so continue + Result := kmShellContinue; +end; + +procedure DownloadingState.HandleDownload; +begin + // Enter Already Downloading +end; + +procedure DownloadingState.HandleAbort; +begin +end; + +procedure DownloadingState.HandleInstallNow; +begin + // Already downloading set the registry apply now + bucStateContext.SetApplyNow(True); +end; + +function DownloadingState.DownloadUpdatesBackground: Boolean; +var + DownloadResult: Boolean; + DownloadUpdate: TDownloadUpdate; +begin + DownloadUpdate := TDownloadUpdate.Create; + try + DownloadResult := DownloadUpdate.DownloadUpdates; + Result := DownloadResult; + finally + DownloadUpdate.Free; + end; +end; + +{ WaitingRestartState } + +procedure WaitingRestartState.Enter; +begin + // Enter WaitingRestartState + bucStateContext.SetRegistryState(usWaitingRestart); +end; + +procedure WaitingRestartState.Exit; +begin + // Exit DownloadingState +end; + +procedure WaitingRestartState.HandleCheck; +begin + +end; + +function WaitingRestartState.HandleKmShell; +var + SavedPath: String; + Filenames: TStringDynArray; + frmStartInstall: TfrmStartInstall; +begin + // Still can't go if keyman has run + if HasKeymanRun then + begin + Result := kmShellContinue; + // Exit; // Exit is not wokring for some reason. + // this else is only here because the exit is not working. + end + else + begin + // Check downloaded cache if available then + SavedPath := IncludeTrailingPathDelimiter + (TKeymanPaths.KeymanUpdateCachePath); + GetFileNamesInDirectory(SavedPath, Filenames); + if Length(Filenames) = 0 then + begin + // Return to Idle state and check for Updates state + ChangeState(IdleState); + bucStateContext.CurrentState.HandleCheck; // TODO no event here + Result := kmShellExit; + // Exit; // again exit was not working + end + else + begin + frmStartInstall := TfrmStartInstall.Create(nil); + try + if frmStartInstall.ShowModal = mrOk then + begin + ChangeState(InstallingState); + Result := kmShellExit; + end + else + Result := kmShellContinue; + finally + frmStartInstall.Free; + end; + end; + end; +end; + +procedure WaitingRestartState.HandleDownload; +begin + +end; + +procedure WaitingRestartState.HandleAbort; +begin + +end; + +procedure WaitingRestartState.HandleInstallNow; +// If user decides not to install now stay in WaitingRestart State +var + frmStartInstallNow: TfrmStartInstallNow; + InstallNow: Boolean; +begin + InstallNow := True; + if HasKeymanRun then + begin + frmStartInstallNow := TfrmStartInstallNow.Create(nil); + try + if frmStartInstallNow.ShowModal = mrOk then + InstallNow := True + else + InstallNow := False; + finally + frmStartInstallNow.Free; + end; + end; + if InstallNow = True then + begin + bucStateContext.SetApplyNow(True); + ChangeState(InstallingState); + end; +end; + +function InstallingState.DoInstallKeyman(SavePath: string): Boolean; +var + s: string; + FResult: Boolean; +begin + s := LowerCase(ExtractFileExt(SavePath)); + if s = '.msi' then + FResult := TUtilExecute.Shell(0, 'msiexec.exe', '', '/qb /i "' + SavePath + + '" AUTOLAUNCHPRODUCT=1') // I3349 + else if s = '.exe' then + begin + // switch -au for auto update in silent mode. + // We will need to add the pop up that says install update now yes/no + // This will run the setup executable which will ask for elevated permissions + FResult := TUtilExecute.Shell(0, SavePath, '', '-au') // I3349 + end + else + FResult := False; + + if not FResult then + begin + // TODO: #10210 Log to Sentry + KL.Log('TUpdateStateMachine.InstallingState.DoInstall: Result = ' + + IntToStr(Ord(FResult))); + // Log message ShowMessage(SysErrorMessage(GetLastError)); + end; + + Result := FResult; +end; + +procedure InstallingState.Enter; +var + SavePath: String; + fileExt: String; + fileName: String; + Filenames: TStringDynArray; +begin + + bucStateContext.SetRegistryState(usInstalling); + SavePath := IncludeTrailingPathDelimiter(TKeymanPaths.KeymanUpdateCachePath); + + GetFileNamesInDirectory(SavePath, Filenames); + // for now we only want the exe although excute install can + // handle msi + for fileName in Filenames do + begin + fileExt := LowerCase(ExtractFileExt(fileName)); + if fileExt = '.exe' then + break; + end; + + if DoInstallKeyman(SavePath + ExtractFileName(fileName)) then + begin + KL.Log('TUpdateStateMachine.InstallingState.Enter: DoInstall OK'); + end + else + begin + // TODO: #10210 clean failed download + // TODO: #10210 Do we do a retry on install? probably not + KL.Log('TUpdateStateMachine.InstallingState.Enter: DoInstall fail'); + ChangeState(IdleState); + end +end; + +procedure InstallingState.Exit; +begin + +end; + +procedure InstallingState.HandleCheck; +begin + +end; + +function InstallingState.HandleKmShell; +begin + // Result = exit straight away as we are installing (MSI installer) + // need to just do a no-op keyman will it maybe using kmshell to install + // packages. + Result := kmShellContinue; +end; + +procedure InstallingState.HandleDownload; +begin + +end; + +procedure InstallingState.HandleAbort; +begin + ChangeState(IdleState); +end; + +procedure InstallingState.HandleInstallNow; +begin + // Do Nothing. Need the UI to let user know installation in progress OR +end; + +{ RetryState } + +procedure RetryState.Enter; +begin + bucStateContext.SetRegistryState(usRetry); +end; + +procedure RetryState.Exit; +begin + +end; + +procedure RetryState.HandleCheck; +begin + +end; + +function RetryState.HandleKmShell; +begin + // #TODO: #10210 Implement retry + Result := kmShellContinue +end; + +procedure RetryState.HandleDownload; +begin + +end; + +procedure RetryState.HandleAbort; +begin + +end; + +procedure RetryState.HandleInstallNow; +begin + // TODO: #10038 handle retry counts + ChangeState(InstallingState); +end; + +{ PostInstallState } + +procedure PostInstallState.Enter; +begin + // Enter downloading state + bucStateContext.SetRegistryState(usPostInstall); +end; + +procedure PostInstallState.Exit; +begin + +end; + +procedure PostInstallState.HandleCheck; +begin + // Handle Check +end; + +function PostInstallState.HandleKmShell; +begin + HandleMSIInstallComplete; + Result := kmShellContinue; +end; + +procedure PostInstallState.HandleDownload; +begin + // Do Nothing +end; + +procedure PostInstallState.HandleMSIInstallComplete; +var + SavePath: string; + fileName: String; + Filenames: TStringDynArray; +begin + SavePath := IncludeTrailingPathDelimiter(TKeymanPaths.KeymanUpdateCachePath); + + GetFileNamesInDirectory(SavePath, Filenames); + for fileName in Filenames do + begin + System.SysUtils.DeleteFile(fileName); + end; + ChangeState(IdleState); +end; + +procedure PostInstallState.HandleAbort; +begin + // Handle Abort +end; + +procedure PostInstallState.HandleInstallNow; +begin + // Do nothing as files will be cleaned via HandleKmShell +end; + +end. diff --git a/windows/src/desktop/kmshell/main/UImportOlderVersionSettings.pas b/windows/src/desktop/kmshell/main/UImportOlderVersionSettings.pas index 007d854797b..e4cdff54bb3 100644 --- a/windows/src/desktop/kmshell/main/UImportOlderVersionSettings.pas +++ b/windows/src/desktop/kmshell/main/UImportOlderVersionSettings.pas @@ -1,18 +1,18 @@ (* Name: UImportOlderVersionSettings Copyright: Copyright (C) 2003-2017 SIL International. - Documentation: - Description: + Documentation: + Description: Create Date: 22 Feb 2011 Modified Date: 3 Jun 2014 Authors: mcdurdin - Related Files: - Dependencies: + Related Files: + Dependencies: - Bugs: - Todo: - Notes: + Bugs: + Todo: + Notes: History: 22 Feb 2011 - mcdurdin - I2651 - Install does not set desired default options 22 Feb 2011 - mcdurdin - I2753 - Firstrun crashes because start with windows and auto update check options are set in Engine instead of Desktop 03 May 2011 - mcdurdin - I2890 - Record diagnostic data when encountering registry errors @@ -24,7 +24,7 @@ interface -function FirstRunInstallDefaults(DoDefaults,DoStartWithWindows,DoCheckForUpdates: Boolean; FDisablePackages, FDefaultUILanguage: string; DoAutomaticallyReportUsage: Boolean): Boolean; // I2753 +function FirstRunInstallDefaults(DoDefaults,DoStartWithWindows,DoCheckForUpdates,DoAutomaticUpdates: Boolean; FDisablePackages, FDefaultUILanguage: string; DoAutomaticallyReportUsage: Boolean): Boolean; // I2753 implementation @@ -43,7 +43,7 @@ implementation RegistryKeys, UImportOlderKeyboardUtils; -function FirstRunInstallDefaults(DoDefaults,DoStartWithWindows,DoCheckForUpdates: Boolean; FDisablePackages, FDefaultUILanguage: string; DoAutomaticallyReportUsage: Boolean): Boolean; // I2753 +function FirstRunInstallDefaults(DoDefaults,DoStartWithWindows,DoCheckForUpdates,DoAutomaticUpdates: Boolean; FDisablePackages, FDefaultUILanguage: string; DoAutomaticallyReportUsage: Boolean): Boolean; // I2753 var n, I: Integer; v: Integer; @@ -136,6 +136,7 @@ function FirstRunInstallDefaults(DoDefaults,DoStartWithWindows,DoCheckForUpdates if DoStartWithWindows then kmcom.Options['koStartWithWindows'].Value := True; // I2753 if DoCheckForUpdates then kmcom.Options['koCheckForUpdates'].Value := True; // I2753 + if DoAutomaticUpdates then kmcom.Options['koAutomaticUpdate'].Value := True; if DoAutomaticallyReportUsage then kmcom.Options['koAutomaticallyReportUsage'].Value := True; diff --git a/windows/src/desktop/kmshell/main/UfrmMain.pas b/windows/src/desktop/kmshell/main/UfrmMain.pas index a779fdcdd2b..cb206e0291b 100644 --- a/windows/src/desktop/kmshell/main/UfrmMain.pas +++ b/windows/src/desktop/kmshell/main/UfrmMain.pas @@ -149,6 +149,7 @@ TfrmMain = class(TfrmWebContainer) procedure DoApply; procedure DoRefresh; procedure Update_CheckNow; + procedure Update_ApplyNow; protected procedure FireCommand(const command: WideString; params: TStringList); override; @@ -185,6 +186,7 @@ implementation LanguagesXMLRenderer, MessageIdentifierConsts, MessageIdentifiers, + Keyman.System.RemoteUpdateCheck, OnlineUpdateCheck, OptionsXMLRenderer, Keyman.Configuration.System.UmodWebHttpServer, @@ -209,7 +211,8 @@ implementation utilkmshell, utilhttp, utiluac, - utilxml; + utilxml, + KeymanPaths; type PHKL = ^HKL; @@ -349,6 +352,7 @@ procedure TfrmMain.FireCommand(const command: WideString; params: TStringList); else if command = 'support_proxyconfig' then Support_ProxyConfig else if command = 'update_checknow' then Update_CheckNow + else if command = 'update_applynow' then Update_ApplyNow else if command = 'contact_support' then Support_ContactSupport(params) // I4390 @@ -793,7 +797,7 @@ procedure TfrmMain.Support_ProxyConfig; Free; end; end; - +// TODO-WINDOWS-UPDATES: #10210 Remove Update procedure TfrmMain.Support_UpdateCheck; begin with TOnlineUpdateCheck.Create(Self, True, False) do @@ -821,16 +825,28 @@ procedure TfrmMain.Support_UpdateCheck; end; procedure TfrmMain.Update_CheckNow; +var UpdateCheck : TRemoteUpdateCheck; begin - with TOnlineUpdateCheck.Create(Self, True, True, True) do + UpdateCheck := TRemoteUpdateCheck.Create(True); try - Run; + UpdateCheck.Run; finally - Free; + UpdateCheck.Free; end; DoRefresh; end; +procedure TfrmMain.Update_ApplyNow; +var + ShellPath, s: string; + FResult: Boolean; +begin + ShellPath := TKeymanPaths.KeymanDesktopInstallPath(TKeymanPaths.S_KMShell); + FResult := TUtilExecute.Shell(0, ShellPath, '', '-an'); + if not FResult then + KL.Log('TrmfMain: Executing Update_ApplyNow Failed'); // TODO: Make error log +end; + procedure TfrmMain.TntFormCloseQuery(Sender: TObject; var CanClose: Boolean); begin inherited; diff --git a/windows/src/desktop/kmshell/main/initprog.pas b/windows/src/desktop/kmshell/main/initprog.pas index 4076ab21015..b5a84792ce6 100644 --- a/windows/src/desktop/kmshell/main/initprog.pas +++ b/windows/src/desktop/kmshell/main/initprog.pas @@ -83,6 +83,8 @@ procedure Main(Owner: TComponent = nil); fmUpgradeKeyboards, fmOnlineUpdateCheck,// I2548 fmOnlineUpdateAdmin, fmTextEditor, fmBackgroundUpdateCheck, + fmBackgroundDownload, + fmApplyInstallNow, fmFirstRun, // I2562 fmKeyboardWelcome, // I2569 fmKeyboardPrint, // I2329 @@ -143,6 +145,7 @@ implementation UpgradeMnemonicLayout, utilfocusappwnd, utilkmshell, + Keyman.System.UpdateStateMachine, KeyboardTIPCheck, @@ -250,8 +253,12 @@ function Init(var FMode: TKMShellMode; KeyboardFileNames: TStrings; var FSilent, else if s = '-?' then FMode := fmHelpKMShell else if s = '-h' then FMode := fmHelp else if s = '-t' then FMode := fmTextEditor + //TODO-WINDOWS-UPDATES: will remove -ouc not used + // -buc uses the Statemachine can be used for external scripts to force a check else if s = '-ouc' then FMode := fmOnlineUpdateCheck else if s = '-buc' then FMode := fmBackgroundUpdateCheck + else if s = '-bd' then FMode := fmBackgroundDownload + else if s = '-an' then FMode := fmApplyInstallNow else if s = '-basekeyboard' then FMode := fmBaseKeyboard // I4169 else if s = '-nowelcome' then FNoWelcome := True else if s = '-kw' then FMode := fmKeyboardWelcome // I2569 @@ -384,7 +391,7 @@ procedure RunKMCOM(FMode: TKMShellMode; KeyboardFileNames: TStrings; FSilent, FF kdl: IKeymanDefaultLanguage; FIcon: string; FMutex: TKeymanMutex; // I2720 - RemoteUpdateCheck: TRemoteUpdateCheck; + BUpdateSM : TUpdateStateMachine; function FirstKeyboardFileName: WideString; begin if KeyboardFileNames.Count = 0 @@ -431,17 +438,31 @@ procedure RunKMCOM(FMode: TKMShellMode; KeyboardFileNames: TStrings; FSilent, FF ShowMessage(MsgFromId(SKOSNotSupported)); Exit; end; - // TODO: #10038 Will add this as part of the background update state machine - // for now just verifing the download happens via -buc switch. - RemoteUpdateCheck := TRemoteUpdateCheck.Create(False, False); + + BUpdateSM := TUpdateStateMachine.Create(False); try if (FMode = fmBackgroundUpdateCheck) then begin - RemoteUpdateCheck.Run; + BUpdateSM.HandleCheck; + Exit; + end + else if (FMode = fmBackgroundDownload) then + begin + BUpdateSM.HandleDownload; + Exit; + end + else if (FMode = fmApplyInstallNow) then + begin + BUpdateSM.HandleInstallNow; Exit; end + else + begin + if BUpdateSM.HandleKmShell = 1 then + Exit; + end; finally - RemoteUpdateCheck.Free; + BUpdateSM.Free; end; @@ -636,6 +657,7 @@ function FirstRun(FQuery, FDisablePackages, FDefaultUILanguage: string): Boolean Pos('installdefaults', FQuery) > 0, Pos('startwithwindows', FQuery) > 0, Pos('checkforupdates', FQuery) > 0, + Pos('automaticupdates', FQuery) > 0, FDisablePackages, FDefaultUILanguage, Pos('automaticallyreportusage', FQuery) > 0); // I2651, I2753 diff --git a/windows/src/desktop/kmshell/util/UfrmDownloadProgress.pas b/windows/src/desktop/kmshell/util/UfrmDownloadProgress.pas index 2edcfbbcf70..9b5f779c8f1 100644 --- a/windows/src/desktop/kmshell/util/UfrmDownloadProgress.pas +++ b/windows/src/desktop/kmshell/util/UfrmDownloadProgress.pas @@ -1,18 +1,18 @@ (* Name: UfrmDownloadProgress Copyright: Copyright (C) SIL International. - Documentation: - Description: + Documentation: + Description: Create Date: 4 Dec 2006 Modified Date: 18 May 2012 Authors: mcdurdin - Related Files: - Dependencies: + Related Files: + Dependencies: - Bugs: - Todo: - Notes: + Bugs: + Todo: + Notes: History: 04 Dec 2006 - mcdurdin - Initial version 05 Dec 2006 - mcdurdin - Localize caption 15 Jan 2007 - mcdurdin - Use font from locale.xml diff --git a/windows/src/desktop/kmshell/util/utilkmshell.pas b/windows/src/desktop/kmshell/util/utilkmshell.pas index 74857532839..76eb4929dd1 100644 --- a/windows/src/desktop/kmshell/util/utilkmshell.pas +++ b/windows/src/desktop/kmshell/util/utilkmshell.pas @@ -33,7 +33,7 @@ interface uses - System.UITypes, + System.UITypes, System.IOUtils, System.Types, Dialogs, Windows, ComObj, shlobj, controls, sysutils, classes; const @@ -96,6 +96,7 @@ procedure SplitString(const instr: string; var outstr1, outstr2: string; const s function ValidDirectory(const dir: string): string; function GetLongFile(APath:String):String; +procedure GetFileNamesInDirectory(const directoryPath: string; var fileNames: TStringDynArray); function TSFInstalled: Boolean; @@ -540,6 +541,19 @@ function GetLongFile(APath:String):String; until Length(APath)=0; end; {Peter Haas} +procedure GetFileNamesInDirectory(const directoryPath: string; var fileNames: TStringDynArray); + +begin + // Check if the directory exists + if TDirectory.Exists(directoryPath) then + begin + // Retrieve file names within the directory + fileNames := TDirectory.GetFiles(directoryPath); + end + else + KL.Log('Directory does not exist.'); +end; + { TString } constructor TString.Create(const AString: string); diff --git a/windows/src/desktop/kmshell/xml/menuframe_update.jpg b/windows/src/desktop/kmshell/xml/menuframe_update.jpg new file mode 100644 index 00000000000..6eeb76bfd6f Binary files /dev/null and b/windows/src/desktop/kmshell/xml/menuframe_update.jpg differ diff --git a/windows/src/desktop/kmshell/xml/strings.xml b/windows/src/desktop/kmshell/xml/strings.xml index c8910b55b9d..24909d34864 100644 --- a/windows/src/desktop/kmshell/xml/strings.xml +++ b/windows/src/desktop/kmshell/xml/strings.xml @@ -417,6 +417,11 @@ Show welcome screen + + + + Automatically check for updates and download + @@ -586,8 +591,6 @@ Diagnostics - - @@ -712,6 +715,10 @@ keyboard that you use in Windows. Keyman keyboards will adapt automatically to + + + + Update @@ -803,6 +810,16 @@ keyboard that you use in Windows. Keyman keyboards will adapt automatically to + + + + Apply update now + + + + + Check for new updates + diff --git a/windows/src/desktop/setup/RunTools.pas b/windows/src/desktop/setup/RunTools.pas index 341f036c6cd..0b654cfeec5 100644 --- a/windows/src/desktop/setup/RunTools.pas +++ b/windows/src/desktop/setup/RunTools.pas @@ -82,7 +82,7 @@ TRunTools = class InstallSuccess: Boolean); function InstallMSI(msiLocation: TInstallInfoFileLocation; var InstallDefaults: Boolean; ContinueSetup: Boolean): Boolean; procedure ConfigFirstRun(StartKeyman,StartWithWindows, - CheckForUpdates,StartDisabled,StartWithConfiguration,InstallDefaults, + CheckForUpdates,AutomaticUpdates,StartDisabled,StartWithConfiguration,InstallDefaults, AutomaticallyReportUsage: Boolean); procedure PrepareForReboot(res: Cardinal; InstallDefaults: Boolean); function RestartWindows: Boolean; @@ -101,7 +101,7 @@ TRunTools = class destructor Destroy; override; procedure CheckInternetConnectedState; function DoInstall(Handle: THandle; - StartAfterInstall, StartWithWindows, CheckForUpdates, StartDisabled, + StartAfterInstall, StartWithWindows, CheckForUpdates, AutomaticUpdates, StartDisabled, StartWithConfiguration, InstallDefaults, AutomaticallyReportUsage, ContinueSetup: Boolean): Boolean; procedure LogError(const msg: WideString; ShowDialogIfNotSilent: Boolean = True); procedure LogInfo(const msg: string; ShowDialogIfNotSilent: Boolean = False); @@ -194,7 +194,7 @@ destructor TRunTools.Destroy; end; function TRunTools.DoInstall(Handle: THandle; - StartAfterInstall, StartWithWindows, CheckForUpdates, StartDisabled, + StartAfterInstall, StartWithWindows, CheckForUpdates, AutomaticUpdates, StartDisabled, StartWithConfiguration, InstallDefaults, AutomaticallyReportUsage, ContinueSetup: Boolean): Boolean; var msiLocation: TInstallInfoFileLocation; @@ -224,7 +224,7 @@ function TRunTools.DoInstall(Handle: THandle; Exit(False); end; - ConfigFirstRun(StartAfterInstall,StartWithWindows,CheckForUpdates, + ConfigFirstRun(StartAfterInstall,StartWithWindows,CheckForUpdates,AutomaticUpdates, StartDisabled,StartWithConfiguration,InstallDefaults,AutomaticallyReportUsage); Result := True; @@ -588,7 +588,7 @@ procedure TRunTools.WaitFor(hProcess: THandle; var Waiting, Cancelled: Boolean); end; end; -procedure TRunTools.ConfigFirstRun(StartKeyman,StartWithWindows,CheckForUpdates, +procedure TRunTools.ConfigFirstRun(StartKeyman,StartWithWindows,CheckForUpdates,AutomaticUpdates, StartDisabled,StartWithConfiguration,InstallDefaults,AutomaticallyReportUsage: Boolean); var i: Integer; @@ -686,6 +686,7 @@ procedure TRunTools.ConfigFirstRun(StartKeyman,StartWithWindows,CheckForUpdates, if StartWithWindows then s := s + 'StartWithWindows,'; if CheckForUpdates then s := s + 'CheckForUpdates,'; + if AutomaticUpdates then s := s + 'AutomaticUpdates,'; if AutomaticallyReportUsage then s := s + 'AutomaticallyReportUsage,'; if InstallDefaults then diff --git a/windows/src/desktop/setup/UfrmRunDesktop.pas b/windows/src/desktop/setup/UfrmRunDesktop.pas index 293df6a6138..ded19ae75cd 100644 --- a/windows/src/desktop/setup/UfrmRunDesktop.pas +++ b/windows/src/desktop/setup/UfrmRunDesktop.pas @@ -113,6 +113,7 @@ TfrmRunDesktop = class(TForm) FCanUpgrade9: Boolean; FCanUpgrade10: Boolean; FCheckForUpdates: Boolean; + FAutomaticUpdates: Boolean; FStartAfterInstall: Boolean; FStartWithWindows: Boolean; FAutomaticallyReportUsage: Boolean; @@ -523,7 +524,7 @@ procedure TfrmRunDesktop.DoInstall(Silent, PromptForReboot: Boolean); // I3355 SetupMSI; // I2644 if GetRunTools.DoInstall(Handle, FStartAfterInstall, FStartWithWindows, FCheckForUpdates, - FInstallInfo.StartDisabled, FInstallInfo.StartWithConfiguration, FInstallDefaults, + FAutomaticUpdates, FInstallInfo.StartDisabled, FInstallInfo.StartWithConfiguration, FInstallDefaults, FAutomaticallyReportUsage, FContinueSetup) then begin if not Silent and not FStartAfterInstall then // I2610 @@ -1032,6 +1033,7 @@ procedure TfrmRunDesktop.GetDefaultSettings; // I2651 begin FStartWithWindows := True; // I2607 FCheckForUpdates := True; // I2609 + FAutomaticUpdates := True; try with CreateHKCURegistry do // I2749 @@ -1041,6 +1043,8 @@ procedure TfrmRunDesktop.GetDefaultSettings; // I2651 FCheckForUpdates := ValueExists(SRegValue_CheckForUpdates) and ReadBool(SRegValue_CheckForUpdates); FStartWithWindows := ValueExists(SRegValue_UpgradeRunKeyman) or (OpenKeyReadOnly('\' + SRegKey_WindowsRun_CU) and ValueExists(SRegValue_WindowsRun_Keyman)); + FAutomaticUpdates := not ValueExists(SRegValue_AutomaticUpdates) or ReadBool(SRegValue_AutomaticUpdates); + end else if FCanUpgrade10 and OpenKeyReadOnly(SRegKey_KeymanEngine100_ProductOptions_Desktop_CU) then // I4293 begin diff --git a/windows/src/engine/insthelper/Keyman.System.Install.EnginePostInstall.pas b/windows/src/engine/insthelper/Keyman.System.Install.EnginePostInstall.pas index bdf602ae056..6c756bbbac2 100644 --- a/windows/src/engine/insthelper/Keyman.System.Install.EnginePostInstall.pas +++ b/windows/src/engine/insthelper/Keyman.System.Install.EnginePostInstall.pas @@ -25,6 +25,38 @@ function ReportFailure(hInstall: MSIHANDLE; const func: string; code: UINT): UIN Result := code; end; + +function UpdateState: Boolean; +var + UpdateStr : UnicodeString; + hk: Winapi.Windows.HKEY; +begin + + Result := False; + UpdateStr := 'usPostInstall'; + + if RegCreateKeyEx(HKEY_CURRENT_USER, PChar(SRegKey_KeymanEngine_CU), 0, nil, 0, KEY_ALL_ACCESS, nil, &hk, nil) = ERROR_SUCCESS then + begin + try + if RegSetValueEx(hk, PChar(SRegValue_Update_State), 0, REG_SZ, PChar(UpdateStr), (Length(UpdateStr)+1) * SizeOf(Char)) = ERROR_SUCCESS then + begin + Result := True; + end + else + begin + // TODO-WINDOWS-UPDATES: error log + end; + finally + RegCloseKey(hk); + end; + end + else + begin + //TODO-WINDOWS-UPDATES: error log creating key + end; +end; + + { Add permission for ALL APPLICATION PACKAGES to read %ProgramData%\Keyman folder } @@ -61,6 +93,8 @@ function EnginePostInstall(hInstall: MSIHANDLE): UINT; end; Result := ERROR_SUCCESS; + // TODO-WINDOWS-UPDATES: better error checking on the registry key update + UpdateState; finally if not CloseHandle(hFile) then diff --git a/windows/src/engine/keyman/keyman.dpr b/windows/src/engine/keyman/keyman.dpr index 8685e8f4a62..dadcca01fc5 100644 --- a/windows/src/engine/keyman/keyman.dpr +++ b/windows/src/engine/keyman/keyman.dpr @@ -32,7 +32,7 @@ uses UfrmOSKPlugInBase in 'viskbd\UfrmOSKPlugInBase.pas' {frmOSKPlugInBase}, UfrmOSKCharacterMap in 'viskbd\UfrmOSKCharacterMap.pas' {frmOSKCharacterMap}, UfrmOSKEntryHelper in 'viskbd\UfrmOSKEntryHelper.pas' {frmOSKEntryHelper}, - TTInfo in '..\..\..\..\common\windows\delphi\general\TTInfo.pas', + ttinfo in '..\..\..\..\common\windows\delphi\general\ttinfo.pas', UnicodeData in '..\..\..\..\common\windows\delphi\charmap\UnicodeData.pas', CharacterMapSettings in '..\..\..\..\common\windows\delphi\charmap\CharacterMapSettings.pas', CharacterRanges in '..\..\..\..\common\windows\delphi\charmap\CharacterRanges.pas', @@ -112,7 +112,8 @@ uses Sentry.Client.Vcl in '..\..\..\..\common\windows\delphi\ext\sentry\Sentry.Client.Vcl.pas', sentry in '..\..\..\..\common\windows\delphi\ext\sentry\sentry.pas', Keyman.System.KeymanSentryClient in '..\..\..\..\common\windows\delphi\general\Keyman.System.KeymanSentryClient.pas', - Keyman.System.LocaleStrings in '..\..\global\delphi\cust\Keyman.System.LocaleStrings.pas'; + Keyman.System.LocaleStrings in '..\..\global\delphi\cust\Keyman.System.LocaleStrings.pas', + Keyman.System.ExecutionHistory in '..\..\..\..\common\windows\delphi\general\Keyman.System.ExecutionHistory.pas'; {$R ICONS.RES} {$R VERSION.RES} diff --git a/windows/src/engine/keyman/keyman.dproj b/windows/src/engine/keyman/keyman.dproj index 44959854d5a..aa70b2ab7bd 100644 --- a/windows/src/engine/keyman/keyman.dproj +++ b/windows/src/engine/keyman/keyman.dproj @@ -141,7 +141,7 @@
frmOSKEntryHelper
 - + @@ -238,6 +238,7 @@ + Cfg_2 @@ -299,21 +300,21 @@ False - + - keyman.exe + .\ true - + keyman.rsm true - + - .\ + keyman.exe true diff --git a/windows/src/engine/keyman/main.pas b/windows/src/engine/keyman/main.pas index 2c019150d7c..79db9c8baa2 100644 --- a/windows/src/engine/keyman/main.pas +++ b/windows/src/engine/keyman/main.pas @@ -40,9 +40,11 @@ implementation System.Win.Registry, GetOsVersion, + Keyman.System.ExecutionHistory, Keyman.System.Security, Keyman.Winapi.VersionHelpers, KeymanVersion, + Klog, RegistryKeys, UfrmKeyman7Main, UserMessages; @@ -76,9 +78,10 @@ procedure RunProgram; hMutex: Cardinal; begin - if not ValidateParameters(FCommand) then Exit; + RecordKeymanStarted; + hProgramMutex := CreateMutex(nil, False, 'KeymanEXE70'); if hProgramMutex = 0 then begin diff --git a/windows/src/engine/kmcomapi/util/utilkeymanoption.pas b/windows/src/engine/kmcomapi/util/utilkeymanoption.pas index 906e121f077..8a18f3be262 100644 --- a/windows/src/engine/kmcomapi/util/utilkeymanoption.pas +++ b/windows/src/engine/kmcomapi/util/utilkeymanoption.pas @@ -121,7 +121,7 @@ TKeymanOptionInfo = record GroupName: string; end; -const KeymanOptionInfo: array[0..16] of TKeymanOptionInfo = ( // I3331 // I3620 // I4552 +const KeymanOptionInfo: array[0..17] of TKeymanOptionInfo = ( // I3331 // I3620 // I4552 // Global options (opt: koKeyboardHotkeysAreToggle; RegistryName: SRegValue_KeyboardHotkeysAreToggle; OptionType: kotBool; BoolValue: False; GroupName: 'kogGeneral'), @@ -129,7 +129,8 @@ TKeymanOptionInfo = record (opt: koAltGrCtrlAlt; RegistryName: SRegValue_AltGrCtrlAlt; OptionType: kotBool; BoolValue: False; GroupName: 'kogGeneral'), (opt: koRightModifierHK; RegistryName: SRegValue_AllowRightModifierHotKey; OptionType: kotBool; BoolValue: False; GroupName: 'kogGeneral'), (opt: koShowHints; RegistryName: SRegValue_EnableHints; OptionType: kotBool; BoolValue: True; GroupName: 'kogGeneral'), - (opt: koBaseLayout; RegistryName: SRegValue_UnderlyingLayout; OptionType: kotLong; IntValue: 0; GroupName: 'kogGeneral'), + (opt: koBaseLayout; RegistryName: SRegValue_UnderlyingLayout; OptionType: kotLong; IntValue: 0; GroupName: 'kogGeneral'), + (opt: koAutomaticUpdate; RegistryName: SRegValue_AutomaticUpdates; OptionType: kotBool; BoolValue: True; GroupName: 'kogGeneral'), (opt: koAutomaticallyReportErrors; RegistryName: SRegValue_AutomaticallyReportErrors; OptionType: kotBool; BoolValue: True; GroupName: 'kogGeneral'), // I4393 (opt: koAutomaticallyReportUsage; RegistryName: SRegValue_AutomaticallyReportUsage; OptionType: kotBool; BoolValue: True; GroupName: 'kogGeneral'), // I4393 diff --git a/windows/src/global/delphi/general/KeymanOptionNames.pas b/windows/src/global/delphi/general/KeymanOptionNames.pas index 73356d19cb3..2d4be34c0a7 100644 --- a/windows/src/global/delphi/general/KeymanOptionNames.pas +++ b/windows/src/global/delphi/general/KeymanOptionNames.pas @@ -10,6 +10,7 @@ interface koRightModifierHK, koReleaseShiftKeysAfterKeyPress, koShowHints, // I1256 + koAutomaticUpdate, // Startup options koTestKeymanFunctioning, koStartWithWindows,