Refactor of JSON response processing. Full refactor of the update check comes in a later version

This commit is contained in:
Marc Durdin 2018-02-15 10:35:12 +07:00
parent 2b0d5465c8
commit f4d1856695
14 changed files with 124 additions and 116 deletions

View file

@ -150,7 +150,8 @@ uses
JsonUtil in '..\..\global\delphi\general\JsonUtil.pas',
Keyman.System.LanguageCodeUtils in '..\..\global\delphi\general\Keyman.System.LanguageCodeUtils.pas',
Keyman.System.Standards.ISO6393ToBCP47Registry in '..\..\global\delphi\standards\Keyman.System.Standards.ISO6393ToBCP47Registry.pas',
Keyman.System.Standards.LCIDToBCP47Registry in '..\..\global\delphi\standards\Keyman.System.Standards.LCIDToBCP47Registry.pas';
Keyman.System.Standards.LCIDToBCP47Registry in '..\..\global\delphi\standards\Keyman.System.Standards.LCIDToBCP47Registry.pas' {$R VERSION.RES},
Keyman.System.UpdateCheckResponse in '..\..\global\delphi\general\Keyman.System.UpdateCheckResponse.pas';
{$R VERSION.RES}
{$R manifest.res}

View file

@ -295,6 +295,7 @@
<DCCReference Include="..\..\global\delphi\standards\Keyman.System.Standards.LCIDToBCP47Registry.pas">
<Form>$R VERSION.RES</Form>
</DCCReference>
<DCCReference Include="..\..\global\delphi\general\Keyman.System.UpdateCheckResponse.pas"/>
<None Include="Profiling\AQtimeModule1.aqt"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
@ -390,18 +391,18 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Profiling\AQtimeModule1.aqt" Configuration="Debug" Class="ProjectFile">
<Platform Name="Win32">
<RemoteDir>.\</RemoteDir>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="kmshell.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>kmshell.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Profiling\AQtimeModule1.aqt" Configuration="Debug" Class="ProjectFile">
<Platform Name="Win32">
<RemoteDir>.\</RemoteDir>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="OSX32">
<Operation>1</Operation>

View file

@ -41,7 +41,8 @@ uses
Classes,
httpuploader,
SysUtils,
UfrmDownloadProgress;
UfrmDownloadProgress,
Keyman.System.UpdateCheckResponse;
type
EOnlineUpdateCheck = class(Exception);
@ -121,9 +122,7 @@ implementation
uses
Vcl.Dialogs,
Vcl.Forms,
xmlintf,
GlobalProxySettings,
JsonUtil,
KLog,
keymanapi_TLB,
kmint,
@ -131,7 +130,6 @@ uses
ErrorControlledRegistry,
RegistryKeys,
ShellApi,
System.JSON,
Upload_Settings,
utildir,
utilexecute,
@ -488,17 +486,11 @@ end;
function TOnlineUpdateCheck.DoRun: TOnlineUpdateCheckResult;
var
node, doc: TJSONObject;
{FProxyHost: string;
FProxyPort: Integer;}
flags: DWord;
i, n: Integer;
kbd0: IKeymanKeyboard;
pkg0: IKeymanPackageInstalled;
kbd: IKeymanKeyboardInstalled;
pkg: IKeymanPackage;
j: Integer;
nodes: TJSONObject;
ucr: TUpdateCheckResponse;
begin
{FProxyHost := '';
FProxyPort := 0;}
@ -547,6 +539,8 @@ begin
end;
end;
Result := oucNoUpdates;
try
with THTTPUploader.Create(nil) do
try
@ -571,71 +565,59 @@ begin
Upload;
if Response.StatusCode = 200 then
begin
doc := TJSONObject.ParseJSONValue(UTF8String(Response.MessageBodyAsString)) as TJSONObject;
if doc = nil then
raise EOnlineUpdateCheck.Create('Invalid response:'#13#10+string(Response.MessageBodyAsString));
SetLength(FParams.Packages,0);
if doc.Values['keyboards'] is TJSONObject
then nodes := doc.Values['keyboards'] as TJSONObject
else nodes := nil;
if Assigned(nodes) then
if ucr.Parse(Response.MessageBodyAsString, 'windows', FCurrentVersion) then
begin
for i := 0 to nodes.Count - 1 do
SetLength(FParams.Packages,0);
for i := Low(ucr.Packages) to High(ucr.Packages) do
begin
node := nodes.Pairs[i].JsonValue as TJSONObject;
n := kmcom.Packages.IndexOf(nodes.Pairs[i].JsonString.Value);
n := kmcom.Packages.IndexOf(ucr.Packages[i].ID);
if n >= 0 then
begin
pkg := kmcom.Packages[n];
j := Length(FParams.Packages);
SetLength(FParams.Packages, j+1);
FParams.Packages[j].NewID := node.Values['id'].Value;
FParams.Packages[j].ID := nodes.Pairs[i].JsonString.Value;
FParams.Packages[j].Description := node.Values['name'].Value;
FParams.Packages[j].NewID := ucr.Packages[i].NewID;
FParams.Packages[j].ID := ucr.Packages[i].ID;
FParams.Packages[j].Description := ucr.Packages[i].Name;
FParams.Packages[j].OldVersion := pkg.Version;
FParams.Packages[j].NewVersion := node.Values['version'].Value;
FParams.Packages[j].DownloadSize := (node.Values['packageFileSize'] as TJSONNumber).AsInt64;
FParams.Packages[j].DownloadURL := node.Values['url'].Value;
FParams.Packages[j].NewVersion := ucr.Packages[i].NewVersion;
FParams.Packages[j].DownloadSize := ucr.Packages[i].DownloadSize;
FParams.Packages[j].DownloadURL := ucr.Packages[i].DownloadURL;
pkg := nil;
end
else
FErrorMessage := 'Unable to find package '+node.Pairs[i].JsonString.Value;
FErrorMessage := 'Unable to find package '+ucr.Packages[i].ID;
end;
end;
if doc.Values['windows'] is TJSONObject then
begin
node := doc.Values['windows'] as TJSONObject;
if CompareVersions(node.Values['version'].Value, FCurrentVersion) < 0 then
begin
FParams.Keyman.OldVersion := FCurrentVersion;
FParams.Keyman.NewVersion := node.Values['version'].Value;
FParams.Keyman.DownloadURL := node.Values['url'].Value;
FParams.Keyman.DownloadSize := (node.Values['size'] as TJSONNumber).AsInt64;
case ucr.Status of
ucrsNoUpdate:
begin
FErrorMessage := ucr.ErrorMessage;
end;
ucrsUpdateReady:
begin
FParams.Keyman.OldVersion := ucr.CurrentVersion;
FParams.Keyman.NewVersion := ucr.NewVersion;
FParams.Keyman.DownloadURL := ucr.InstallURL;
FParams.Keyman.DownloadSize := ucr.InstallSize;
end;
end;
end;
if (Length(FParams.Packages) > 0) or (FParams.Keyman.DownloadURL <> '') then
begin
if not FSilent then
ShowUpdateForm
else
if (Length(FParams.Packages) > 0) or (FParams.Keyman.DownloadURL <> '') then
begin
ShowUpdateIcon;
if not FSilent then
ShowUpdateForm
else
begin
ShowUpdateIcon;
end;
Result := FParams.Result;
end;
Result := FParams.Result;
end
else if doc.Values['message'] <> nil then
begin
Result := oucFailure;
FErrorMessage := doc.Values['message'].Value;
end
else
begin
FErrorMessage := 'No updates are currently available.';
Result := oucNoUpdates;
FErrorMessage := ucr.ErrorMessage;
Result := oucFailure;
end;
end
else

View file

@ -123,7 +123,7 @@ implementation
uses
Vcl.Forms,
System.JSON,
Keyman.System.UpdateCheckResponse,
bootstrapmain,
comobj,
@ -323,8 +323,7 @@ end;
procedure TRunTools.CheckNewVersion;
var
doc: TJSONObject;
node: TJSONObject;
ucr: TUpdateCheckResponse;
begin
with THTTPUploader.Create(nil) do
try
@ -334,26 +333,23 @@ begin
Request.HostName := API_Server;
Request.Protocol := API_Protocol;
Request.UrlPath := API_Path_UpdateCheck;
Request.UrlPath := API_Path_UpdateCheck_Desktop;
Upload;
if Response.StatusCode = 200 then
begin
doc := TJSONObject.ParseJSONValue(UTF8String(Response.MessageBodyAsString)) as TJSONObject;
if doc = nil then
raise Exception.Create('Invalid response:'#13#10+string(Response.MessageBodyAsString));
if doc.Values['windows'] is TJSONObject then
if ucr.Parse(Response.MessageBodyAsString, 'windows', FInstallInfo.Version) then
begin
node := doc.Values['windows'] as TJSONObject;
if CompareVersions(node.Values['version'].Value, FInstallInfo.Version) < 0 then
if ucr.Status = ucrsUpdateReady then
begin
FNewVersion.Version := node.Values['version'].Value;
FNewVersion.InstallURL := node.Values['url'].Value;
FNewVersion.InstallSize := (node.Values['size'] as TJSONNumber).AsInt64;
FNewVersion.Version := ucr.NewVersion;
FNewVersion.InstallURL := ucr.InstallURL;
FNewVersion.InstallSize := ucr.InstallSize;
FNewVersion.Filename := ExtractFileName(StringReplace(FNewVersion.InstallURL, '/', '\', [rfReplaceAll])); // I1917
end;
end;
end
else
raise Exception.Create(ucr.ErrorMessage);
end
else
raise Exception.Create('Error '+IntToStr(Response.StatusCode));

View file

@ -36,7 +36,8 @@ uses
Unicode in '..\..\global\delphi\general\Unicode.pas',
KeymanVersion in '..\..\global\delphi\general\KeymanVersion.pas',
KeymanPaths in '..\..\global\delphi\general\KeymanPaths.pas',
SFX in '..\..\global\delphi\setup\SFX.pas';
SFX in '..\..\global\delphi\setup\SFX.pas',
Keyman.System.UpdateCheckResponse in '..\..\global\delphi\general\Keyman.System.UpdateCheckResponse.pas';
{$R icons.res}
{$R version.res}

View file

@ -136,6 +136,7 @@
<DCCReference Include="..\..\global\delphi\general\KeymanVersion.pas"/>
<DCCReference Include="..\..\global\delphi\general\KeymanPaths.pas"/>
<DCCReference Include="..\..\global\delphi\setup\SFX.pas"/>
<DCCReference Include="..\..\global\delphi\general\Keyman.System.UpdateCheckResponse.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>

View file

@ -262,7 +262,8 @@ uses
BCP47Tag in '..\..\global\delphi\general\BCP47Tag.pas',
Keyman.System.KMXFileLanguages in '..\..\global\delphi\keyboards\Keyman.System.KMXFileLanguages.pas',
Keyman.System.LanguageCodeUtils in '..\..\global\delphi\general\Keyman.System.LanguageCodeUtils.pas',
Keyman.System.RegExGroupHelperRSP19902 in '..\..\global\delphi\general\Keyman.System.RegExGroupHelperRSP19902.pas';
Keyman.System.RegExGroupHelperRSP19902 in '..\..\global\delphi\general\Keyman.System.RegExGroupHelperRSP19902.pas',
Keyman.System.UpdateCheckResponse in '..\..\global\delphi\general\Keyman.System.UpdateCheckResponse.pas';
{$R *.RES}
{$R ICONS.RES}

View file

@ -503,6 +503,7 @@
<DCCReference Include="..\..\global\delphi\keyboards\Keyman.System.KMXFileLanguages.pas"/>
<DCCReference Include="..\..\global\delphi\general\Keyman.System.LanguageCodeUtils.pas"/>
<DCCReference Include="..\..\global\delphi\general\Keyman.System.RegExGroupHelperRSP19902.pas"/>
<DCCReference Include="..\..\global\delphi\general\Keyman.System.UpdateCheckResponse.pas"/>
<None Include="Profiling\AQtimeModule1.aqt"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>

View file

@ -123,13 +123,13 @@ implementation
{R *.dfm}
uses
System.JSON,
Unicode, utilexecute,
utilsystem, shlobj,
OnlineConstants,
TntDialogHelp,
types, upload_settings,
httpuploader,
Keyman.System.UpdateCheckResponse,
VersionInfo, GetOSVersion,
SFX,
bootstrapmain, jwawintype, jwamsi, ErrorControlledRegistry, RegistryKeys;
@ -277,40 +277,33 @@ end;
procedure TfrmRun.CheckNewVersion;
var
doc: TJSONObject;
node: TJSONObject;
ucr: TUpdateCheckResponse;
begin
with THTTPUploader.Create(nil) do
try
// TODO: Eliminate Raw parameter and use 'setup' instead
Fields.Add('OnlineProductID', AnsiString(IntToStr(OnlineProductID_KeymanDeveloper_100))); // I2856 // I3377
if FInstalledVersion.Version = ''
then Fields.Add('Version', AnsiString(FInstallInfo.Version))
else Fields.Add('Version', AnsiString(FInstalledVersion.Version));
Fields.Add('Raw', '1');
Request.HostName := API_Server;
Request.Protocol := API_Protocol;
Request.UrlPath := API_Path_UpdateCheck;
Request.UrlPath := API_Path_UpdateCheck_Developer;
Upload;
if Response.StatusCode = 200 then
begin
doc := TJSONObject.ParseJSONValue(UTF8String(Response.MessageBodyAsString)) as TJSONObject;
if doc = nil then
raise Exception.Create('Invalid response:'#13#10+string(Response.MessageBodyAsString));
if doc.Values['windows'] is TJSONObject then
if ucr.Parse(Response.MessageBodyAsString, 'developer', FInstallInfo.Version) then
begin
node := doc.Values['windows'] as TJSONObject;
if CompareVersions(node.Values['version'].Value, FInstallInfo.Version) < 0 then
if ucr.Status = ucrsUpdateReady then
begin
FNewVersion.Version := node.Values['version'].Value;
FNewVersion.InstallURL := node.Values['url'].Value;
FNewVersion.InstallSize := (node.Values['size'] as TJSONNumber).AsInt64;
FNewVersion.Version := ucr.NewVersion;
FNewVersion.InstallURL := ucr.InstallURL;
FNewVersion.InstallSize := ucr.InstallSize;
FNewVersion.Filename := ExtractFileName(StringReplace(FNewVersion.InstallURL, '/', '\', [rfReplaceAll])); // I1917
end;
end;
end
else
raise Exception.Create(ucr.ErrorMessage);
end
else
raise Exception.Create('Error '+IntToStr(Response.StatusCode));

View file

@ -26,7 +26,8 @@ uses
Unicode in '..\..\global\delphi\general\Unicode.pas',
utilexecute in '..\..\global\delphi\general\utilexecute.pas',
KeymanVersion in '..\..\global\delphi\general\KeymanVersion.pas',
SFX in '..\..\global\delphi\setup\SFX.pas';
SFX in '..\..\global\delphi\setup\SFX.pas',
Keyman.System.UpdateCheckResponse in '..\..\global\delphi\general\Keyman.System.UpdateCheckResponse.pas';
{$R icons.res}
{$R version.res}

View file

@ -108,6 +108,7 @@
<DCCReference Include="..\..\global\delphi\general\utilexecute.pas"/>
<DCCReference Include="..\..\global\delphi\general\KeymanVersion.pas"/>
<DCCReference Include="..\..\global\delphi\setup\SFX.pas"/>
<DCCReference Include="..\..\global\delphi\general\Keyman.System.UpdateCheckResponse.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
@ -160,7 +161,6 @@
</VersionInfoKeys>
</Delphi.Personality>
<Platforms>
<Platform value="Linux64">False</Platform>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>

View file

@ -3,12 +3,26 @@ unit Keyman.System.UpdateCheckResponse;
interface
uses
System.JSON,
System.SysUtils;
type
EUpdateCheckResponse = class(Exception);
TUpdateCheckResponseStatus = (ucrsNoUpdate, ucrsUpdateReady, ucrsError);
TUpdateCheckResponseStatus = (ucrsNoUpdate, ucrsUpdateReady);
TUpdateCheckResponsePackage = record
ID: string;
NewID: string;
Name: string;
OldVersion, NewVersion: string;
DownloadURL: string;
SavePath: string;
DownloadSize: Integer;
Install: Boolean;
end;
TUpdateCheckResponsePackages = TArray<TUpdateCheckResponsePackage>;
TUpdateCheckResponse = record
private
@ -18,6 +32,8 @@ type
FStatus: TUpdateCheckResponseStatus;
FErrorMessage: string;
FCurrentVersion: string;
FPackages: TUpdateCheckResponsePackages;
function ParseKeyboards(nodes: TJSONObject): Boolean;
public
function Parse(const message: AnsiString; const app, currentVersion: string): Boolean;
@ -27,13 +43,13 @@ type
property InstallSize: Int64 read FInstallSize;
property ErrorMessage: string read FErrorMessage;
property Status: TUpdateCheckResponseStatus read FStatus;
property Packages: TUpdateCheckResponsePackages read FPackages;
end;
implementation
uses
versioninfo,
System.JSON;
versioninfo;
{ TUpdateCheckResponse }
@ -42,12 +58,12 @@ var
node, doc: TJSONObject;
begin
FCurrentVersion := currentVersion;
FStatus := ucrsNoUpdate;
// TODO: test with UTF8 characters in response
doc := TJSONObject.ParseJSONValue(UTF8String(message)) as TJSONObject;
if doc = nil then
begin
FStatus := ucrsError;
FErrorMessage := Format('Invalid response:'#13#10'%s', [string(message)]);
Exit(False);
end;
@ -70,11 +86,32 @@ begin
end
else if doc.Values['message'] <> nil then
begin
FStatus := ucrsError;
FErrorMessage := doc.Values['message'].Value;
end
else
FStatus := ucrsNoUpdate;
Exit(False);
end;
if doc.Values['keyboards'] is TJSONObject
then Result := ParseKeyboards(doc.Values['keyboards'] as TJSONObject)
else Result := True;
end;
function TUpdateCheckResponse.ParseKeyboards(nodes: TJSONObject): Boolean;
var
node: TJSONObject;
i: Integer;
begin
SetLength(FPackages,nodes.Count);
for i := 0 to nodes.Count - 1 do
begin
node := nodes.Pairs[i].JsonValue as TJSONObject;
FPackages[i].NewID := node.Values['id'].Value;
FPackages[i].ID := nodes.Pairs[i].JsonString.Value;
FPackages[i].Name := node.Values['name'].Value;
//FPackages[j].OldVersion := pkg.Version;
FPackages[i].NewVersion := node.Values['version'].Value;
FPackages[i].DownloadSize := (node.Values['packageFileSize'] as TJSONNumber).AsInt64;
FPackages[i].DownloadURL := node.Values['url'].Value;
end;
Result := True;
end;

View file

@ -168,9 +168,7 @@ begin
Proxy.Username := FProxyUsername;
Proxy.Password := FProxyPassword;
Request.Agent := API_UserAgent;
//Request.Protocol := Upload_Protocol;
//Request.HostName := Upload_Server;
Request.SetURL(DownloadUpdate_URL);// UrlPath := URL;
Request.SetURL(DownloadUpdate_URL);
Upload;
if Response.StatusCode = 200 then
begin
@ -357,11 +355,6 @@ begin
Synchronize(SyncShowUpdateForm);
Result := FParams.Result;
end;
ucrsError:
begin
FErrorMessage := ucr.ErrorMessage;
Result := oucFailure;
end;
end;
end
else