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

(*
  Name:             WebUpdateCheck
  Copyright:        Copyright (C) SIL International.
  Documentation:
  Description:
  Create Date:      5 Dec 2023

  Modified Date:
  Authors:          rcruickshank
  Related Files:
  Dependencies:

  Bugs:
  Todo:
  Notes:
  History:
*)
unit Keyman.System.RemoteUpdateCheck;  // I3306

interface

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

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;
    FDownload: TRemoteUpdateCheckDownloadParams;
    FCheckOnly: Boolean;

    function DownloadUpdates(Params: TUpdateCheckResponse) : Boolean;
    procedure DoDownloadUpdates(SavePath: string; Params: TUpdateCheckResponse;  var Result: Boolean);
    function DoRun: TRemoteUpdateCheckResult;
  public

    constructor Create(AForce : Boolean; ACheckOnly: Boolean = False);
    destructor Destroy; override;
    function Run: TRemoteUpdateCheckResult;
    property ShowErrors: Boolean read FShowErrors write FShowErrors;
  end;

procedure LogMessage(LogMessage: string);

implementation

uses
  System.WideStrUtils,
  Winapi.Windows,
  Winapi.WinINet,

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

  OnlineUpdateCheckMessages;

{ TRemoteUpdateCheck }

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

  FShowErrors := True;
  FRemoteResult := wucUnknown;

  FForce := AForce;
  FCheckOnly := ACheckOnly;

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

destructor TRemoteUpdateCheck.Destroy;
begin
  if (FErrorMessage <> '') and FShowErrors then
    LogMessage(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;

  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;

    function DownloadFile(const url, savepath: string): Boolean;
    begin
      with THttpUploader.Create(nil) do
      try
        Proxy.Server := GetProxySettings.Server;
        Proxy.Port := GetProxySettings.Port;
        Proxy.Username := GetProxySettings.Username;
        Proxy.Password := GetProxySettings.Password;
        Request.Agent := API_UserAgent;

        Request.SetURL(url);
        Upload;
        if Response.StatusCode = 200 then
        begin
          fs := TFileStream.Create(savepath, fmCreate);
          try
            fs.Write(Response.PMessageBody^, 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
        Free;
      end;
    end;


begin
  Result := False;
  try
    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 record 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;
  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;

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;
begin
  {FProxyHost := '';
  FProxyPort := 0;}

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

  { Verify that it has been at least 7 days since last update check }
  try
    with TRegistryErrorControlled.Create do  // I2890
    try
      if OpenKeyReadOnly(SRegKey_KeymanDesktop_CU) then
      begin
        if ValueExists(SRegValue_CheckForUpdates) and not ReadBool(SRegValue_CheckForUpdates) and not FForce then
        begin
          Result := wucNoUpdates;
          Exit;
        end;
        if ValueExists(SRegValue_LastUpdateCheckTime) and (Now - ReadDateTime(SRegValue_LastUpdateCheckTime) < 7) and not FForce then
        begin
          Result := wucNoUpdates;
          // TODO: 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
      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;
  end;

  Result := wucNoUpdates;

  try
    with THTTPUploader.Create(nil) do
    try
      Fields.Add('version', ansistring(CKeymanVersionInfo.Version));
      Fields.Add('tier', ansistring(CKeymanVersionInfo.Tier));
      if FForce
        then Fields.Add('manual', '1')
        else 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.
        Fields.Add(AnsiString('packageid_'+IntToStr(i)), AnsiString(pkg.ID));
        Fields.Add(AnsiString('packageversion_'+IntToStr(i)), AnsiString(pkg.Version));
        pkg := nil;
      end;

      Proxy.Server := GetProxySettings.Server;
      Proxy.Port := GetProxySettings.Port;
      Proxy.Username := GetProxySettings.Username;
      Proxy.Password := GetProxySettings.Password;

      Request.HostName := API_Server;
      Request.Protocol := API_Protocol;
      Request.UrlPath := API_Path_UpdateCheck_Windows;
      //OnStatus :=
      Upload;
      if Response.StatusCode = 200 then
      begin
        if ucr.Parse(Response.MessageBodyAsString, 'bundle', CKeymanVersionInfo.Version) then
        begin
          //ResponseToParams(ucr);

          if FCheckOnly then
          begin
            // TODO: Refactor this
            TUpdateCheckStorage.SaveUpdateCacheData(ucr);
            Result := FRemoteResult;
          end
          // TODO: #10038
          // 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;
        end
        else
        begin
          FErrorMessage := ucr.ErrorMessage;
          Result := wucFailure;
        end;
      end
      else
        raise ERemoteUpdateCheck.Create('Error '+IntToStr(Response.StatusCode));
    finally
      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;

  with TRegistryErrorControlled.Create do  // I2890
  try
    if OpenKey(SRegKey_KeymanDesktop_CU, True) then
      WriteDateTime(SRegValue_LastUpdateCheckTime, Now);
  finally
    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;

end.