Skip to content
Projects
Groups
Snippets
Help
This project
Loading...
Sign in / Register
Toggle navigation
E
emiMobile
Overview
Overview
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Mac Stephens
emiMobile
Commits
07612752
Commit
07612752
authored
May 30, 2026
by
Michael Brachmann
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
debugging websockets
parent
6b931563
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
37 additions
and
25 deletions
+37
-25
Ws.Server.Module.dfm
emiMobileServer/Source/Ws.Server.Module.dfm
+1
-1
Ws.Server.Module.pas
emiMobileServer/Source/Ws.Server.Module.pas
+4
-3
Ws.Service.pas
emiMobileServer/Source/Ws.Service.pas
+0
-3
Ws.ServiceImpl.pas
emiMobileServer/Source/Ws.ServiceImpl.pas
+32
-18
No files found.
emiMobileServer/Source/Ws.Server.Module.dfm
View file @
07612752
...
...
@@ -7,7 +7,6 @@ object WsServerModule: TWsServerModule
end
object XDataServer1: TXDataServer
Dispatcher = SparkleHttpSysDispatcher3
ModelName = 'Ws'
EntitySetPermissions = <>
SwaggerOptions.Enabled = True
SwaggerOptions.AuthMode = Jwt
...
...
@@ -17,6 +16,7 @@ object WsServerModule: TWsServerModule
Left = 85
Top = 110
object XDataServer1WebSocket: TSparkleWebSocketMiddleware
Path = 'emimobile'
AllowedOrigins.Strings = (
'*')
end
...
...
emiMobileServer/Source/Ws.Server.Module.pas
View file @
07612752
...
...
@@ -51,7 +51,8 @@ uses
XData
.
Sys
.
Exceptions
,
Common
.
Logging
,
Common
.
Middleware
.
Logging
,
Common
.
Config
,
Vcl
.
Forms
,
IniFiles
;
Common
.
Config
,
Vcl
.
Forms
,
IniFiles
,
Ws
.
ServiceImpl
;
{%CLASSGROUP 'Vcl.Controls.TControl'}
...
...
@@ -65,6 +66,8 @@ procedure TWsServerModule.StartWsServer(ABaseUrl: string; AModelName: string);
var
Url
:
string
;
begin
RegisterServiceType
(
TWebSocketService
);
Logger
.
Log
(
1
,
Format
(
'Ws model "%s" registered TWebSocketService'
,
[
AModelName
]));
RegisterOpenApiService
;
Url
:=
ABaseUrl
;
if
not
Url
.
EndsWith
(
'/'
)
then
...
...
@@ -72,8 +75,6 @@ begin
Url
:=
Url
+
SERVER_PATH_SEGMENT
;
XDataServer1
.
BaseUrl
:=
Url
;
XDataServer1
.
ModelName
:=
AModelName
;
//XDataServer1JWT.Secret := 'token';
//SparkleHttpSysDispatcher3.HttpSys.KeepHostInUrlPrefixes := True;
SparkleHttpSysDispatcher3
.
Start
;
Logger
.
Log
(
1
,
Format
(
'Ws server module listening at "%s"'
,
[
Url
]));
end
;
...
...
emiMobileServer/Source/Ws.Service.pas
View file @
07612752
...
...
@@ -19,7 +19,4 @@ type
implementation
initialization
RegisterServiceType
(
TypeInfo
(
IWebSocketService
));
end
.
emiMobileServer/Source/Ws.ServiceImpl.pas
View file @
07612752
...
...
@@ -4,6 +4,7 @@ interface
uses
Common
.
Logging
,
Common
.
Config
,
System
.
SysUtils
,
XData
.
Server
.
Module
,
XData
.
Service
.
Common
,
...
...
@@ -15,7 +16,9 @@ uses
BaseRequest
,
LoginRequest
,
Pkg
.
Json
.
DTO
,
Generics
.
Collections
;
Generics
.
Collections
,
Bcl
.
JOSE
.
Core
.
Builder
,
Bcl
.
JOSE
.
Core
.
JWT
;
type
[
ServiceImplementation
]
...
...
@@ -36,25 +39,44 @@ var
WebSocket
:
IWebSocket
;
Timer
:
TSparkleTimer
;
Msg
:
IWebSocketMessage
;
JSONObject
:
TJSONObject
;
MsgStr
:
string
;
JWT
:
TJWT
;
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
>;
if
Upgrader
=
nil
then
begin
TXDataOperationContext
.
Current
.
Handler
.
SetStatusCode
(
400
);
Exit
;
end
;
Logger
.
Log
(
1
,
'websocket upgrading-------'
);
Logger
.
Log
(
1
,
'websocket upgrading-------'
);
// Upgrade to websocket
WebSocket
:=
Upgrader
.
Upgrade
;
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
(
procedure
(
Value
:
TObject
)
begin
...
...
@@ -64,7 +86,6 @@ begin
nil
,
2000
,
TTimerType
.
Periodic
);
// Receive messages
try
while
WebSocket
.
State
=
TWebSocketState
.
Open
do
begin
...
...
@@ -74,14 +95,10 @@ begin
begin
MsgStr
:=
TEncoding
.
Default
.
GetString
(
Msg
.
Data
);
Logger
.
Log
(
1
,
'Web Socket Message: '
+
MsgStr
);
//TODO: store connection in map with device id, implement message protocol
end
;
//TODO: HERE we need to create a map to store connections for later
// and implement protocol to communicate
// 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);
TWebSocketMessageType
.
Close
:
WebSocket
.
SendClose
(
WebSocketStatusCodes
.
NormalClosure
);
end
;
end
;
finally
...
...
@@ -135,7 +152,4 @@ begin
end
;
initialization
RegisterServiceType
(
TWebSocketService
);
end
.
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment