|
@@ -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.
|
|
|
+
|