Commit 07612752 by Michael Brachmann

debugging websockets

parent 6b931563
...@@ -7,7 +7,6 @@ object WsServerModule: TWsServerModule ...@@ -7,7 +7,6 @@ object WsServerModule: TWsServerModule
end end
object XDataServer1: TXDataServer object XDataServer1: TXDataServer
Dispatcher = SparkleHttpSysDispatcher3 Dispatcher = SparkleHttpSysDispatcher3
ModelName = 'Ws'
EntitySetPermissions = <> EntitySetPermissions = <>
SwaggerOptions.Enabled = True SwaggerOptions.Enabled = True
SwaggerOptions.AuthMode = Jwt SwaggerOptions.AuthMode = Jwt
...@@ -17,6 +16,7 @@ object WsServerModule: TWsServerModule ...@@ -17,6 +16,7 @@ object WsServerModule: TWsServerModule
Left = 85 Left = 85
Top = 110 Top = 110
object XDataServer1WebSocket: TSparkleWebSocketMiddleware object XDataServer1WebSocket: TSparkleWebSocketMiddleware
Path = 'emimobile'
AllowedOrigins.Strings = ( AllowedOrigins.Strings = (
'*') '*')
end end
......
...@@ -51,7 +51,8 @@ uses ...@@ -51,7 +51,8 @@ uses
XData.Sys.Exceptions, XData.Sys.Exceptions,
Common.Logging, Common.Logging,
Common.Middleware.Logging, Common.Middleware.Logging,
Common.Config, Vcl.Forms, IniFiles; Common.Config, Vcl.Forms, IniFiles,
Ws.ServiceImpl;
{%CLASSGROUP 'Vcl.Controls.TControl'} {%CLASSGROUP 'Vcl.Controls.TControl'}
...@@ -65,6 +66,8 @@ procedure TWsServerModule.StartWsServer(ABaseUrl: string; AModelName: string); ...@@ -65,6 +66,8 @@ procedure TWsServerModule.StartWsServer(ABaseUrl: string; AModelName: string);
var var
Url: string; Url: string;
begin begin
RegisterServiceType(TWebSocketService);
Logger.Log(1, Format('Ws model "%s" registered TWebSocketService', [AModelName]));
RegisterOpenApiService; RegisterOpenApiService;
Url := ABaseUrl; Url := ABaseUrl;
if not Url.EndsWith('/') then if not Url.EndsWith('/') then
...@@ -72,8 +75,6 @@ begin ...@@ -72,8 +75,6 @@ begin
Url := Url + SERVER_PATH_SEGMENT; Url := Url + SERVER_PATH_SEGMENT;
XDataServer1.BaseUrl := Url; XDataServer1.BaseUrl := Url;
XDataServer1.ModelName := AModelName; XDataServer1.ModelName := AModelName;
//XDataServer1JWT.Secret := 'token';
//SparkleHttpSysDispatcher3.HttpSys.KeepHostInUrlPrefixes := True;
SparkleHttpSysDispatcher3.Start; SparkleHttpSysDispatcher3.Start;
Logger.Log(1, Format('Ws server module listening at "%s"', [Url])); Logger.Log(1, Format('Ws server module listening at "%s"', [Url]));
end; end;
......
...@@ -19,7 +19,4 @@ type ...@@ -19,7 +19,4 @@ type
implementation implementation
initialization
RegisterServiceType(TypeInfo(IWebSocketService));
end. end.
...@@ -4,6 +4,7 @@ interface ...@@ -4,6 +4,7 @@ interface
uses uses
Common.Logging, Common.Logging,
Common.Config,
System.SysUtils, System.SysUtils,
XData.Server.Module, XData.Server.Module,
XData.Service.Common, XData.Service.Common,
...@@ -15,7 +16,9 @@ uses ...@@ -15,7 +16,9 @@ uses
BaseRequest, BaseRequest,
LoginRequest, LoginRequest,
Pkg.Json.DTO, Pkg.Json.DTO,
Generics.Collections; Generics.Collections,
Bcl.JOSE.Core.Builder,
Bcl.JOSE.Core.JWT;
type type
[ServiceImplementation] [ServiceImplementation]
...@@ -36,25 +39,44 @@ var ...@@ -36,25 +39,44 @@ var
WebSocket: IWebSocket; WebSocket: IWebSocket;
Timer: TSparkleTimer; Timer: TSparkleTimer;
Msg: IWebSocketMessage; Msg: IWebSocketMessage;
JSONObject: TJSONObject;
MsgStr: string; MsgStr: string;
JWT: TJWT;
begin begin
Logger.Log(1, 'websocket begin-------'); Logger.Log(1, 'websocket begin-------');
// Check if the client sent an websocket request, if yes the IWebSocketUpgrader interface will be available.
Upgrader := THttpServerContext.Current.Item<IWebSocketUpgrader>; Upgrader := THttpServerContext.Current.Item<IWebSocketUpgrader>;
if Upgrader = nil then if Upgrader = nil then
begin begin
TXDataOperationContext.Current.Handler.SetStatusCode(400); TXDataOperationContext.Current.Handler.SetStatusCode(400);
Exit; Exit;
end; end;
Logger.Log(1, 'websocket upgrading-------'); Logger.Log(1, 'websocket upgrading-------');
// Upgrade to websocket
WebSocket := Upgrader.Upgrade; WebSocket := Upgrader.Upgrade;
Logger.Log(1, 'websocket upgraded-------'); Logger.Log(1, 'websocket upgraded-------');
// Send a message to client every 2 seconds
// First message must be the JWT token for authentication
Msg := WebSocket.Receive;
if Msg.MessageType <> TWebSocketMessageType.Text then
begin
Logger.Log(1, 'websocket auth failed - expected text token-------');
WebSocket.SendClose(WebSocketStatusCodes.PolicyViolation);
Exit;
end;
MsgStr := TEncoding.Default.GetString(Msg.Data);
JWT := TJOSE.Verify(serverConfig.jwtTokenSecret, MsgStr);
try
if not JWT.Verified then
begin
Logger.Log(1, 'websocket auth failed - invalid token-------');
WebSocket.SendClose(WebSocketStatusCodes.PolicyViolation);
Exit;
end;
finally
JWT.Free;
end;
Logger.Log(1, 'websocket auth ok-------');
Timer := TSparkleTimer.Create( Timer := TSparkleTimer.Create(
procedure(Value: TObject) procedure(Value: TObject)
begin begin
...@@ -64,7 +86,6 @@ begin ...@@ -64,7 +86,6 @@ begin
nil, 2000, TTimerType.Periodic nil, 2000, TTimerType.Periodic
); );
// Receive messages
try try
while WebSocket.State = TWebSocketState.Open do while WebSocket.State = TWebSocketState.Open do
begin begin
...@@ -74,14 +95,10 @@ begin ...@@ -74,14 +95,10 @@ begin
begin begin
MsgStr := TEncoding.Default.GetString(Msg.Data); MsgStr := TEncoding.Default.GetString(Msg.Data);
Logger.Log(1, 'Web Socket Message: ' + MsgStr); Logger.Log(1, 'Web Socket Message: ' + MsgStr);
//TODO: store connection in map with device id, implement message protocol
end; end;
//TODO: HERE we need to create a map to store connections for later TWebSocketMessageType.Close:
// and implement protocol to communicate WebSocket.SendClose(WebSocketStatusCodes.NormalClosure);
// store websocket obj, handle another layer of compression/encryption,
// probably store the websocket connection in a map with device id or some other uuid
//self.ProcessJsonMessage(MsgStr);
//TWebSocketMessageType.Close:
// WebSocket.SendClose(WebSocketStatusCodes.NormalClosure);
end; end;
end; end;
finally finally
...@@ -135,7 +152,4 @@ begin ...@@ -135,7 +152,4 @@ begin
end; end;
initialization
RegisterServiceType(TWebSocketService);
end. end.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment