Browse Source

* Webassembly websocket support and demo

Michaël Van Canneyt 11 months ago
parent
commit
51fdff0e7f

+ 24 - 0
packages/wasm-utils/demo/README.md

@@ -0,0 +1,24 @@
+# Assorted Webassembly utility routine demos
+
+For the HTTP and Websocket demos, you need also the corresponding host application
+which will load the demo and provide the needed APIs
+
+They are contained in the Pas2JS demos under 
+```
+demos/wasienv/wasm-http 
+```
+
+and
+
+```
+demos/wasienv/wasm-websocket
+```
+
+respectively.
+
+For the websocket demo, additionally the websocket server program in
+```
+packages/fcl-web/examples/websocket/server
+```
+is needed, since this is the websocket server that the demo program will
+connect to.

+ 68 - 0
packages/wasm-utils/demo/websocket/wasmwebsocketdemo.lpi

@@ -0,0 +1,68 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="Webassembly Websocket Support Demo"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="wasmwebsocketdemo.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="wasmwebsocketdemo.wasm" ApplyConventions="False"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../../src"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Subtarget Value="browser"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="False"/>
+      </Debugging>
+      <Options>
+        <ExecutableType Value="Library"/>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 116 - 0
packages/wasm-utils/demo/websocket/wasmwebsocketdemo.pp

@@ -0,0 +1,116 @@
+library wasmwebsocketdemo;
+
+uses fpjson, jsonparser, basenenc, sysutils, wasm.websocket.api, wasm.websocket.shared, wasm.websocket.objects;
+
+Type
+
+  { TApplication }
+
+  TApplication = class(TObject)
+  Private
+    FWS : TWasmWebsocket;
+    procedure HandleError(Sender: TObject);
+    procedure HandleMessage(Sender: TObject; const IsString: Boolean; aPayload: TBytes);
+    procedure HandleOpen(Sender: TObject);
+    procedure HandleClose(Sender: TObject; aCode : Integer; const aReason : String; aIsClean : Boolean);
+    procedure HandleWebsocketLog(Level: TWasmWebSocketLogLevel; const Msg: string);
+  Public
+    Procedure Run;
+    Property WS : TWasmWebSocket Read FWS;
+  end;
+
+var
+  Application : TApplication;
+
+procedure sendmessage(buf : PByte; Len : Longint);
+
+var
+  Msg : UTF8String;
+
+begin
+  SetLength(Msg,Len);
+  Move(Buf^,Msg[1],Len);
+  Application.FWS.SendMessage(Msg);
+end;
+
+exports sendmessage;
+
+procedure TApplication.HandleOpen(Sender: TObject);
+begin
+  Writeln('Websocket is opened');
+end;
+
+procedure TApplication.HandleClose(Sender: TObject; aCode : Integer; const aReason : String; aIsClean : Boolean);
+
+const
+  SClean : Array[Boolean] of string = ('not ','');
+
+begin
+  Writeln('Websocket closed ',SClean[aIsClean],'cleanly with code ',aCode,', reason: "',aReason,'"');
+end;
+
+procedure TApplication.HandleWebsocketLog(Level: TWasmWebSocketLogLevel; const Msg: string);
+begin
+  Writeln('(Websocket Log) [', Level,']: ',Msg);
+end;
+
+procedure TApplication.HandleError(Sender: TObject);
+begin
+  Writeln('Error detected on websocket.');
+end;
+
+procedure TApplication.HandleMessage(Sender: TObject; const IsString: Boolean; aPayload: TBytes);
+
+var
+  Msg,lfrom,lRecip : String;
+  D : TJSONData;
+  O : TJSONObject absolute D;
+
+begin
+  if IsString then
+    begin
+    Msg:=TEncoding.UTF8.GetAnsiString(aPayLoad);
+    D:=Nil;
+    try
+      D:=GetJSON(Msg,True);
+    except
+      on E : Exception do
+        Writeln('Received non-JSON message: '+Msg);
+    end;
+    if D is TJSONObject then
+      begin
+      lFrom:=O.get('from','(unknown)');
+      lRecip:=O.get('recip','');
+      msg:=O.get('msg','');
+      if lRecip<>'' then
+        lFrom:=lFrom+' [PM]';
+      Writeln(lFrom,' > ',Msg);
+      end
+    else
+      Writeln('Received invalid JSON message: '+Msg);
+    end
+  else
+    begin
+    Msg:=Base64.Encode(aPayload);
+    Writeln('Received binary message : ',Msg);
+    end;
+end;
+
+Procedure TApplication.Run;
+
+begin
+  FWS:=TWasmWebsocket.Create(Nil);
+  OnWebsocketLog:=@HandleWebsocketLog;
+  WS.OnOpen:=@HandleOpen;
+  WS.OnError:=@HandleError;
+  WS.OnClose:=@HandleClose;
+  WS.OnMessage:=@HandleMessage;
+  WS.Open('ws://localhost:6060/','');
+  Writeln('Websocket opened, waiting for messages');
+end;
+
+begin
+  Application:=TApplication.Create;
+  Application.Run;
+end.
+

+ 9 - 0
packages/wasm-utils/fpmake.pp

@@ -34,6 +34,15 @@ begin
     T:=P.Targets.AddUnit('wasm.http.objects.pas');
     T:=P.Targets.AddUnit('wasm.http.objects.pas');
       T.Dependencies.AddUnit('wasm.http.api');
       T.Dependencies.AddUnit('wasm.http.api');
       T.Dependencies.AddUnit('wasm.http.shared');
       T.Dependencies.AddUnit('wasm.http.shared');
+
+    T:=P.Targets.AddUnit('wasm.websocket.shared.pas');
+    T:=P.Targets.AddUnit('wasm.websocket.api.pas');
+      T.Dependencies.AddUnit('wasm.websocket.shared');
+      
+    T:=P.Targets.AddUnit('wasm.websocket.objects.pas');
+      T.Dependencies.AddUnit('wasm.websocket.api');
+      T.Dependencies.AddUnit('wasm.websocket.shared');
+      
 {$ifndef ALLPACKAGES}
 {$ifndef ALLPACKAGES}
     Run;
     Run;
     end;
     end;

+ 221 - 0
packages/wasm-utils/src/wasm.websocket.api.pas

@@ -0,0 +1,221 @@
+{
+    This file is part of the Free Component Library
+
+    Webassembly Websocket API - imported functions and structures.
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit wasm.websocket.api;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.SysUtils,
+  {$ELSE}
+  sysutils,
+  {$ENDIF}
+  wasm.websocket.shared;
+
+Type
+  TWasmWebSocketLogLevel = (wllTrace, wllDebug, wllInfo, wllWarning, wllError, wllCritical);
+  TWasmWebSocketLogLevels = set of TWasmWebsocketLogLevel;
+
+function __wasm_websocket_allocate(
+    aURL : PByte;
+    aUrlLen : Longint;
+    aProtocols : PByte;
+    aProtocolLen : Longint;
+    aUserData : Pointer;
+    aWebsocketID : PWasmWebSocketID) : TWasmWebsocketResult; external websocketExportName name websocketFN_Allocate;
+
+function __wasm_websocket_close(
+    aWebsocketID : TWasmWebSocketID;
+    aCode : Longint;
+    aReason : PByte;
+    aReasonLen : Longint) : TWasmWebsocketResult; external websocketExportName name websocketFN_Close;
+
+function __wasm_websocket_send(
+    aWebsocketID : TWasmWebSocketID;
+    aData : PByte;
+    aDataLen : Longint;
+    aType : Longint
+    ) : TWasmWebsocketResult; external websocketExportName name websocketFN_Send;
+
+function __wasm_websocket_deallocate(
+    aWebsocketID : TWasmWebSocketID) : TWasmWebsocketResult; external websocketExportName name websocketFN_DeAllocate;
+
+
+Type
+  TWasmWebsocketErrorCallback = procedure(aWebSocketID : TWasmWebSocketID; aUserData : Pointer);
+  TWasmWebsocketMessageCallback = procedure(aWebSocketID : TWasmWebSocketID; aUserData : Pointer; aMessageType : TWasmWebSocketMessageType; aMessage : TBytes);
+  TWasmWebsocketCloseCallback = procedure(aWebSocketID : TWasmWebSocketID; aUserData : Pointer; aCode: Longint; const aReason : String; aClean : Boolean);
+  TWasmWebsocketOpenCallback = procedure(aWebSocketID : TWasmWebSocketID; aUserData : Pointer);
+  TWasmWebsocketLogHook = procedure (Level : TWasmWebSocketLogLevel; const Msg : string) of object;
+
+// Callee is responsible for freeing incoming buffers
+Function __wasm_websocket_allocate_buffer(aWebsocketID : TWasmWebSocketID; aUserData : Pointer; aBufferLen : Longint) : Pointer;
+Function __wasm_websocket_on_error (aWebsocketID : TWasmWebSocketID; aUserData : Pointer) : TWebsocketCallBackResult;
+Function __wasm_websocket_on_message (aWebsocketID : TWasmWebSocketID; aUserData : Pointer; aMessageType : TWasmWebSocketMessageType; aMessage : Pointer; aMessageLen : Integer) : TWebsocketCallBackResult;
+Function __wasm_websocket_on_open (aWebsocketID : TWasmWebSocketID; aUserData : Pointer) : TWebsocketCallBackResult;
+Function __wasm_websocket_on_close (aWebsocketID : TWasmWebSocketID; aUserData : Pointer; aCode: Longint; aReason : PByte; aReasonLen : Longint; aClean : Longint) : TWebsocketCallBackResult;
+
+
+procedure __wasmwebsocket_log(level : TWasmWebsocketLogLevel; const Msg : String);
+procedure __wasmwebsocket_log(level : TWasmWebSocketLogLevel; const Fmt : String; Args : Array of const);
+
+var
+  WebSocketErrorCallback : TWasmWebsocketErrorCallback;
+  WebSocketMessageCallback : TWasmWebsocketMessageCallback;
+  WebSocketCloseCallback : TWasmWebsocketCloseCallback;
+  WebSocketOpenCallback : TWasmWebsocketOpenCallback;
+  OnWebsocketLog : TWasmWebsocketLogHook;
+
+implementation
+
+procedure __wasmwebsocket_log(level : TWasmWebSocketLogLevel; const Msg : String);
+
+begin
+  if assigned(OnWebsocketLog) then
+    OnWebSocketLog(level,msg)
+end;
+
+procedure __wasmwebsocket_log(level : TWasmWebSocketLogLevel; const Fmt : String; Args : Array of const);
+
+begin
+  if assigned(OnWebsocketLog) then
+    OnWebSocketLog(level,SafeFormat(Fmt,Args));
+end;
+
+
+Function __wasm_websocket_allocate_buffer(aWebsocketID : TWasmWebSocketID; aUserData : Pointer; aBufferLen : Longint) : Pointer;
+
+begin
+  Result:=GetMem(aBufferLen);
+end;
+
+procedure LogError(const aOperation : String; aError : Exception);
+
+begin
+  __wasmwebsocket_log(wllError,SafeFormat('Error %s during %s callback: %s',[aError.ClassName,aError.Message]));
+end;
+
+Function __wasm_websocket_on_error (aWebsocketID : TWasmWebSocketID; aUserData : Pointer) : TWebsocketCallBackResult;
+
+var
+  lErr : String;
+  Buf : TBytes;
+
+begin
+    if not assigned(WebSocketErrorCallback) then
+      Exit(WASMWS_CALLBACK_NOHANDLER);
+    try
+      WebsocketErrorCallBack(aWebsocketID,aUserData);
+      Result:=WASMWS_CALLBACK_SUCCESS;
+    except
+      On E : exception do
+        begin
+        LogError('error',E);
+        Result:=WASMWS_CALLBACK_ERROR;
+        end;
+    end;
+end;
+
+Function __wasm_websocket_on_message (aWebsocketID : TWasmWebSocketID; aUserData : Pointer; aMessageType : TWasmWebSocketMessageType; aMessage : Pointer; aMessageLen : Integer) : TWebsocketCallBackResult;
+
+var
+  Buf : TBytes;
+
+begin
+  try
+    if not assigned(WebSocketMessageCallback) then
+      Exit(WASMWS_CALLBACK_NOHANDLER);
+    try
+      SetLength(Buf,aMessageLen);
+      if aMessageLen>0 then
+        Move(aMessage^,Buf[0],aMessageLen);
+      WebsocketMessageCallBack(aWebsocketID,aUserData,aMessageType,Buf);
+      Result:=WASMWS_CALLBACK_SUCCESS;
+    except
+      On E : exception do
+        begin
+        LogError('message',E);
+        Result:=WASMWS_CALLBACK_ERROR;
+        end;
+    end;
+  finally
+    FreeMem(aMessage);
+  end;
+end;
+
+Function __wasm_websocket_on_open (aWebsocketID : TWasmWebSocketID; aUserData : Pointer) : TWebsocketCallBackResult;
+
+begin
+  if not assigned(WebSocketOpenCallback) then
+    Exit(WASMWS_CALLBACK_NOHANDLER);
+  try
+    WebsocketOpenCallBack(aWebsocketID,aUserData);
+    Result:=WASMWS_CALLBACK_SUCCESS;
+  except
+    On E : exception do
+      begin
+      LogError('message',E);
+      Result:=WASMWS_CALLBACK_ERROR;
+      end;
+  end;
+end;
+
+Function __wasm_websocket_on_close (aWebsocketID : TWasmWebSocketID; aUserData : Pointer; aCode: Longint; aReason : PByte; aReasonLen : Longint; aClean : Longint) : TWebsocketCallBackResult;
+
+var
+  lReason : String;
+  Buf : TBytes;
+  lClean : Boolean;
+
+begin
+  try
+    if not assigned(WebSocketCloseCallback) then
+      Exit(WASMWS_CALLBACK_NOHANDLER);
+    try
+      lClean:=(aClean=0);
+      SetLength(Buf,aReasonLen);
+      Move(aReason^,Buf[0],aReasonLen);
+      {$IF SIZEOF(CHAR)=1}
+      lReason:=TEncoding.UTF8.GetAnsiString(Buf);
+      {$ELSE}
+      lReason:=TEncoding.UTF8.GetString(Buf);
+      {$ENDIF}
+      WebsocketCloseCallBack(aWebsocketID,aUserData,aCode,lReason,lClean);
+      Result:=WASMWS_CALLBACK_SUCCESS;
+    except
+      On E : exception do
+        begin
+        LogError('message',E);
+        Result:=WASMWS_CALLBACK_ERROR;
+        end;
+    end;
+  finally
+    FreeMem(aReason);
+  end;
+end;
+
+exports
+  __wasm_websocket_allocate_buffer,
+  __wasm_websocket_on_error,
+  __wasm_websocket_on_message,
+  __wasm_websocket_on_open,
+  __wasm_websocket_on_close;
+
+
+end.
+

+ 350 - 0
packages/wasm-utils/src/wasm.websocket.objects.pas

@@ -0,0 +1,350 @@
+{
+    This file is part of the Free Component Library
+
+    Webassembly Websocket - Simple objects around the low-level API
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit wasm.websocket.objects;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.Classes, System.SysUtils, wasm.websocket.api, wasm.websocket.shared;
+  {$ELSE}
+  Classes, SysUtils, wasm.websocket.api, wasm.websocket.shared;
+  {$ENDIF}
+
+Type
+  EWasmWebsocket = Class(Exception);
+  TWasmWebSocketManager = Class;
+  TWasmWebsocket = Class;
+
+  TWasmWebSocketManagerClass = Class of TWasmWebSocketManager;
+  TWasmWebSocketClass = Class of TWasmWebsocket;
+
+  TWasmWebsocketErrorEvent = procedure(Sender : TObject) of object;
+  TWasmWebsocketMessageEvent = procedure(Sender : TObject; const IsString : Boolean; aPayload : TBytes) of object;
+  TWasmWebsocketOpenEvent = procedure(Sender : TObject) of object;
+  TWasmWebsocketCloseEvent = procedure(Sender : TObject; aCode : Integer; const aReason : string; aClean : Boolean) of object;
+
+  { TWasmWebsocket }
+
+  TWasmWebsocket = class(TComponent)
+  private
+    FOnClose: TWasmWebsocketCloseEvent;
+    FOnError: TWasmWebsocketErrorEvent;
+    FOnMessage: TWasmWebsocketMessageEvent;
+    FOnOpen: TWasmWebsocketOpenEvent;
+    FProtocols: String;
+    FURL: String;
+    FWebSocketID: TWasmWebSocketID;
+    FClosed : Boolean;
+    procedure DoSendMessage(aBytes: TBytes; aType: longint);
+  Protected
+    procedure CheckWebsocketRes(aResult: TWasmWebsocketResult; const aMsg: String; aLogOnly: Boolean=false);
+    Procedure DoOpen(const aURL : String; const aProtocols : String); virtual;
+    Procedure DoClose(aCode : Longint; aReason: UTF8String; aRaiseError : Boolean); virtual;
+    // Called from host
+    Procedure HandleError; virtual;
+    procedure HandleOpen; virtual;
+    procedure HandleMessage(aType : Longint; aMessage : TBytes); virtual;
+    procedure HandleClose(aCode : Longint; aReason : string; aIsClean : Boolean); virtual;
+
+  Public
+    Constructor create(aOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure Open(const aURL : String; const aProtocols : String);
+    Procedure Close(aCode : Longint; aReason: UTF8String);
+    Procedure SendMessage(aBytes : TBytes);
+    Procedure SendMessage(const aString : String);
+    Property WebSocketID : TWasmWebSocketID Read FWebSocketID;
+    Property OnError : TWasmWebsocketErrorEvent Read FOnError Write FOnError;
+    Property OnMessage : TWasmWebsocketMessageEvent Read FOnMessage Write FOnMessage;
+    Property OnClose : TWasmWebsocketCloseEvent Read FOnClose Write FOnClose;
+    Property OnOpen : TWasmWebsocketOpenEvent Read FOnOpen Write FOnOpen;
+    Property URL : String Read FURL;
+    Property Protocols : String Read FProtocols;
+  end;
+
+  { TWasmWebSocketManager }
+  TWasmWebSocketManager = class(TObject)
+  private
+    class var _Instance : TWasmWebSocketManager;
+    class function GetInstance: TWasmWebSocketManager; static;
+  private
+    Flist : TFPList; // Todo: change to thread list.
+  protected
+    class procedure HandleClose(aWebSocketID: TWasmWebSocketID; aUserData: Pointer; aCode: Longint; const aReason: String; aClean: Boolean); static;
+    class procedure HandleError(aWebSocketID: TWasmWebSocketID; aUserData: Pointer); static;
+    class procedure HandleMessage(aWebSocketID: TWasmWebSocketID; aUserData: Pointer; aMessageType: TWasmWebSocketMessageType;  aMessage: TBytes); static;
+    class procedure HandleOpen(aWebSocketID: TWasmWebSocketID; aUserData: Pointer); static;
+    procedure RegisterWebSocket(aWebSocket : TWasmWebSocket);
+    procedure UnRegisterWebSocket(aWebSocket : TWasmWebSocket);
+    function IsValidWebSocket(aWebSocketID: TWasmWebSocketID; aUserData: Pointer) : Boolean;
+  Public
+    class constructor init;
+    constructor create; virtual;
+    destructor destroy; override;
+    class var DefaultInstanceType : TWasmWebSocketManagerClass;
+    Class Property Instance : TWasmWebSocketManager Read GetInstance;
+  end;
+
+implementation
+
+{ TWasmWebsocket }
+
+constructor TWasmWebsocket.create(aOwner : TComponent);
+
+begin
+  Inherited;
+  TWasmWebSocketManager.Instance.RegisterWebSocket(Self);
+  FClosed:=False
+end;
+
+
+procedure TWasmWebsocket.DoClose(aCode: Longint; aReason: UTF8String; aRaiseError: Boolean);
+
+var
+  Res : TWasmWebsocketResult;
+
+begin
+  if FWebSocketID=0 then
+    exit;
+  Res:=__wasm_websocket_close(FWebSocketID,aCode,PByte(PAnsiChar(aReason)),Length(aReason));
+  CheckWebsocketRes(Res,'close',not aRaiseError);
+end;
+
+
+procedure TWasmWebsocket.HandleError;
+begin
+  if assigned(FonError) then
+    FOnError(Self);
+end;
+
+
+procedure TWasmWebsocket.HandleOpen;
+begin
+  if assigned(FonOpen) then
+    FOnOpen(Self);
+end;
+
+
+procedure TWasmWebsocket.HandleMessage(aType: Longint; aMessage: TBytes);
+begin
+  if assigned(FOnMessage) then
+    FOnMessage(Self,aType=WASMWS_MESSAGE_TYPE_TEXT,aMessage);
+end;
+
+
+procedure TWasmWebsocket.HandleClose(aCode: Longint; aReason: string; aIsClean: Boolean);
+begin
+  FClosed:=True;
+  if assigned(FonClose) then
+    FOnClose(Self,aCode,aReason,aIsClean);
+end;
+
+
+procedure TWasmWebsocket.DoOpen(const aURL: String; const aProtocols: String);
+
+var
+  lURL,lProtocols : UTF8String;
+
+begin
+  FURL:=aURL;
+  FProtocols:=aProtocols;
+  lURL:=UTF8Encode(aURL);
+  lProtocols:=UTF8Encode(aProtocols);
+  if __wasm_websocket_allocate(PByte(lURL),Length(lURL),PByte(lProtocols),Length(lProtocols),Self,@FWebSocketID)<>WASMWS_RESULT_SUCCESS then
+    Raise EWasmWebsocket.CreateFmt('Failed to allocate websocket for URL %s',[aURL]);
+end;
+
+
+destructor TWasmWebsocket.Destroy;
+
+var
+  Res : TWasmWebsocketResult;
+
+begin
+  if not FClosed then
+    DoClose(0,'',False);
+  res:=__wasm_websocket_deallocate(FWebSocketID);
+  CheckWebsocketRes(Res,'Deallocating websocket',True);
+  FWebSocketID:=0;
+  TWasmWebSocketManager.Instance.UnRegisterWebSocket(Self);
+  inherited Destroy;
+end;
+
+
+procedure TWasmWebsocket.Open(const aURL: String; const aProtocols: String);
+begin
+  DoOpen(aURL,aProtocols);
+end;
+
+
+procedure TWasmWebsocket.Close(aCode: Longint; aReason: UTF8String);
+
+begin
+  DoClose(aCode,aReason,True);
+  FClosed:=True;
+end;
+
+
+procedure TWasmWebsocket.CheckWebsocketRes(aResult : TWasmWebsocketResult; const aMsg :String; aLogOnly : Boolean = false);
+
+var
+  Err : String;
+
+begin
+  if aResult=WASMWS_RESULT_SUCCESS then
+    Exit;
+  Err:=Format('Websocket %d (URL: %s) got error %d: %s',[FWebSocketID,FURL,aResult,aMsg]);
+  __wasmwebsocket_log(wllError,Err);
+  if not aLogOnly then
+    Raise EWasmWebsocket.Create(Err);
+end;
+
+
+procedure TWasmWebsocket.DoSendMessage(aBytes: TBytes; aType : longint);
+
+const
+  aTypes : Array[Boolean] of string = ('binary','text');
+
+var
+  Res : TWasmWebsocketResult;
+  DataLen : Longint;
+
+begin
+  DataLen:=Length(aBytes);
+  if DataLen=0 then
+    exit;
+  Res:=__wasm_websocket_send(FWebsocketID,PByte(aBytes),DataLen,aType);
+  CheckWebsocketRes(Res,'Failed to send '+aTypes[aType=WASMWS_MESSAGE_TYPE_TEXT]+' data on websocket');
+end;
+
+
+procedure TWasmWebsocket.SendMessage(aBytes: TBytes);
+
+begin
+  DoSendMessage(aBytes,WASMWS_MESSAGE_TYPE_BINARY);
+end;
+
+
+procedure TWasmWebsocket.SendMessage(const aString: String);
+
+var
+  Res : TWasmWebsocketResult;
+  Buf : TBytes;
+
+begin
+  if Length(aString)=0 then
+    exit;
+  {$IF SIZEOF(CHAR)=1}
+  Buf:=TEncoding.UTF8.GetAnsiBytes(aString);
+  {$ELSE}
+  Buf:=TEncoding.UTF8.GetBytes(aString);
+  {$ENDIF}
+  DoSendMessage(Buf,WASMWS_MESSAGE_TYPE_TEXT);
+end;
+
+{ TWasmWebSocketManager }
+
+class function TWasmWebSocketManager.GetInstance: TWasmWebSocketManager; static;
+
+var
+  C : TWasmWebSocketManagerClass;
+
+begin
+  if _instance=nil then
+    begin
+    C:=DefaultInstanceType;
+    if C=Nil then C:=TWasmWebSocketManager;
+    _instance:=TWasmWebSocketManager.Create;
+    end;
+end;
+
+
+procedure TWasmWebSocketManager.RegisterWebSocket(aWebSocket: TWasmWebSocket);
+begin
+  Writeln(Format('adding websocket [%p]',[Pointer(aWebSocket)]));
+  Flist.Add(aWebSocket);
+end;
+
+
+procedure TWasmWebSocketManager.UnRegisterWebSocket(aWebSocket: TWasmWebSocket);
+begin
+  Flist.Remove(aWebSocket);
+end;
+
+
+function TWasmWebSocketManager.IsValidWebSocket(aWebSocketID: TWasmWebSocketID; aUserData: Pointer): Boolean;
+begin
+  Result:=FList.IndexOf(aUserData)<>-1;
+  If Result then
+    Result:=TWasmWebSocket(aUserData).WebSocketID=aWebSocketID;
+  if not Result then
+    __wasmwebsocket_log(wllError,'Invalid websocket received: %d [%p]',[aWebsocketID,aUserData]);
+end;
+
+
+class procedure TWasmWebSocketManager.HandleError(aWebSocketID : TWasmWebSocketID; aUserData : Pointer);
+begin
+  If Instance.IsValidWebSocket(aWebSocketID,aUserData) then
+    TWasmWebSocket(aUserData).HandleError;
+end;
+
+
+class procedure TWasmWebSocketManager.HandleMessage(aWebSocketID : TWasmWebSocketID; aUserData : Pointer; aMessageType : TWasmWebSocketMessageType; aMessage : TBytes);
+begin
+  If Instance.IsValidWebSocket(aWebSocketID,aUserData) then
+    TWasmWebSocket(aUserData).HandleMessage(aMessageType,aMessage);
+end;
+
+
+class procedure TWasmWebSocketManager.HandleClose(aWebSocketID : TWasmWebSocketID; aUserData : Pointer; aCode: Longint; const aReason : String; aClean : Boolean);
+begin
+  If Instance.IsValidWebSocket(aWebSocketID,aUserData) then
+    TWasmWebSocket(aUserData).HandleClose(aCode,aReason,aClean)
+end;
+
+
+class procedure TWasmWebSocketManager.HandleOpen(aWebSocketID : TWasmWebSocketID; aUserData : Pointer);
+begin
+  If Instance.IsValidWebSocket(aWebSocketID,aUserData) then
+    TWasmWebSocket(aUserData).HandleOpen;
+end;
+
+class constructor TWasmWebSocketManager.init;
+begin
+  WebSocketErrorCallback:=@HandleError;
+  WebSocketMessageCallback:=@HandleMessage;
+  WebSocketCloseCallback:=@HandleClose;
+  WebSocketOpenCallback:=@HandleOpen;
+end;
+
+
+constructor TWasmWebSocketManager.create;
+begin
+  Flist:=TFPList.Create;
+end;
+
+
+destructor TWasmWebSocketManager.destroy;
+begin
+  FreeAndNil(Flist);
+  inherited destroy;
+end;
+
+
+end.
+

+ 68 - 0
packages/wasm-utils/src/wasm.websocket.shared.pas

@@ -0,0 +1,68 @@
+{
+    This file is part of the Free Component Library
+
+    Webassembly Websocket API - Definitions shared with host implementation.
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit wasm.websocket.shared;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.SysUtils;
+  {$ELSE}
+  sysutils;
+  {$ENDIF}
+
+Type
+  TWasmWebsocketResult = longint;
+  TWasmWebsocketID = longint;
+  TBuffer = longint;
+  TWasmWebSocketMessageType = Longint;
+  TWebsocketCallBackResult = Longint;
+
+  {$IFNDEF PAS2JS}
+  PWasmWebSocketID = ^TWasmWebsocketID;
+  {$ELSE}
+  TWasmPointer = longint;
+
+  PByte = TWasmPointer;
+  PWasmWebSocketID = TWasmPointer;
+  {$endif}
+
+Const
+  WASMWS_RESULT_SUCCESS   = 0;
+  WASMWS_RESULT_ERROR     = -1;
+  WASMWS_RESULT_NO_URL    = -2;
+  WASMWS_RESULT_INVALIDID = -3;
+
+  WASMWS_CALLBACK_SUCCESS   = 0;
+  WASMWS_CALLBACK_NOHANDLER = -1;
+  WASMWS_CALLBACK_ERROR     = -2;
+
+  WASMWS_MESSAGE_TYPE_TEXT   = 0;
+  WASMWS_MESSAGE_TYPE_BINARY = 1;
+
+const
+  websocketExportName  = 'websocket';
+  websocketFN_Allocate = 'allocate';
+  websocketFN_DeAllocate = 'deallocate';
+  websocketFN_close = 'close';
+  websocketFN_send = 'send';
+
+
+implementation
+
+end.
+