mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 15:49:26 +02:00
* Webassembly websocket support and demo
This commit is contained in:
Michaël Van Canneyt
parent
27fd290150
commit
51fdff0e7f
24
packages/wasm-utils/demo/README.md
Normal file
24
packages/wasm-utils/demo/README.md
Normal file
@ -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
packages/wasm-utils/demo/websocket/wasmwebsocketdemo.lpi
Normal file
68
packages/wasm-utils/demo/websocket/wasmwebsocketdemo.lpi
Normal file
@ -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
packages/wasm-utils/demo/websocket/wasmwebsocketdemo.pp
Normal file
116
packages/wasm-utils/demo/websocket/wasmwebsocketdemo.pp
Normal file
@ -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.
|
||||
|
||||
@ -34,6 +34,15 @@ begin
|
||||
T:=P.Targets.AddUnit('wasm.http.objects.pas');
|
||||
T.Dependencies.AddUnit('wasm.http.api');
|
||||
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}
|
||||
Run;
|
||||
end;
|
||||
|
||||
221
packages/wasm-utils/src/wasm.websocket.api.pas
Normal file
221
packages/wasm-utils/src/wasm.websocket.api.pas
Normal file
@ -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 michael@freepascal.org
|
||||
|
||||
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
packages/wasm-utils/src/wasm.websocket.objects.pas
Normal file
350
packages/wasm-utils/src/wasm.websocket.objects.pas
Normal file
@ -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 michael@freepascal.org
|
||||
|
||||
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
packages/wasm-utils/src/wasm.websocket.shared.pas
Normal file
68
packages/wasm-utils/src/wasm.websocket.shared.pas
Normal file
@ -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 michael@freepascal.org
|
||||
|
||||
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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user