mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 22:49:23 +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:=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
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