mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-05 18:17:45 +02:00
* Allow execution of functions in libraries through a JSON-RPC mechanism
This commit is contained in:
Michael Van Canneyt
parent
2d0fc5940a
commit
5876e535a2
@ -48,6 +48,8 @@ Const
|
||||
cmdLoad = 'load';
|
||||
cmdRun = 'run';
|
||||
cmdExecute = 'execute';
|
||||
cmdRPC = 'rpc';
|
||||
cmdRPCResult = 'rpcResult';
|
||||
|
||||
channelConsole = 'console_output';
|
||||
|
||||
@ -231,6 +233,31 @@ Type
|
||||
Env : TJSObject;
|
||||
end;
|
||||
|
||||
// Sent my main to thread controller worker: load and start a webassembly
|
||||
TWorkerRpcCommand = class external name 'Object' (TWorkerCommand)
|
||||
public
|
||||
method : string;
|
||||
id : string;
|
||||
params : TJSArray;
|
||||
jsonrpc : string;
|
||||
end;
|
||||
|
||||
// Sent my main to thread controller worker: load and start a webassembly
|
||||
TWorkerRPCError = class external name 'Object' (TJSObject)
|
||||
code : integer;
|
||||
message : string;
|
||||
data : JSValue;
|
||||
end;
|
||||
|
||||
TWorkerRpcResultCommand = class external name 'Object' (TWorkerCommand)
|
||||
public
|
||||
method : string;
|
||||
result : jsValue;
|
||||
id : string;
|
||||
error : TWorkerRPCError;
|
||||
jsonrpc : string;
|
||||
end;
|
||||
|
||||
|
||||
{ TWorkerRunCommandHelper }
|
||||
|
||||
@ -239,6 +266,23 @@ Type
|
||||
Class function Create(aThreadID, aArgs : Longint): TWorkerRunCommand; static; reintroduce;
|
||||
end;
|
||||
|
||||
{ TWorkerRpcCommandHelper }
|
||||
|
||||
TWorkerRpcCommandHelper = class helper for TWorkerRpcCommand
|
||||
Class function CommandName : string; static;
|
||||
Class function Create(aID : String; aMethod : String; aParams : TJSArray): TWorkerRpcCommand; static; reintroduce;
|
||||
end;
|
||||
|
||||
{ TWorkerRpcResultCommandHelper }
|
||||
|
||||
TWorkerRpcResultCommandHelper = class helper for TWorkerRpcResultCommand
|
||||
Class function CommandName : string; static;
|
||||
Class function Create(aID : String; aResult : JSValue): TWorkerRpcResultCommand; static; reintroduce;
|
||||
Class function CreateError(aID : String; aCode : Integer; aMessage : string): TWorkerRpcResultCommand; static; reintroduce;
|
||||
Class function CreateError(aID : String; aCode : Integer; aMessage : string; aData : JSValue): TWorkerRpcResultCommand; static; reintroduce;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
// Sent to worker with new range of thread IDs.
|
||||
TWorkerThreadIDRangeCommand = class external name 'Object' (TWorkerCommand)
|
||||
@ -301,6 +345,53 @@ begin
|
||||
Result.Args:=aArgs;
|
||||
end;
|
||||
|
||||
{ TWorkerRpcCommandHelper }
|
||||
|
||||
class function TWorkerRpcCommandHelper.CommandName: string;
|
||||
begin
|
||||
Result:=cmdRpc;
|
||||
end;
|
||||
|
||||
class function TWorkerRpcCommandHelper.Create(aID: String; aMethod: String; aParams: TJSArray): TWorkerRpcCommand;
|
||||
begin
|
||||
Result:=TWorkerRpcCommand(TWorkerCommand.NewWorker(CommandName));
|
||||
Result.id:=aID;
|
||||
Result.Method:=aMethod;
|
||||
Result.Params:=aParams;
|
||||
end;
|
||||
|
||||
{ TWorkerRpcResultCommandHelper }
|
||||
|
||||
class function TWorkerRpcResultCommandHelper.CommandName: string;
|
||||
begin
|
||||
result:=cmdRPCResult;
|
||||
end;
|
||||
|
||||
class function TWorkerRpcResultCommandHelper.Create(aID: String; aResult: JSValue): TWorkerRpcResultCommand;
|
||||
begin
|
||||
Result:=TWorkerRpcResultCommand(TWorkerCommand.NewWorker(CommandName));
|
||||
Result.id:=aID;
|
||||
Result.result:=aResult;
|
||||
Result.jsonrpc:='2.0';
|
||||
end;
|
||||
|
||||
class function TWorkerRpcResultCommandHelper.CreateError(aID: String; aCode: Integer; aMessage: string): TWorkerRpcResultCommand;
|
||||
begin
|
||||
Result:=TWorkerRpcResultCommand(TWorkerCommand.NewWorker(CommandName));
|
||||
Result.Id:=aID;
|
||||
Result.Error:=TWorkerRPCError.New;
|
||||
Result.Error.Code:=aCode;
|
||||
Result.Error.Message:=aMessage;
|
||||
Result.jsonrpc:='2.0';
|
||||
end;
|
||||
|
||||
class function TWorkerRpcResultCommandHelper.CreateError(aID: String; aCode: Integer; aMessage: string; aData: JSValue
|
||||
): TWorkerRpcResultCommand;
|
||||
begin
|
||||
Result:=CreateError(aID,aCode,aMessage);
|
||||
Result.Error.Data:=aData;
|
||||
end;
|
||||
|
||||
{ TWorkerLoadCommandHelper }
|
||||
|
||||
class function TWorkerLoadCommandHelper.CommandName: string;
|
||||
|
||||
@ -118,6 +118,7 @@ Type
|
||||
procedure DoOnSendCommand(Sender : TObject; aCommand : TWorkerCommand);
|
||||
function CreateHost: TWASIHost; virtual; abstract;
|
||||
procedure DoRun; override;
|
||||
procedure DoLog(EventType: TEventType; const Msg: String); override;
|
||||
function GetConsoleApplication: boolean; override;
|
||||
function GetLocation: String; override;
|
||||
property ConsoleChannel : TJSBroadCastChannel Read FConsoleChannel;
|
||||
@ -158,8 +159,8 @@ Type
|
||||
TWorkerThreadRunnerApplication = class(TWorkerWASIHostApplication)
|
||||
Private
|
||||
FThreadSupport : TWorkerThreadSupport;
|
||||
procedure HandleConsoleWrite(Sender: TObject; aOutput: string);
|
||||
Protected
|
||||
procedure HandleConsoleWrite(Sender: TObject; aOutput: string);
|
||||
function CreateHost: TWASIHost; override;
|
||||
procedure HandleMessage(aEvent: TJSEvent); override;
|
||||
procedure ShowException(aError: Exception); override;
|
||||
@ -191,22 +192,26 @@ Type
|
||||
TWorkerThreadControllerApplication = class(TWorkerWASIHostApplication)
|
||||
Private
|
||||
FThreadSupport : TThreadController;
|
||||
procedure HandleConsoleWrite(Sender: TObject; aOutput: string);
|
||||
procedure HandleExecuteCommand(aCmd: TWorkerExecuteCommand);
|
||||
Protected
|
||||
procedure ShowException(aError: Exception); override;
|
||||
procedure HandleConsoleWrite(Sender: TObject; aOutput: string); virtual;
|
||||
procedure HandleExecuteCommand(aCmd: TWorkerExecuteCommand); virtual;
|
||||
procedure HandleRpcCommand(aCmd: TWorkerRpcCommand); virtual;
|
||||
function HandleCustomCommand(aData: TWorkerCommand): Boolean; virtual;
|
||||
procedure HandleMessage(aEvent: TJSEvent); override;
|
||||
function CreateHost: TWASIHost; override;
|
||||
Public
|
||||
procedure ShowException(aError: Exception); override;
|
||||
end;
|
||||
|
||||
function GetJSClassName(aObj : TJSObject) : string;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
{$IFDEF FPC_DOTTEDUNITS}
|
||||
System.Types;
|
||||
System.Types, System.TypInfo;
|
||||
{$ELSE}
|
||||
Types;
|
||||
TypInfo, Types;
|
||||
{$ENDIF}
|
||||
|
||||
var
|
||||
@ -625,6 +630,14 @@ begin
|
||||
Self_.addEventListener('message',@HandleMessage);
|
||||
end;
|
||||
|
||||
procedure TWorkerWASIHostApplication.DoLog(EventType: TEventType; const Msg: String);
|
||||
var
|
||||
S : String;
|
||||
begin
|
||||
S:=GetEnumName(TypeInfo(TEventType),Ord(EventType));
|
||||
ConsoleChannel.PostMessage(TWorkerConsoleCommand.Create(Format('[%s] %s',[S,Msg])));
|
||||
end;
|
||||
|
||||
|
||||
procedure TWorkerWASIHostApplication.DoOnSendCommand(Sender: TObject;
|
||||
aCommand: TWorkerCommand);
|
||||
@ -689,7 +702,6 @@ end;
|
||||
|
||||
procedure TWorkerThreadRunnerApplication.HandleConsoleWrite(Sender: TObject; aOutput: string);
|
||||
begin
|
||||
Writeln('Console write ',aOutput);
|
||||
ConsoleChannel.postMessage(TWorkerConsoleCommand.Create(aOutput));
|
||||
end;
|
||||
|
||||
@ -787,11 +799,69 @@ begin
|
||||
StartWebAssembly(aCmd.Url,True,Nil {@DoPrepare}, Nil)
|
||||
end;
|
||||
|
||||
function GetJSClassName(aObj : TJSObject) : string;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
asm
|
||||
return aObj.constructor.name;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWorkerThreadControllerApplication.HandleRpcCommand(aCmd: TWorkerRpcCommand);
|
||||
|
||||
var
|
||||
res : TWorkerRpcResultCommand;
|
||||
data : JSValue;
|
||||
errClass : String;
|
||||
errMessage : String;
|
||||
|
||||
begin
|
||||
if aCmd.Id='' then
|
||||
Res:=TWorkerRpcResultCommand.CreateError(aCmd.id,-32600,'Invalid request: No json-rpc ID')
|
||||
else if aCmd.jsonrpc<>'2.0' then
|
||||
Res:=TWorkerRpcResultCommand.CreateError(aCmd.id,-32600,'Invalid request: no jsonrpc version')
|
||||
else if Not Assigned(Exported.functions[aCmd.method]) then
|
||||
Res:=TWorkerRpcResultCommand.CreateError(aCmd.id,-32601,'Method "'+aCmd.method+'" not found')
|
||||
else
|
||||
begin
|
||||
try
|
||||
if isArray(aCmd.Params) then
|
||||
data:=Exported.functions[aCmd.method].Apply(nil,TJSValueDynArray(aCmd.Params))
|
||||
else
|
||||
data:=Exported.functions[aCmd.method].call(nil);
|
||||
Res:=TWorkerRpcResultCommand.Create(aCmd.id,Data);
|
||||
except
|
||||
on JE : TJSError do
|
||||
begin
|
||||
errClass:=GetJSClassName(JE);
|
||||
errMessage:=JE.message;
|
||||
end;
|
||||
on E : Exception do
|
||||
begin
|
||||
errClass:=E.ClassName;
|
||||
errMessage:=E.Message;
|
||||
end;
|
||||
end;
|
||||
if not assigned(Res) then
|
||||
Res:=TWorkerRpcResultCommand.CreateError(aCmd.id,-32603,'Exception '+ErrClass+' while executing "'+aCmd.method+'" : '+ErrMessage);
|
||||
end;
|
||||
Self_.postMessage(Res);
|
||||
end;
|
||||
|
||||
procedure TWorkerThreadControllerApplication.HandleConsoleWrite(Sender: TObject; aOutput: string);
|
||||
begin
|
||||
FConsoleChannel.postMessage(TWorkerConsoleCommand.Create(aOutput,0));
|
||||
end;
|
||||
|
||||
function TWorkerThreadControllerApplication.HandleCustomCommand(aData : TWorkerCommand) : Boolean;
|
||||
|
||||
begin
|
||||
if not Assigned(aData) then
|
||||
Exit(True);
|
||||
Result:=False;
|
||||
end;
|
||||
|
||||
procedure TWorkerThreadControllerApplication.HandleMessage(aEvent: TJSEvent);
|
||||
|
||||
var
|
||||
@ -804,7 +874,9 @@ begin
|
||||
aData:=TWorkerCommand(aMessageEvent.Data);
|
||||
case aData.Command of
|
||||
cmdExecute : HandleExecuteCommand(TWorkerExecuteCommand(aData));
|
||||
cmdRpc : HandleRPCCommand(TWorkerRpcCommand(aData));
|
||||
else
|
||||
if not HandleCustomCommand(aData) then
|
||||
FThreadSupport.HandleCommand(aData);
|
||||
end;
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user