From 5876e535a2c21ec629c51bd17ab6dc983797b676 Mon Sep 17 00:00:00 2001 From: Michael Van Canneyt Date: Thu, 7 Nov 2024 17:52:54 +0100 Subject: [PATCH] * Allow execution of functions in libraries through a JSON-RPC mechanism --- packages/wasi/src/rtl.webthreads.pas | 91 ++++++++++++++++++++++ packages/wasi/src/wasiworkerthreadhost.pas | 88 +++++++++++++++++++-- 2 files changed, 171 insertions(+), 8 deletions(-) diff --git a/packages/wasi/src/rtl.webthreads.pas b/packages/wasi/src/rtl.webthreads.pas index 5db09a6..eb23001 100644 --- a/packages/wasi/src/rtl.webthreads.pas +++ b/packages/wasi/src/rtl.webthreads.pas @@ -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; diff --git a/packages/wasi/src/wasiworkerthreadhost.pas b/packages/wasi/src/wasiworkerthreadhost.pas index 060af41..995279d 100644 --- a/packages/wasi/src/wasiworkerthreadhost.pas +++ b/packages/wasi/src/wasiworkerthreadhost.pas @@ -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,8 +874,10 @@ begin aData:=TWorkerCommand(aMessageEvent.Data); case aData.Command of cmdExecute : HandleExecuteCommand(TWorkerExecuteCommand(aData)); + cmdRpc : HandleRPCCommand(TWorkerRpcCommand(aData)); else - FThreadSupport.HandleCommand(aData); + if not HandleCustomCommand(aData) then + FThreadSupport.HandleCommand(aData); end; end; end;