spiegel-keyman/windows/src/desktop/kmshell/main/Keyman.System.RemoteUpdateCheck.pas

(**
  * 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

interface

uses
  System.Classes,
  System.SysUtils,
  KeymanPaths,
  httpuploader,
  Keyman.System.UpdateCheckResponse,
  OnlineUpdateCheck;

const
  CheckPeriod: Integer = 7; // Days between checking for updates

type
  ERemoteUpdateCheck = class(Exception);

  TRemoteUpdateCheckResult = (wucUnknown, wucSuccess, wucNoUpdates, wucFailure, wucOffline);

  TRemoteUpdateCheckDownloadParams = record
    TotalSize: Integer;
    TotalDownloads: Integer;
    StartPosition: Integer;
  end;

  TRemoteUpdateCheck = class
  private
    FForce: Boolean;
    FRemoteResult: TRemoteUpdateCheckResult;
    FErrorMessage: string;
    FShowErrors: 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);
    destructor Destroy; override;
    function Run: TRemoteUpdateCheckResult;
    property ShowErrors: Boolean read FShowErrors write FShowErrors;
  end;

(**
  * 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,
  Sentry.Client,

  GlobalProxySettings,
  KLog,
  keymanapi_TLB,
  KeymanVersion,
  Keyman.System.KeymanSentryClient,
  Keyman.System.UpdateCheckStorage,
  kmint,
  ErrorControlledRegistry,
  RegistryKeys,
  Upload_Settings,

  OnlineUpdateCheckMessages;

{ TRemoteUpdateCheck }

constructor TRemoteUpdateCheck.Create(AForce: Boolean);
begin
  inherited Create;

  FShowErrors := True;
  FRemoteResult := wucUnknown;

  FForce := AForce;

  KL.Log('TRemoteUpdateCheck.Create');
end;

destructor TRemoteUpdateCheck.Destroy;
begin
  if (FErrorMessage <> '') and FShowErrors then
        TKeymanSentryClient.Client.MessageEvent(Sentry.Client.SENTRY_LEVEL_ERROR,
      '"+FErrorMessage+"');

  KL.Log('TRemoteUpdateCheck.Destroy: FErrorMessage = ' + FErrorMessage);
  KL.Log('TRemoteUpdateCheck.Destroy: FRemoteResult = ' +
    IntToStr(Ord(FRemoteResult)));

  inherited Destroy;
end;

function TRemoteUpdateCheck.Run: TRemoteUpdateCheckResult;
begin
  Result := DoRun;
  FRemoteResult := Result;
end;

function TRemoteUpdateCheck.DoRun: TRemoteUpdateCheckResult;
var
  flags: DWord;
  i: Integer;
  ucr: TUpdateCheckResponse;
  pkg: IKeymanPackage;
  Registry: TRegistryErrorControlled;
  http: THttpUploader;
  proceed: Boolean;
begin
  { FProxyHost := '';
    FProxyPort := 0; }

  { Check if user is currently online }
  if not InternetGetConnectedState(@flags, 0) then
  begin
    Result := wucOffline;
    Exit;
  end;

  proceed := ConfigCheckContinue;
  if not proceed and not FForce then
  begin
    Result := wucNoUpdates;
    Exit;
  end;

  try
    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');

      for i := 0 to kmcom.Packages.Count - 1 do
      begin
        pkg := kmcom.Packages[i];

        // 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));
        pkg := nil;
      end;

      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;
      // OnStatus :=
      http.Upload;
      if http.Response.StatusCode = 200 then
      begin
        if ucr.Parse(http.Response.MessageBodyAsString, 'bundle', CKeymanVersionInfo.Version) then
        begin
          TUpdateCheckStorage.SaveUpdateCacheData(ucr);
          Result := wucSuccess;
        end
        else
        begin
          FErrorMessage := ucr.ErrorMessage;
          Result := wucFailure;
        end;
      end
      else
        raise ERemoteUpdateCheck.Create('Error '+IntToStr(http.Response.StatusCode));
    finally
      http.Free;
    end;
  except
    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]);
      Result := wucFailure;
    end;
    on E: Exception do
    begin
      FErrorMessage := E.Message;
      Result := wucFailure;
    end;
  end;

  Registry := TRegistryErrorControlled.Create; // I2890
  try
    if Registry.OpenKey(SRegKey_KeymanDesktop_CU, True) then
      Registry.WriteDateTime(SRegValue_LastUpdateCheckTime, Now);
  finally
    Registry.Free;
  end;
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;
          TKeymanSentryClient.Client.MessageEvent(Sentry.Client.SENTRY_LEVEL_ERROR,
      E.Message);
    end;
  end;
end;

end.