mORMot2
mORMot2 copied to clipboard
synopse
HttpApiWebSocketServer 'WebSocket API not supported'
I'm using Windows 11 with FPC 3.2.2 and I have the mORMot v1 example Project31WinHTTPEchoServer working.
Now I'm trying to adapt it to oORMot2 by doing the following:
uses
{$I mormot.uses.inc} // use FastMM4 on older versions of Delphi
sysutils,
mormot.core.base,
mormot.core.os,
mormot.core.zip,
mormot.lib.winhttp,
mormot.net.server,
mormot.net.http;
...
{ TSimpleWebsocketServer }
constructor TSimpleWebsocketServer.Create;
begin
fServer := THttpApiWebSocketServer.Create;
fServer.AddUrl('','8888', False, '127.0.0.1');
fServer.AddUrlWebSocket('whatever', '8888', False, '127.0.0.1');
fServer.RegisterProtocol('meow', False, onAccept, onMessage, onConnect, onDisconnect);
fServer.RegisterCompress(CompressDeflate);
fServer.OnRequest := onHttpRequest;
end;
...
It compiles OK, but when I run it, it shows:
EWebSocketApi: WebSocket API not supported
This is located inside the unit mormot.net.server:
constructor THttpApiWebSocketServer.Create
if not (WebSocketApi.WebSocketEnabled) then
raise EWebSocketApi.Create('WebSocket API not supported');
I would appreciate any help you can provide to resolve this.
Click to expand the full code
program restws_winhttpechoserver;
{$I mormot.defines.inc}
{$ifdef OSWINDOWS}
{$APPTYPE CONSOLE}
{$endif OSWINDOWS}
uses
{$I mormot.uses.inc} // use FastMM4 on older versions of Delphi
sysutils,
mormot.core.base,
mormot.core.os,
mormot.core.zip,
mormot.lib.winhttp,
mormot.net.server,
mormot.net.http;
type
TSimpleWebsocketServer = class
private
fServer: THttpApiWebSocketServer;
function onHttpRequest(Ctxt: THttpServerRequestAbstract): cardinal;
function onAccept(Ctxt: THttpServerRequest; var Conn: THttpApiWebSocketConnection): Boolean;
procedure onConnect(var Conn: THttpApiWebSocketConnection );
procedure onMessage(var Conn: THttpApiWebSocketConnection; aBufferType: WEB_SOCKET_BUFFER_TYPE; aBuffer: Pointer; aBufferSize: Cardinal);
procedure onDisconnect(var Conn: THttpApiWebSocketConnection ; aStatus: WEB_SOCKET_CLOSE_STATUS; aBuffer: Pointer; aBufferSize: Cardinal);
public
constructor Create;
destructor Destroy; override;
end;
{ TSimpleWebsocketServer }
constructor TSimpleWebsocketServer.Create;
begin
fServer := THttpApiWebSocketServer.Create;
fServer.AddUrl('','8888', False, '127.0.0.1');
fServer.AddUrlWebSocket('whatever', '8888', False, '127.0.0.1');
fServer.RegisterProtocol('meow', False, onAccept, onMessage, onConnect, onDisconnect);
fServer.RegisterCompress(CompressDeflate);
fServer.OnRequest := onHttpRequest;
end;
destructor TSimpleWebsocketServer.Destroy;
begin
fServer.Free;
inherited;
end;
function TSimpleWebsocketServer.onAccept(Ctxt: THttpServerRequest; var Conn: THttpApiWebSocketConnection): Boolean;
begin
// You can check some Ctxt parameters here
Result := true;
end;
procedure TSimpleWebsocketServer.onConnect(var Conn: THttpApiWebSocketConnection);
begin
Writeln('New connection. Assigned connectionID=', Conn.index);
end;
procedure TSimpleWebsocketServer.onDisconnect(var Conn: THttpApiWebSocketConnection;
aStatus: WEB_SOCKET_CLOSE_STATUS; aBuffer: Pointer; aBufferSize: Cardinal);
var
str: RawUTF8;
begin
SetString(str, pUtf8Char(aBuffer), aBufferSize);
Writeln('Disconnected ', Conn.index,' ',aStatus,' ',str);
end;
function TSimpleWebsocketServer.onHttpRequest(Ctxt: THttpServerRequestAbstract): cardinal;
begin
Writeln('HTTP request to ', Ctxt.URL);
if Ctxt.URL = '/' then
Ctxt.OutContent := 'restws_simpleechoserver.html'
else if Ctxt.URL = '/favicon.ico' then
Ctxt.OutContent := 'favicon.ico';
Ctxt.OutContentType := HTTP_RESP_STATICFILE;
Result := 200;
end;
procedure TSimpleWebsocketServer.onMessage(var Conn: THttpApiWebSocketConnection;
aBufferType: WEB_SOCKET_BUFFER_TYPE; aBuffer: Pointer; aBufferSize: Cardinal);
var
str: RawUTF8;
begin
Conn.Send(aBufferType, aBuffer, aBufferSize);
SetString(str, pUtf8Char(aBuffer), aBufferSize);
if aBufferType = WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE then
Writeln('UTF8 message from ', Conn.index, ': ',str)
else if aBufferType = WEB_SOCKET_UTF8_FRAGMENT_BUFFER_TYPE then
Writeln('UTF8 fragment from ', Conn.index, ': ',str)
else if (aBufferType = WEB_SOCKET_BINARY_MESSAGE_BUFFER_TYPE)
or (aBufferType = WEB_SOCKET_BINARY_FRAGMENT_BUFFER_TYPE) then
Writeln(aBufferType, ' from ', Conn.index, ' of length ', aBufferSize)
else begin
Writeln(aBufferType, ' from ', Conn.index, ': ',str);
end;
end;
var
_Server: TSimpleWebsocketServer;
s: string;
idx: integer;
MsgBuffer: RawUTF8;
CloseReasonBuffer: RawUTF8;
begin
MsgBuffer := '';
CloseReasonBuffer := 'Connection closed by server';
try
_Server := TSimpleWebsocketServer.Create;
try
Writeln('WebSocket server is now listen on ws://localhost:8888/whatever');
Writeln('HTTP server is now listen on http://localhost:8888/');
Writeln(' Point your browser to http://localhost:8888/ for initial page');
WriteLn('Type one of a commnad:');
Writeln(' - "close connectionID" to close existing webSocket connection');
Writeln(' - "sendto connectionID" to send text to specified WebCocket');
Writeln(' - "sendall" to send text to specified WebCocket');
Writeln(' - press [Enter] to quit');
Writeln('Waiting for command:');
repeat
Readln(s);
if Pos('close ', s) = 1 then begin
s := SysUtils.Trim(Copy(s, 7, Length(s)));
_Server.fServer.GetRegisteredProtocols[0].Close(StrToIntDef(s, -1), WEB_SOCKET_SUCCESS_CLOSE_STATUS,
Pointer(CloseReasonBuffer), length(CloseReasonBuffer));
end else if Pos('sendto ', s) = 1 then begin
s := SysUtils.Trim(Copy(s, 8, Length(s)));
idx := StrToIntDef(s, -1);
if (idx = -1 ) then
Writeln('Invalid connection ID. Usage: send connectionID (Example: send 0)')
else begin
Write('Type text to send: ');
Readln(MsgBuffer);
if _Server.fServer.GetRegisteredProtocols[0].Send(
StrToIntDef(s, -1), WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE,
Pointer(MsgBuffer), length(MsgBuffer)
) then
WriteLn('Sent successfully. The message should appear in the client. Waiting for command:')
else
WriteLn('Error')
end;
end else if (s = 'sendall') then begin
Write('Type text to send: ');
Readln(MsgBuffer);
if _Server.fServer.GetRegisteredProtocols[0].Broadcast(
WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE,
Pointer(MsgBuffer), length(MsgBuffer)
) then
WriteLn('Broadcast successfully. All clients should got a message. Waiting for command:')
else
WriteLn('Error')
end else if (s <> '') then
WriteLn('Invalid comand; Valid command are: close, sendto, sendall');
until s = '';
finally
_Server.Free;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
The WebSockets API is not fully tested with mORMot 2.
Any input is welcome.
Thank you very much for the quick update. I tested the latest commit and confirmed that the behavior is now working exactly as expected. I appreciate your help and the great work on mORMot!
@Iwasaki-Laboratory I think you got confused and tried to answer your own issue: https://github.com/synopse/mORMot2/issues/420
@Iwasaki-Laboratory I think you got confused and tried to answer your own issue: #420
@rcla
My apologies. I accidentally commented on a different issue.