WebSocket Server

Share your advanced PureBasic knowledge/code with the community.
User avatar
Dadido3
User
User
Posts: 52
Joined: Sat Jan 12, 2008 11:50 pm
Location: Hessen, Germany
Contact:

Re: WebSocket Server

Post by Dadido3 »

Hello bbanelli,

a few points regarding the limits:
  • The OS limits the amount of connections an application or the complete system can have. I don't know exact numbers right now, but on Windows it's artifically limited so that you have to buy the server version for more sophisticated use of network stuff. On Linux and OSX? there is no artifical limit as far as i know. So if you don't have windows server, you can do a lot more with them.
  • The websocket protocol sits on top of TCP/IP, so it doesn't know anything about the concurrent connections, and therefore isn't a limiting factor in a direct way. Indirectly it introduces a bit of overhead (Additional 6 bytes for small frames, and up to 14 bytes for larger frames. And some processing overhead to mask and demask frames), so it's not a good idea to send a lot of frames with just a few bytes via websocket. The frames will be batched together by the network stack anyway, so to get the maximum amount of concurrent users out of your network connection, you should design your protocol in a way that it creates rather few big frames than a lot of small frames.
  • My implementation also has its limits:
    • For now i just use a list of clients which i have to iterate through every incoming event. It would be nice if PB would support maps with integer keys (that's why i don't use maps for this yet), but if more performance is needed i could use maps with string keys.
    • Same goes for the outgoing frames, i'm iterating through all clients checking wether any of them has outgoing frames queued. I could put that into one queue and create an extra thread for it, but for now it should handle a few hundred connections just fine.
    • There is only one thread for now, so it can't use all the ressources a modern CPU can offer. But to improve that you would probably need to use something else than PB its networking commands, and use modern networking APIs of the OSes (NAPI on linux i think, and WebSocket 2 on windows). But thats rather a thing you need if you have to handle million or more packets per second.
I just tested how much is possible with the chat example under windows 10. I created a simple program in golang, which creates a specific amount of connections to the server and then sends a message every second on each connection:
  • Without sending any data i was able to crate only around 450 connections, so the limit in windows 10 pro is probably 500 or 512.
  • The server was able to handle the incoming messages of those clients (450 incoming messages per second), there is probably a lot more possible.
  • But as the server is broadcasting every message to all clients, i reached the limit at around 300 clients (~90000 outgoing messages per second).
There is room for improvement, especially as the golang program only uses 10% CPU, and the PB server 25% (1 of 4 cores) for 300 connections.
User avatar
bbanelli
Enthusiast
Enthusiast
Posts: 543
Joined: Tue May 28, 2013 10:51 pm
Location: Europe
Contact:

Re: WebSocket Server

Post by bbanelli »

Hi Dadido3 (and others),

I have build TLS capable version of libwebsockets but I am completely clueless how to start doing something with PB. Using regular ws (non TLS) is basically useless for anything but internal prototyping.

Only needing client side, though, since server is done in Golang, but libwebsockets doesn't look really nice or friendly, at least at first glance.

Thanks for any heads-up!

Bruno
"If you lie to the compiler, it will get its revenge."
Henry Spencer
https://www.pci-z.com/
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: WebSocket Server

Post by infratec »

2 posibilities:

1. Write your own pbi with libcurl.pbi
2. Write a wrapper for libwebsockets
User avatar
bbanelli
Enthusiast
Enthusiast
Posts: 543
Joined: Tue May 28, 2013 10:51 pm
Location: Europe
Contact:

Re: WebSocket Server

Post by bbanelli »

Well, I got myself a third, dirty option. :)

I used GoLang and Gorilla library to produce the following:

Code: Select all

package main

import "C"
import (
	"github.com/gorilla/websocket"
	"net/url"
	"sync"
)

//export NewWebSocketClientConnection
func NewWebSocketClientConnection (scheme, host, path, echoMessage *C.char) *C.char {
	var wg sync.WaitGroup
	wg.Add(1)

	var retMsg string

	u := url.URL{Scheme: C.GoString(scheme), Host: C.GoString(host), Path: C.GoString(path)}

	c, _, err := websocket.DefaultDialer.Dial(u.String(), nil)
	if err != nil {
		retMsg = err.Error()
		return C.CString(retMsg)
	}
	defer c.Close()

	go func() {
		defer wg.Done()
		for {
			_, message, err := c.ReadMessage()
			if err != nil {
				retMsg = err.Error()
				err := c.WriteMessage(websocket.CloseMessage, websocket.FormatCloseMessage(websocket.CloseNormalClosure, ""))
				if err != nil {
					retMsg = err.Error()
					return
				}
				return
			}
			retMsg = string(message)
			err = c.WriteMessage(websocket.CloseMessage, websocket.FormatCloseMessage(websocket.CloseNormalClosure, ""))
			if err != nil {
				retMsg = err.Error()
				return
			}
			return
		}
	}()

	err = c.WriteMessage(websocket.TextMessage, []byte(C.GoString(echoMessage)))
	if err != nil {
		retMsg = err.Error()
		return C.CString(retMsg)
	}
	wg.Wait()
	return C.CString(retMsg)
}

func main() {}
Compiled with -buildmode=c-shared and wrote the following PB code.

Code: Select all

EnableExplicit

Prototype.i NewWebSocketClientConnection(scheme.i, host.i, path.i, echoMessage.i)

If OpenLibrary(0, GetCurrentDirectory() + "/websocket.dll")
  Define NewWebSocketClientConnection.NewWebSocketClientConnection = GetFunction(0, "NewWebSocketClientConnection")
  Define *scheme, *host, *path, *echoMessage, *returnEchoMessage
  *scheme = AllocateMemory(1024)
  *host= AllocateMemory(1024)
  *path = AllocateMemory(1024)
  *echoMessage = AllocateMemory(1024)
  PokeS(*scheme, "wss", -1, #PB_UTF8)
  PokeS(*host, "demos.kaazing.com", -1, #PB_UTF8) ;echo.websocket.org
  PokeS(*path, "/echo", -1, #PB_UTF8)
  PokeS(*echoMessage, "Hello from PureBasic through Secure Web Socket feat. Golang :)", -1, #PB_UTF8)
  *returnEchoMessage = NewWebSocketClientConnection(*scheme, *host, *path, *echoMessage)
  MessageRequester("Response", PeekS(*returnEchoMessage, -1, #PB_UTF8))
  CloseLibrary(0)
Else
  MessageRequester("Error", "Error opening lib")
EndIf
Mind you, both codes have little to no error code checking, thus making them highly unreliable and subjected to production revision.

However, this WORKS as a proof of concept, though it has rather large shared library (Windows x64 a bit more than 10MB - after omiting (DWARF) symbol table and debug information, it is just above 5MB).

But one who can live with that drawback might enjoy some fine PB addon, at least regarding (secure) web sockets.

Hope this helps someone!

With my very best,

Bruno

Edit: slightly updated Go code for graceful connection closing
"If you lie to the compiler, it will get its revenge."
Henry Spencer
https://www.pci-z.com/
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: WebSocket Server

Post by infratec »

Ups...

my solution 1 (libcurl) is not possible.
It is not possible to create a server with libcurl. It only handles client stuff. :cry:
lesserpanda
User
User
Posts: 65
Joined: Tue Feb 11, 2020 7:50 am

Re: WebSocket Server

Post by lesserpanda »

Hello, I have used the Websocket server code to implement for my app. It is working fine and thank you very much.

However, I'd like to capture the URL which the User connect to

e.g.

ws://localhost:8090/abc

I'd like the abc part. is there a way to access it from the HTTP_Header? I'm not sure and I was trying to see how to do it but couldn't. Sorry, I'm a newbie and I may not be well versed with the structures at the moment but if it is there, please do let me know.
User avatar
Dadido3
User
User
Posts: 52
Joined: Sat Jan 12, 2008 11:50 pm
Location: Hessen, Germany
Contact:

Re: WebSocket Server

Post by Dadido3 »

lesserpanda wrote: Mon Dec 05, 2022 1:22 am However, I'd like to capture the URL which the User connect to
The server stores the parsed HTTP request for every client, so theoretically the information is there. Unfortunately it's only available from inside the library.

But i could add a function that returns the HTTP request for a client, i'll check it out soon.
User avatar
Dadido3
User
User
Posts: 52
Joined: Sat Jan 12, 2008 11:50 pm
Location: Hessen, Germany
Contact:

Re: WebSocket Server

Post by Dadido3 »

I just added a function to get that data:

Code: Select all

Protected *HTTP_Header.WebSocket_Server::HTTP_Header = WebSocket_Server::Get_HTTP_Header(*Client)
PrintN(" Request: " + *HTTP_Header\Request)
ForEach *HTTP_Header\Field()
  PrintN(" Header Key-Value pair: " + MapKey(*HTTP_Header\Field()) + #TAB$ + #TAB$ + *HTTP_Header\Field())
Next
will result in:
Request: GET / HTTP/1.1
Header Key-Value pair: accept */*
Header Key-Value pair: sec-fetch-dest websocket
Header Key-Value pair: sec-fetch-mode websocket
Header Key-Value pair: sec-websocket-extensions permessage-deflate
Header Key-Value pair: origin null
Header Key-Value pair: pragma no-cache
Header Key-Value pair: sec-websocket-key 09xtga3M2j7tW4ckuqWIFQ==
Header Key-Value pair: accept-encoding gzip, deflate, br
Header Key-Value pair: user-agent Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv
Header Key-Value pair: accept-language de,en-US;q=0.7,en;q=0.3
Header Key-Value pair: host localhost
Header Key-Value pair: cache-control no-cache
Header Key-Value pair: sec-fetch-site cross-site
Header Key-Value pair: sec-websocket-version 13
Header Key-Value pair: connection keep-alive, Upgrade
Header Key-Value pair: upgrade websocket
Header Key-Value pair: dnt 1
The important part for you is probably *HTTP_Header\Request. You can obtain the URL path with:

Code: Select all

StringField(*HTTP_Header\Request, 2, " ")
lesserpanda
User
User
Posts: 65
Joined: Tue Feb 11, 2020 7:50 am

Re: WebSocket Server

Post by lesserpanda »

Hi, yeah got the new codes. Thanks for the quick one. I was half hacking it but rather keep to the repo version.
User avatar
Maxus
User
User
Posts: 70
Joined: Thu Feb 16, 2006 9:35 am
Location: Russia
Contact:

Re: WebSocket Server

Post by Maxus »

tls_server.pbi

Code: Select all

DeclareModule tls_server
  Declare ServerUpgrade(Server.i, pem.s)
  Declare UpgradeConn(ClientID.i)
  Declare SendData(ClientID.i, *Buffer, BufferLenght.i)
  Declare ReceiveData(ClientID.i, *Buffer, BufferLenght.i)
  Declare isTls(Server.i)
  Declare CloseConn(ClientID.i)
  Declare CloseServer(Server.i)
EndDeclareModule

Module tls_server
  XIncludeFile "libreSSL.pbi"
  Structure tls_server
    pb_srv.i
    tls_srv.i
    cfg.i
  EndStructure
  Structure ctx
    connect.i
    ctx.i
    server.i
  EndStructure
  
  Global NewMap tls.tls_server()
  Global NewMap ctx.ctx()
  
  Procedure ServerUpgrade(Server.i, fullchain.s)
    fid = ReadFile(0,fullchain,#PB_File_SharedRead)
    If fid
      *crt_key=AllocateMemory(Lof(fid))
      ReadData(fid,*crt_key,MemorySize(*crt_key))
      CloseFile(fid)
      If tls_init(): ProcedureReturn -2 : EndIf
      tls_cfg = tls_config_new()
      If tls_config_set_ca_mem(tls_cfg, *crt_key, MemorySize(*crt_key)) : ProcedureReturn -3 : EndIf
      ;*crt=*crt_key:*crt_end=*crt
      ;While Not CompareMemory(*crt,Ascii("-----BEGIN CERTIFICATE-----"),27):*crt+1:Wend
      ;While Not CompareMemory(*crt_end,Ascii("-----END CERTIFICATE-----"),25):*crt_end+1:Wend:*crt_end+25
      ;If tls_config_set_cert_mem(tls_cfg, *crt, *crt_end-*crt) : ProcedureReturn -4 : EndIf
      If tls_config_set_cert_mem(tls_cfg, *crt_key, MemorySize(*crt_key)) : ProcedureReturn -4 : EndIf
      ;*key=*crt_key:*key_end=*key
      ;While Not CompareMemory(*key,Ascii("-----BEGIN RSA PRIVATE KEY-----"),31):*key+1:Wend
      ;While Not CompareMemory(*key_end,Ascii("-----END RSA PRIVATE KEY-----"),29):*key_end+1:Wend:*key_end+29
      ;If tls_config_set_key_mem(tls_cfg, *key, *key_end - *key) : ProcedureReturn -5 : EndIf
      If tls_config_set_key_mem(tls_cfg, *crt_key, MemorySize(*crt_key)) : ProcedureReturn -5 : EndIf
      tls_ctx = tls_server()
      If Not tls_ctx : tls_config_free(tls_cfg) : ProcedureReturn -6 : EndIf
      returns = tls_configure(tls_ctx, tls_cfg)
      If returns <> 0 :tls_config_free(tls_cfg) : ProcedureReturn -7 : EndIf
      tls(Str(Server))\pb_srv = ServerID(Server)
      tls(Str(Server))\tls_srv = tls_ctx
      tls(Str(Server))\cfg = tls_cfg
      FreeMemory(*crt_key)
      ProcedureReturn 1
    Else
      ProcedureReturn -1
    EndIf
  EndProcedure
  
  Procedure UpgradeConn(ClientID.i)
    clid.s=Str(ClientID)
    srv.s=Str(EventServer())
    If tls(srv)\tls_srv
      tlssID = tls_accept_socket(tls(srv)\tls_srv, @cctx, ConnectionID(ClientID))
      If tlssID = -1 : ProcedureReturn -2 : EndIf
      ctx(clid)\connect = ConnectionID(ClientID)
      ctx(clid)\ctx = cctx
      ctx(clid)\server = ServerID(Val(srv))
      tls_handshake(ctx(clid)\ctx)
      Repeat:lt = tls_read(ctx(clid)\ctx,@tmp.s{1024},1024):Until lt=-2
      Repeat:lt = tls_read(ctx(clid)\ctx,@tmp.s{1024},1024):Until lt=-2
      ProcedureReturn ctx(clid)\ctx
    EndIf
  EndProcedure
  
  Procedure ReceiveData(ClientID.i, *Buffer, BufferLenght.i)
    clid.s=Str(ClientID)
    If ctx(clid)\connect
      ProcedureReturn tls_read(ctx(clid)\ctx,*Buffer, BufferLenght)
    Else
      ProcedureReturn ReceiveNetworkData(ClientID, *Buffer, BufferLenght)
    EndIf
  EndProcedure
  
  Procedure SendData(ClientID.i, *Buffer, BufferLenght.i)
    clid.s=Str(ClientID)
    If ctx(clid)\connect
      ProcedureReturn tls_write(ctx(clid)\ctx,*Buffer, BufferLenght)
    Else
      ProcedureReturn SendNetworkData(ClientID, *Buffer, BufferLenght)
    EndIf
  EndProcedure
  
  Procedure isTls(Server.i)
    srv.s=Str(Server)
    If tls(srv)\tls_srv:ProcedureReturn #True:EndIf
  EndProcedure
  
  Procedure CloseConn(ClientID.i)
    clid.s=Str(ClientID)
    If ctx(clid)\connect
      tls_close(ctx(clid)\ctx)
      DeleteMapElement(ctx(),clid)
    EndIf
  EndProcedure
  
  Procedure CloseServer(Server.i)
    srv.s = Str(Server)
    If tls(srv)\tls_srv
      tls_free(tls(srv)\tls_srv)
      tls_config_free(tls(srv)\cfg)
      DeleteMapElement(tls(),srv)
    EndIf
    ProcedureReturn CloseNetworkServer(Server)
  EndProcedure
  
EndModule
Good afternoon.
Here I modified this server to work over the TLS protocol, I used LibreSSL.pbi

LibreSSL: http://forums.purebasic.com/english/vie ... 72#p584096
Here is a link to your file and how to change it to work over SSL.
Last edited by Maxus on Wed Jan 11, 2023 5:32 pm, edited 1 time in total.
Sorry my English, I'm Russian
AMT Laboratory
User avatar
Maxus
User
User
Posts: 70
Joined: Thu Feb 16, 2006 9:35 am
Location: Russia
Contact:

Re: WebSocket Server

Post by Maxus »

Code: Select all

CompilerIf Not #PB_Compiler_Thread
  CompilerError "Thread-Safe is not activated!"
CompilerEndIf

IncludeFile "tls_server.pbi"
; ##################################################### Module ######################################################

DeclareModule WebSocket_Server
  
  ; ##################################################### Public Constants ############################################
  
  #Version = 1006
  
  Enumeration
    #Event_None
    #Event_Connect
    #Event_Disconnect
    #Event_Frame
  EndEnumeration
  
  Enumeration
    #Opcode_Continuation
    #Opcode_Text
    #Opcode_Binary
    
    #Opcode_Connection_Close = 8
    #Opcode_Ping
    #Opcode_Pong
  EndEnumeration
  
  Enumeration
    #CloseStatusCode_Normal = 1000      ; indicates a normal closure, meaning that the purpose for which the connection was established has been fulfilled.
    #CloseStatusCode_GoingAway          ; indicates that an endpoint is "going away", such as a server going down or a browser having navigated away from a page.
    #CloseStatusCode_ProtocolError      ; indicates that an endpoint is terminating the connection due to a protocol error.
    #CloseStatusCode_UnhandledDataType  ; indicates that an endpoint is terminating the connection because it has received a type of data it cannot accept (e.g., an endpoint that understands only text data MAY send this if it receives a binary message).
    #CloseStatusCode_1004               ; Reserved.  The specific meaning might be defined in the future.
    #CloseStatusCode_NoStatusCode       ; is a reserved value and MUST NOT be set as a status code in a Close control frame by an endpoint.  It is designated for use in applications expecting a status code to indicate that no status code was actually present.
    #CloseStatusCode_AbnormalClose      ; is a reserved value and MUST NOT be set as a status code in a Close control frame by an endpoint.  It is designated for use in applications expecting a status code to indicate that the connection was closed abnormally, e.g., without sending or receiving a Close control frame.
    #CloseStatusCode_1007               ; indicates that an endpoint is terminating the connection because it has received data within a message that was not consistent with the type of the message (e.g., non-UTF-8 [RFC3629] data within a text message).
    #CloseStatusCode_PolicyViolation    ; indicates that an endpoint is terminating the connection because it has received a message that violates its policy.  This is a generic status code that can be returned when there is no other more suitable status code (e.g., 1003 or 1009) or if there is a need to hide specific details about the policy.
    #CloseStatusCode_SizeLimit          ; indicates that an endpoint is terminating the connection because it has received a message that is too big for it to process.
    #CloseStatusCode_1010
    #CloseStatusCode_1011
    #CloseStatusCode_1015
  EndEnumeration
  
  #RSV1 = %00000100
  #RSV2 = %00000010
  #RSV3 = %00000001
  
  #Frame_Payload_Max = 10000000             ; Default max. size of an incoming frame's payload. If the payload exceeds this value, the client will be disconnected.
  #Frame_Fragmented_Payload_Max = 100000000 ; Default max. size of the total payload of a series of frame fragments. If the payload exceeds this value, the client will be disconnected. If the user/application needs more, it has To handle fragmentation on its own.
  #Frame_Control_Payload_Max = 125          ; Max. allowed amount of bytes in the payload of control frames. This is defined by the websocket standard.
  
  #ClientDisconnectTimeout = 5000 ; Maximum duration in ms a client waits to send all queued outgoing frames on connection closure.
  #ClientConnectTimeout = 45000 ; Maximum duration in ms a client is allowed to take for connection and handshake related activities.
  
  ; ##################################################### Public Structures ###########################################
  
  Structure Event_Frame
    Fin.a                 ; #True if this is the final frame of a series of frames.
    RSV.a                 ; Extension bits: RSV1, RSV2, RSV3.
    Opcode.a              ; Opcode.
    
    *Payload
    Payload_Size.i
    
    *FrameData            ; Raw frame data. don't use this, you should use the *Payload instead.
  EndStructure
  
  Structure HTTP_Header
    *Data
    RX_Pos.i
    
    Request.s     ; The HTTP request that was originally sent by the client.
    Map Field.s() ; The HTTP header key value pairs originally sent by the client.
  EndStructure
  
  ; ##################################################### Public Variables ############################################
  
  ; ##################################################### Public Prototypes ###########################################
  
  Prototype   Event_Callback(*Object, *Client, Event.i, *Custom_Structure=#Null)
  
  ; ##################################################### Public Procedures (Declares) ################################
  
  Declare.i Create(Port, *Event_Thread_Callback.Event_Callback=#Null, Frame_Payload_Max.q=#Frame_Payload_Max, HandleFragmentation=#True) ; Creates a new WebSocket server. *Event_Thread_Callback is the callback which will be called out of the server thread.
  Declare   Free(*Object)                                                                           ; Closes the WebSocket server.
  
  Declare   Frame_Text_Send(*Object, *Client, Text.s)                                               ; Sends a text-frame.
  Declare   Frame_Send(*Object, *Client, FIN.a, RSV.a, Opcode.a, *Payload, Payload_Size.q)          ; Sends a frame. FIN, RSV and Opcode can be freely defined. Normally you should use #Opcode_Binary.
  
  Declare   Event_Callback(*Object, *Callback.Event_Callback)                                       ; Checks for events, and calls the *Callback function if there are any.
  
  Declare.i Get_HTTP_Header(*Client)                                                                ; Returns a pointer to the HTTP_Header structure that contains the parsed HTTP request of the given client.
  
  Declare   Client_Disconnect(*Object, *Client, statusCode.u=0, reason.s="")                        ; Disconnects the specified *Client.
  
EndDeclareModule

; ##################################################### Module (Private Part) #######################################

Module WebSocket_Server
  
  EnableExplicit
  
  ; #### Only use this for debugging purposes.
  ;XIncludeFile "AllocationDumper.pbi"
  CompilerIf #PB_Compiler_Version<>600
    InitNetwork()
  CompilerEndIf
  UseSHA1Fingerprint()
  
  ; ##################################################### Constants ###################################################
  
  #Frame_Data_Size_Min = 2048
  
  #HTTP_Header_Data_Read_Step = 1024
  #HTTP_Header_Data_Size_Step = 2048
  #HTTP_Header_Data_Size_Max = 8192
  
  #GUID = "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"
  
  Enumeration
    #Mode_Handshake
    #Mode_Frames
  EndEnumeration
  
  ; ##################################################### Structures ##################################################
  
  Structure Eight_Bytes
    Byte.a[8]
  EndStructure
  
  Structure Frame_Header_Length
    Dummy.a
    Length.a
    Extended.a[8]
  EndStructure
  
  Structure Frame_Header
    StructureUnion
      Byte.a[14]            ; Size of the header is 14B max.
      Length.Frame_Header_Length
    EndStructureUnion
  EndStructure
  
  Structure Frame
    *Data.Frame_Header
    
    RxTx_Pos.i              ; Current position while receiving or sending the frame.
    RxTx_Size.i             ; Size of the frame (Header + Payload).
    
    Payload_Pos.i
    Payload_Size.q          ; Quad, because a frame can be 2^64B large.
  EndStructure
  
  Structure Client
    ID.i                    ; Client ID. Is set to #Null when the TCP connection closes. The user can still read all incoming frames, though.
    
    HTTP_Header.HTTP_Header
    
    *New_RX_FRAME.Frame     ; A frame that is currently being received.
    
    List RX_Frame.Frame()   ; List of fully received incoming frames (They need to be passed to the user of this library).
    List TX_Frame.Frame()   ; List of outgoing frames. First one is currently being sent.
    
    List Fragments.Event_Frame()  ; List of (parsed) fragment frames. A series of fragments will be stored here temporarily.
    Fragments_Size.q              ; Total size sum of all fragments.
    
    Mode.i
    
    Event_Connect.i               ; #True --> Generate connect callback.
    Event_Disconnect_Manually.i   ; #True --> Generate disconnect callback and delete client as soon as all data is sent and read by the application. (This gets set by the application or websocket protocol, there is possibly still a TCP connection)
    DisconnectTimeout.q           ; When Event_Disconnect_Manually is #True: Point in time when the server forcefully disconnects the client, no matter if all packets have been sent or not.
    ConnectTimeout.q              ; Point in time when a client will be disconnected. Reset after the handshake was successful.
    
    Enqueued.i              ; #True --> This client is already inside the ClientQueue of the server.
    
    External_Reference.i    ; #True --> An external reference was given to the application (via event). If the connection closes, there must be a closing event.
  EndStructure
  
  Structure Object
    Server_ID.i
    
    Network_Thread_ID.i     ; Thread handling in and outgoing data.
    
    Event_Thread_ID.i       ; Thread handling event callbacks and client deletions.
    
    List Client.Client()
    List *ClientQueue.Client() ; A queue of clients that need to be processed in Event_Callback().
    ClientQueueSemaphore.i     ; Semaphore for the client queue.
    
    *Event_Thread_Callback.Event_Callback
    
    Frame_Payload_Max.q     ; Max-Size of an incoming frame's payload. If the frame exceeds this value, the client will be disconnected.
    HandleFragmentation.i   ; Let the library handle frame fragmentation. If set to true, the user/application will only receive coalesced frames. If set to false, the user/application has to handle fragmentation (By checking the Fin flag and #Opcode_Continuation)
    
    Mutex.i
    
    Free_Event.i            ; Free the event thread and its semaphore.
    Free.i                  ; Free the main networking thread and all the resources.
  EndStructure
  
  ; ##################################################### Variables ###################################################
  
  Global DummyMemorySize = 1024
  Global *DummyMemory = AllocateMemory(DummyMemorySize)
  
  ; ##################################################### Declares ####################################################
  
  Declare   Frame_Send_Mutexless(*Object.Object, *Client.Client, FIN.a, RSV.a, Opcode.a, *Payload, Payload_Size.q)
  Declare   Client_Disconnect_Mutexless(*Object.Object, *Client.Client, statusCode.u=0, reason.s="")
  
  ; ##################################################### Procedures ##################################################
  
  Procedure Client_Select(*Object.Object, ID.i)
    If Not ID
      ProcedureReturn #False
    EndIf
    
    ForEach *Object\Client()
      If *Object\Client()\ID = ID
        ProcedureReturn #True
      EndIf
    Next
    
    ProcedureReturn #False
  EndProcedure
  
  Procedure ClientQueueEnqueue(*Object.Object, *Client.Client, signal=#True)
    If *Client\Enqueued
      ProcedureReturn #True
    EndIf
    
    LastElement(*Object\ClientQueue())
    If AddElement(*Object\ClientQueue())
      *Client\Enqueued = #True
      *Object\ClientQueue() = *Client
      
      If *Object\ClientQueueSemaphore And signal
        ; #### Set semaphore to 1, but don't increase count above 1.
        TrySemaphore(*Object\ClientQueueSemaphore)
        SignalSemaphore(*Object\ClientQueueSemaphore)
      EndIf
      
      ProcedureReturn #True
    EndIf
    
    ProcedureReturn #False
  EndProcedure
  
  Procedure ClientQueueDequeue(*Object.Object)
    Protected *Client.Client
    
    If FirstElement(*Object\ClientQueue())
      *Client = *Object\ClientQueue()
      DeleteElement(*Object\ClientQueue())
      *Client\Enqueued = #False
      ProcedureReturn *Client
    EndIf
    
    ProcedureReturn #Null
  EndProcedure
  
  Procedure ClientQueueRemove(*Object.Object, *Client.Client)
    If Not *Client\Enqueued
      ProcedureReturn #True
    EndIf
    
    ForEach *Object\ClientQueue()
      If *Object\ClientQueue() = *Client
        DeleteElement(*Object\ClientQueue())
        *Client\Enqueued = #False
        ProcedureReturn #True
      EndIf
    Next
    
    ProcedureReturn #False
  EndProcedure
  
  Procedure ClientQueueWait(*Object.Object)
    ; #### Wait for signal.
    WaitSemaphore(*Object\ClientQueueSemaphore)
  EndProcedure
  
  Procedure Client_Free(*Client.Client)
    ; #### Free all RX_Frames()
    While FirstElement(*Client\RX_Frame())
      If *Client\RX_Frame()\Data
        FreeMemory(*Client\RX_Frame()\Data) : *Client\RX_Frame()\Data = #Null
      EndIf
      DeleteElement(*Client\RX_Frame())
    Wend
    
    ; #### Free all TX_Frames()
    While FirstElement(*Client\TX_Frame())
      If *Client\TX_Frame()\Data
        FreeMemory(*Client\TX_Frame()\Data) : *Client\TX_Frame()\Data = #Null
      EndIf
      DeleteElement(*Client\TX_Frame())
    Wend
    
    ; #### Free all Fragments()
    While FirstElement(*Client\Fragments())
      If *Client\Fragments()\FrameData
        FreeMemory(*Client\Fragments()\FrameData) : *Client\Fragments()\FrameData = #Null
      EndIf
      DeleteElement(*Client\Fragments())
    Wend
    
    ; #### Free HTTP header data, if still present
    If *Client\HTTP_Header\Data
       FreeMemory(*Client\HTTP_Header\Data) : *Client\HTTP_Header\Data = #Null
    EndIf
    
    ; #### Free temporary RX frame
    If *Client\New_RX_FRAME
      If *Client\New_RX_FRAME\Data
        FreeMemory(*Client\New_RX_FRAME\Data) : *Client\New_RX_FRAME\Data = #Null
      EndIf
      FreeStructure(*Client\New_RX_FRAME) : *Client\New_RX_FRAME = #Null
    EndIf
  EndProcedure
  
  Procedure.s Generate_Key(Client_Key.s)
    Protected *Temp_Data_2, *Temp_Data_3
    Protected Temp_String.s
    Protected Temp_SHA1.s
    Protected i
    Protected Result.s
    
    Temp_String.s = Client_Key + #GUID
    
    ; #### Generate the SHA1
    *Temp_Data_2 = AllocateMemory(20)
    If Not *Temp_Data_2
      ProcedureReturn ""
    EndIf
    Temp_SHA1.s = StringFingerprint(Temp_String, #PB_Cipher_SHA1, 0, #PB_Ascii)
    ;Debug Temp_SHA1
    For i = 0 To 19
      PokeA(*Temp_Data_2+i, Val("$"+Mid(Temp_SHA1, 1+i*2, 2)))
    Next
    
    ; #### Encode the SHA1 as Base64
    *Temp_Data_3 = AllocateMemory(64) ; Expected max. size of Base64 encoded string is 27 bytes. But Base64EncoderBuffer has a min. output buffer size of 64 bytes.
    If Not *Temp_Data_3
      FreeMemory(*Temp_Data_2)
      ProcedureReturn ""
    EndIf
    CompilerIf #PB_Compiler_Version < 560
      Base64Encoder(*Temp_Data_2, 20, *Temp_Data_3, 64)
    CompilerElse
      Base64EncoderBuffer(*Temp_Data_2, 20, *Temp_Data_3, 64)
    CompilerEndIf
    
    Result = PeekS(*Temp_Data_3, -1, #PB_Ascii)
    
    FreeMemory(*Temp_Data_2)
    FreeMemory(*Temp_Data_3)
    
    ProcedureReturn Result
  EndProcedure
  
  Procedure Thread_Receive_Handshake(*Object.Object, *Client.Client)
    Protected Result.i
    Protected *Temp_Data
    Protected Temp_Text.s
    Protected Temp_Line.s
    Protected Temp_Key.s
    Protected Response.s
    Protected i
    
    If *Client\Event_Disconnect_Manually
      ; #### Read data into dummy memory to dump it. Otherwise this will be called over and over again, as there is "new" data.
      While tls_server::ReceiveData(*Client\ID, *DummyMemory, DummyMemorySize) > 0
        ;ReceiveNetworkData(*Client\ID, *DummyMemory, DummyMemorySize) > 0
      Wend
      ProcedureReturn #False
    EndIf
    
    Repeat
    
      ; #### Limit memory usage.
      If *Client\HTTP_Header\RX_Pos > #HTTP_Header_Data_Size_Max
        *Client\Event_Disconnect_Manually = #True : ClientQueueEnqueue(*Object, *Client)
        ProcedureReturn #False
      EndIf
      
      ; #### Manage memory
      If Not *Client\HTTP_Header\Data
        *Client\HTTP_Header\Data = AllocateMemory(#HTTP_Header_Data_Size_Step) ; This will be purged when the header got fully parsed, when the client is deleted or when the server is released.
        If Not *Client\HTTP_Header\Data
          *Client\Event_Disconnect_Manually = #True : ClientQueueEnqueue(*Object, *Client)
          ProcedureReturn #False
        EndIf
      EndIf
      If MemorySize(*Client\HTTP_Header\Data) < *Client\HTTP_Header\RX_Pos + #HTTP_Header_Data_Read_Step
        *Temp_Data = ReAllocateMemory(*Client\HTTP_Header\Data, ((*Client\HTTP_Header\RX_Pos + #HTTP_Header_Data_Read_Step) / #HTTP_Header_Data_Size_Step + 1) * #HTTP_Header_Data_Size_Step)
        If *Temp_Data
          *Client\HTTP_Header\Data = *Temp_Data
        Else
          *Client\Event_Disconnect_Manually = #True : ClientQueueEnqueue(*Object, *Client)
          ProcedureReturn #False
        EndIf
      EndIf
      
      ; #### Receive a chunk of data.
      Result = tls_server::ReceiveData(*Client\ID, *Client\HTTP_Header\Data + *Client\HTTP_Header\RX_Pos, #HTTP_Header_Data_Read_Step)
      ;ReceiveNetworkData(*Client\ID, *Client\HTTP_Header\Data + *Client\HTTP_Header\RX_Pos, #HTTP_Header_Data_Read_Step)
      If Result > 0
        *Client\HTTP_Header\RX_Pos + Result
      ElseIf Result = 0
        Break
      Else
        *Client\Event_Disconnect_Manually = #True : ClientQueueEnqueue(*Object, *Client)
        ProcedureReturn #False
      EndIf
      
      ; #### Check if the header ends
      If *Client\HTTP_Header\RX_Pos >= 4
        If PeekL(*Client\HTTP_Header\Data + *Client\HTTP_Header\RX_Pos - 4) = 168626701 ; ### CR LF CR LF
          
          Temp_Text = PeekS(*Client\HTTP_Header\Data, *Client\HTTP_Header\RX_Pos-2, #PB_Ascii)
          FreeMemory(*Client\HTTP_Header\Data) : *Client\HTTP_Header\Data = #Null
          
          *Client\HTTP_Header\Request = StringField(Temp_Text, 1, #CRLF$)
          
          For i = 2 To CountString(Temp_Text, #CRLF$)
            Temp_Line = StringField(Temp_Text, i, #CRLF$)
            *Client\HTTP_Header\Field(LCase(StringField(Temp_Line, 1, ":"))) = Trim(StringField(Temp_Line, 2, ":"))
          Next
          
          ; #### Check if the request is correct
          ;TODO: Check if this mess works with most clients/browsers!
          If StringField(*Client\HTTP_Header\Request, 1, " ") = "GET"
            If LCase(*Client\HTTP_Header\Field("upgrade")) = "websocket"
              If FindString(LCase(*Client\HTTP_Header\Field("connection")), "upgrade")
                If Val(*Client\HTTP_Header\Field("sec-websocket-version")) = 13 And FindMapElement(*Client\HTTP_Header\Field(), "sec-websocket-key")
                  *Client\Mode = #Mode_Frames
                  *Client\Event_Connect = #True : ClientQueueEnqueue(*Object, *Client)
                  Response = "HTTP/1.1 101 Switching Protocols" + #CRLF$ +
                             "Upgrade: websocket" + #CRLF$ +
                             "Connection: Upgrade" + #CRLF$ +
                             "Sec-WebSocket-Accept: " + Generate_Key(*Client\HTTP_Header\Field("sec-websocket-key")) + #CRLF$ +
                             #CRLF$
                Else
                  *Client\Event_Disconnect_Manually = #True : ClientQueueEnqueue(*Object, *Client)
                  Response = "HTTP/1.1 400 Bad Request" + #CRLF$ +
                             "Content-Type: text/html" + #CRLF$ +
                             "Content-Length: 63" + #CRLF$ +
                             #CRLF$ +
                             "<html><head></head><body><h1>400 Bad Request</h1></body></html>"
                EndIf
              Else
                *Client\Event_Disconnect_Manually = #True : ClientQueueEnqueue(*Object, *Client)
                Response = "HTTP/1.1 400 WebSocket Upgrade Failure" + #CRLF$ +
                           "Content-Type: text/html" + #CRLF$ +
                           "Content-Length: 77" + #CRLF$ +
                           #CRLF$ +
                           "<html><head></head><body><h1>400 WebSocket Upgrade Failure</h1></body></html>"
              EndIf
            Else
              *Client\Event_Disconnect_Manually = #True : ClientQueueEnqueue(*Object, *Client)
              Response = "HTTP/1.1 404 Not Found" + #CRLF$ +
                         "Content-Type: text/html" + #CRLF$ +
                         "Content-Length: 61" + #CRLF$ +
                         #CRLF$ +
                         "<html><head></head><body><h1>404 Not Found</h1></body></html>"
            EndIf
          Else
            *Client\Event_Disconnect_Manually = #True : ClientQueueEnqueue(*Object, *Client)
            Response = "HTTP/1.1 405 Method Not Allowed" + #CRLF$ +
                       "Content-Type: text/html" + #CRLF$ +
                       "Content-Length: 70" + #CRLF$ +
                       #CRLF$ +
                       "<html><head></head><body><h1>405 Method Not Allowed</h1></body></html>"
          EndIf
          
          ; #### Misuse a frame for the HTTP response
          LastElement(*Client\TX_Frame())
          If AddElement(*Client\TX_Frame())
            
            *Client\TX_Frame()\RxTx_Size = StringByteLength(Response, #PB_Ascii)
            *Client\TX_Frame()\Data = AllocateMemory(*Client\TX_Frame()\RxTx_Size)
            If Not *Client\TX_Frame()\Data
              *Client\Event_Disconnect_Manually = #True : ClientQueueEnqueue(*Object, *Client)
              DeleteElement(*Client\TX_Frame())
              ProcedureReturn #False
            EndIf
            
            PokeS(*Client\TX_Frame()\Data, Response, -1, #PB_Ascii | #PB_String_NoZero)
            
          EndIf
          
          ProcedureReturn #True
        EndIf
      EndIf
      
    ForEver
    
    ProcedureReturn #True
  EndProcedure
  
  Procedure Thread_Receive_Frame(*Object.Object, *Client.Client)
    Protected Receive_Size.i
    Protected Result.i
    Protected *Temp_Data
    Protected Mask.l, *Pointer_Mask.Long
    Protected *Eight_Bytes.Eight_Bytes
    Protected *TempFrame.Frame
    Protected i
    
    If *Client\Event_Disconnect_Manually
      ; #### Read data into dummy memory to dump it. Otherwise this will be called over and over again, as there is "new" data.
      While tls_server::ReceiveData(*Client\ID, *DummyMemory, DummyMemorySize) > 0
        ;ReceiveNetworkData(*Client\ID, *DummyMemory, DummyMemorySize) > 0
      Wend
      ProcedureReturn #False
    EndIf
    
    Repeat
      
      ; #### Create new temporary frame if there is none yet.
      If Not *Client\New_RX_FRAME
        *Client\New_RX_FRAME = AllocateStructure(Frame) ; This will be purged when the frame is fully received, when the client is deleted or when the server is freed.
        If Not *Client\New_RX_FRAME
          *Client\Event_Disconnect_Manually = #True : ClientQueueEnqueue(*Object, *Client)
          ProcedureReturn #False
        EndIf
        *Client\New_RX_FRAME\RxTx_Size = 2
      EndIf
      
      *TempFrame = *Client\New_RX_FRAME
      
      ; #### Check if the frame exceeds the max. frame-size.
      If *TempFrame\Payload_Size > *Object\Frame_Payload_Max
        Client_Disconnect_Mutexless(*Object, *Client, #CloseStatusCode_SizeLimit)
        ProcedureReturn #False
      EndIf
      
      ; #### Check if a control frame exceeds the max. payload size.
      If *TempFrame\Payload_Size > #Frame_Control_Payload_Max
        ; #### Control frames are identified by opcodes where the most significant bit of the opcode is 1.
        If *TempFrame\RxTx_Pos >= 1 And *TempFrame\Data\Byte[0] & %00001000 = %1000
          Client_Disconnect_Mutexless(*Object, *Client, #CloseStatusCode_ProtocolError)
          ProcedureReturn #False
        EndIf
      EndIf
      
      ; #### Manage memory
      If Not *TempFrame\Data
        *TempFrame\Data = AllocateMemory(#Frame_Data_Size_Min) ; This will be purged when the client is deleted or when the server is freed, otherwise it will be reused in RX_Frame.
        If Not *TempFrame\Data
          *Client\Event_Disconnect_Manually = #True : ClientQueueEnqueue(*Object, *Client)
          ProcedureReturn #False
        EndIf
      EndIf
      If MemorySize(*TempFrame\Data) < *TempFrame\RxTx_Size + 3                   ; #### Add 3 bytes so that the (de)masking doesn't write outside of the buffer
        *Temp_Data = ReAllocateMemory(*TempFrame\Data, *TempFrame\RxTx_Size + 3)
        If *Temp_Data
          *TempFrame\Data = *Temp_Data
        Else
          *Client\Event_Disconnect_Manually = #True : ClientQueueEnqueue(*Object, *Client)
          ProcedureReturn #False
        EndIf
      EndIf
      
      ; #### Calculate how many bytes need to be received
      Receive_Size = *TempFrame\RxTx_Size - *TempFrame\RxTx_Pos
      
      ; #### Receive...
      Result = tls_server::ReceiveData(*Client\ID, *TempFrame\Data + *TempFrame\RxTx_Pos, Receive_Size)
      ;ReceiveNetworkData(*Client\ID, *TempFrame\Data + *TempFrame\RxTx_Pos, Receive_Size)
      If Result > 0
        *TempFrame\RxTx_Pos + Result
      Else
        ProcedureReturn #False
      EndIf
      
      ; #### Recalculate the size of the current frame (Only if all data is received)
      If *TempFrame\RxTx_Pos >= *TempFrame\RxTx_Size
        
        ; #### Size of the first 2 byte in the header
        *TempFrame\RxTx_Size = 2
        
        ; #### Determine the length of the payload
        Select *TempFrame\Data\Length\Length & %01111111
          Case 0 To 125
            *TempFrame\Payload_Size = *TempFrame\Data\Length\Length & %01111111
            
          Case 126
            *TempFrame\RxTx_Size + 2
            If *TempFrame\RxTx_Pos = *TempFrame\RxTx_Size
              *Eight_Bytes = @*TempFrame\Payload_Size
              *Eight_Bytes\Byte[1] = *TempFrame\Data\Length\Extended[0]
              *Eight_Bytes\Byte[0] = *TempFrame\Data\Length\Extended[1]
            EndIf
            
          Case 127
            *TempFrame\RxTx_Size + 8
            If *TempFrame\RxTx_Pos = *TempFrame\RxTx_Size
              *Eight_Bytes = @*TempFrame\Payload_Size
              *Eight_Bytes\Byte[7] = *TempFrame\Data\Length\Extended[0]
              *Eight_Bytes\Byte[6] = *TempFrame\Data\Length\Extended[1]
              *Eight_Bytes\Byte[5] = *TempFrame\Data\Length\Extended[2]
              *Eight_Bytes\Byte[4] = *TempFrame\Data\Length\Extended[3]
              *Eight_Bytes\Byte[3] = *TempFrame\Data\Length\Extended[4]
              *Eight_Bytes\Byte[2] = *TempFrame\Data\Length\Extended[5]
              *Eight_Bytes\Byte[1] = *TempFrame\Data\Length\Extended[6]
              *Eight_Bytes\Byte[0] = *TempFrame\Data\Length\Extended[7]
            EndIf
            
        EndSelect
        
        If *TempFrame\RxTx_Pos >= *TempFrame\RxTx_Size
          
          ; #### Add the payload length to the size of the frame data
          *TempFrame\RxTx_Size + *TempFrame\Payload_Size
          
          ; #### Check if there is a mask
          If *TempFrame\Data\Byte[1] & %10000000
            *TempFrame\RxTx_Size + 4
          EndIf
          
          *TempFrame\Payload_Pos = *TempFrame\RxTx_Size - *TempFrame\Payload_Size
          
        EndIf
        
      EndIf
      
      ; #### Check if the frame is received completely.
      If *TempFrame\RxTx_Pos >= *TempFrame\RxTx_Size
        
        ; #### (De)masking
        If *TempFrame\Data\Byte[1] & %10000000
          ; #### Get mask
          Mask = PeekL(*TempFrame\Data + *TempFrame\Payload_Pos - 4)
          
          ; #### XOr mask
          *Pointer_Mask = *TempFrame\Data + *TempFrame\Payload_Pos
          For i = 0 To *TempFrame\Payload_Size-1 Step 4
            *Pointer_Mask\l = *Pointer_Mask\l ! Mask
            *Pointer_Mask + 4
          Next
          
        EndIf
        
        ; #### Move this frame into the RX_Frame list.
        LastElement(*Client\RX_Frame())
        If AddElement(*Client\RX_Frame())
          *Client\RX_Frame()\Data = *TempFrame\Data
          *Client\RX_Frame()\Payload_Pos = *TempFrame\Payload_Pos
          *Client\RX_Frame()\Payload_Size = *TempFrame\Payload_Size
          *Client\RX_Frame()\RxTx_Pos = *TempFrame\RxTx_Pos
          *Client\RX_Frame()\RxTx_Size = *TempFrame\RxTx_Size
        EndIf
        
        ClientQueueEnqueue(*Object, *Client)
        
        ; #### Remove temporary frame, but don't free the memory, as it is used in the RX_Frame list now.
        FreeStructure(*Client\New_RX_FRAME) : *Client\New_RX_FRAME = #Null
        
      EndIf
      
    ForEver
    
    ProcedureReturn #True
  EndProcedure
  
  Procedure Thread_Transmit(*Object.Object, *Client.Client)
    Protected Transmit_Size.i
    Protected Result.i
    
    While FirstElement(*Client\TX_Frame())
      
      Transmit_Size = *Client\TX_Frame()\RxTx_Size - *Client\TX_Frame()\RxTx_Pos
      
      If Transmit_Size > 0
        ; #### Some data needs to be sent
        Result = tls_server::SendData(*Client\ID, *Client\TX_Frame()\Data + *Client\TX_Frame()\RxTx_Pos, Transmit_Size)
        ;SendNetworkData(*Client\ID, *Client\TX_Frame()\Data + *Client\TX_Frame()\RxTx_Pos, Transmit_Size)
        If Result > 0
          *Client\TX_Frame()\RxTx_Pos + Result
        Else
          ProcedureReturn #False
        EndIf
      EndIf
      
      Transmit_Size = *Client\TX_Frame()\RxTx_Size - *Client\TX_Frame()\RxTx_Pos
      
      If Transmit_Size <= 0
        ; #### Frame can be deleted
        FreeMemory(*Client\TX_Frame()\Data) : *Client\TX_Frame()\Data = #Null
        DeleteElement(*Client\TX_Frame())
        
        ; #### The event thread may have to handle stuff, send a signal.
        If ListSize(*Client\TX_Frame()) = 0
          ClientQueueEnqueue(*Object, *Client)
        EndIf
      EndIf
      
    Wend
    
    ProcedureReturn #True
  EndProcedure
  
  Procedure Thread(*Object.Object)
    Protected Busy, Counter, ms
    Protected *Client.Client
    
    Repeat
      ; #### Network Events
      Counter = 0
      Repeat
        LockMutex(*Object\Mutex)
        Select NetworkServerEvent(*Object\Server_ID)
          Case #PB_NetworkEvent_None
            UnlockMutex(*Object\Mutex)
            Break
            
          Case #PB_NetworkEvent_Connect
            LastElement(*Object\Client())
            If AddElement(*Object\Client())
              *Object\Client()\ConnectTimeout = ElapsedMilliseconds() + #ClientConnectTimeout
              *Object\Client()\ID = EventClient()
              tls_server::UpgradeConn(*Object\Client()\ID)
            EndIf
            Counter + 1
            
          Case #PB_NetworkEvent_Disconnect
            If Client_Select(*Object, EventClient())
              tls_server::CloseConn(*Object\Client()\ID)
              *Object\Client()\ID = #Null : ClientQueueEnqueue(*Object, *Object\Client()) ; #### The application can still read all incoming frames. The client will be deleted after all incoming frames have been read.
            EndIf
            Counter + 1
            
          Case #PB_NetworkEvent_Data
            If Client_Select(*Object, EventClient())
              Select *Object\Client()\Mode
                Case #Mode_Handshake  : Thread_Receive_Handshake(*Object, *Object\Client())
                Case #Mode_Frames     : Thread_Receive_Frame(*Object, *Object\Client())
              EndSelect
            EndIf
            Counter + 1
            
        EndSelect
        UnlockMutex(*Object\Mutex)
        
        If ListSize(*Object\ClientQueue()) > 100
          Delay(1)
        EndIf
        
      Until Counter > 10
      
      ; #### Busy when there was at least one network event
      Busy = Bool(Counter > 0)
      
      ;While Event_Callback(*Object, *Object\Event_Thread_Callback)
      ;Wend
      
      LockMutex(*Object\Mutex)
      ;Debug "Queue: " + ListSize(*Object\ClientQueue()) + "  Clients: " + ListSize(*Object\Client())
      ms = ElapsedMilliseconds()
      ForEach *Object\Client()
        *Client = *Object\Client()
        
        ; #### Send Data.
        If *Client\ID
          Busy | Bool(Thread_Transmit(*Object, *Client) = #False)
        EndIf
        
        ; #### Handle timeouts: Check if a client timed out before the handshake was successful.
        If *Client\ConnectTimeout And *Client\ConnectTimeout <= ms
          ClientQueueEnqueue(*Object, *Client)
        EndIf
        
        ; #### Handle timeouts: Disconnect timeout, so the client has some time to receive its disconnect message.
        If *Client\DisconnectTimeout And *Client\DisconnectTimeout <= ms
          ClientQueueEnqueue(*Object, *Client)
        EndIf
      Next
      UnlockMutex(*Object\Mutex)
      
      ; #### Delay only if there is nothing to do
      If Not Busy
        Delay(1)
      EndIf
      
    Until *Object\Free
    
    tls_server::CloseServer(*Object\Server_ID)
    ;CloseNetworkServer(*Object\Server_ID)
    *Object\Server_ID = #Null
    
    ; No need to care about the event thread, as it is shut down before cleanup happens here
    ForEach *Object\Client()
      ClientQueueRemove(*Object, *Object\Client())
      Client_Free(*Object\Client())
    Next
    
    If *Object\ClientQueueSemaphore
      FreeSemaphore(*Object\ClientQueueSemaphore) : *Object\ClientQueueSemaphore = #Null
    EndIf
    
    FreeMutex(*Object\Mutex) : *Object\Mutex = #Null
    FreeStructure(*Object)
  EndProcedure
  
  Procedure Thread_Events(*Object.Object)
    Repeat
      ; #### Wait for client queue entries.
      ClientQueueWait(*Object)
      
      ;Debug "New events to process"
      
      ; #### Process all events and callbacks. It's important that all events are processed.
      While Event_Callback(*Object, *Object\Event_Thread_Callback) And Not *Object\Free_Event
        ;Debug "Processed one event"
      Wend
      ;Debug "Processed all events"
    Until *Object\Free_Event
  EndProcedure
  
  Procedure Frame_Send_Mutexless(*Object.Object, *Client.Client, FIN.a, RSV.a, Opcode.a, *Payload, Payload_Size.q)
    Protected *Pointer.Ascii
    Protected *Eight_Bytes.Eight_Bytes
    
    If Not *Object
      ProcedureReturn #False
    EndIf
    
    If Not *Client
      ProcedureReturn #False
    EndIf
    
    If Not *Client\ID Or *Client\Event_Disconnect_Manually
      ProcedureReturn #False
    EndIf
    
    If Payload_Size < 0
      ProcedureReturn #False
    EndIf
    
    If Not *Payload
      Payload_Size = 0
    EndIf
    
    ; #### Special case: Connection close request (or answer).
    If Opcode = #Opcode_Connection_Close
      *Client\Event_Disconnect_Manually = #True : ClientQueueEnqueue(*Object, *Client)
      
      ; #### Remove all TX_Frame elements (Except the one that is being sent right now).
      While LastElement(*Client\TX_Frame()) And ListIndex(*Client\TX_Frame()) > 0
        If *Client\TX_Frame()\Data
          FreeMemory(*Client\TX_Frame()\Data) : *Client\TX_Frame()\Data = #Null
        EndIf
        DeleteElement(*Client\TX_Frame())
      Wend
    EndIf
    
    LastElement(*Client\TX_Frame())
    If AddElement(*Client\TX_Frame())
      
      *Client\TX_Frame()\Data = AllocateMemory(10 + Payload_Size)
      If Not *Client\TX_Frame()\Data
        *Client\Event_Disconnect_Manually = #True : ClientQueueEnqueue(*Object, *Client)
        ProcedureReturn #False
      EndIf
      
      ; #### FIN, RSV and Opcode
      *Pointer = *Client\TX_Frame()\Data
      *Pointer\a = (FIN & 1) << 7 | (RSV & %111) << 4 | (Opcode & %1111) : *Pointer + 1
      *Client\TX_Frame()\RxTx_Size + 1
      
      ; #### Payload_Size and extended stuff
      Select Payload_Size
        Case 0 To 125
          *Pointer\a = Payload_Size       : *Pointer + 1
          *Client\TX_Frame()\RxTx_Size + 1
        Case 126 To 65535
          *Eight_Bytes = @Payload_Size
          *Pointer\a = 126                  : *Pointer + 1
          *Pointer\a = *Eight_Bytes\Byte[1] : *Pointer + 1
          *Pointer\a = *Eight_Bytes\Byte[0] : *Pointer + 1
          *Client\TX_Frame()\RxTx_Size + 3
        Default
          *Eight_Bytes = @Payload_Size
          *Pointer\a = 127                  : *Pointer + 1
          *Pointer\a = *Eight_Bytes\Byte[7] : *Pointer + 1
          *Pointer\a = *Eight_Bytes\Byte[6] : *Pointer + 1
          *Pointer\a = *Eight_Bytes\Byte[5] : *Pointer + 1
          *Pointer\a = *Eight_Bytes\Byte[4] : *Pointer + 1
          *Pointer\a = *Eight_Bytes\Byte[3] : *Pointer + 1
          *Pointer\a = *Eight_Bytes\Byte[2] : *Pointer + 1
          *Pointer\a = *Eight_Bytes\Byte[1] : *Pointer + 1
          *Pointer\a = *Eight_Bytes\Byte[0] : *Pointer + 1
          *Client\TX_Frame()\RxTx_Size + 9
      EndSelect
      
      If *Payload
        CopyMemory(*Payload, *Pointer, Payload_Size)
        ;*Pointer + Payload_Size
        *Client\TX_Frame()\RxTx_Size + Payload_Size
      EndIf
      
      ProcedureReturn #True
    EndIf
    
    ProcedureReturn #False
  EndProcedure
  
  Procedure Frame_Send(*Object.Object, *Client.Client, FIN.a, RSV.a, Opcode.a, *Payload, Payload_Size.q)
    Protected Result
    
    If Not *Object
      ProcedureReturn #False
    EndIf
    
    LockMutex(*Object\Mutex)
    Result = Frame_Send_Mutexless(*Object, *Client, FIN, RSV, Opcode, *Payload, Payload_Size)
    UnlockMutex(*Object\Mutex)
    
    ProcedureReturn Result
  EndProcedure
  
  Procedure Frame_Text_Send(*Object.Object, *Client.Client, Text.s)
    Protected *Temp, Temp_Size.i
    Protected Result
    
    Temp_Size = StringByteLength(Text, #PB_UTF8)
    If Temp_Size = 0
      ProcedureReturn Frame_Send(*Object, *Client, #True, 0, #Opcode_Text, #Null, 0)
    EndIf
    If Temp_Size < 0
      ProcedureReturn #False
    EndIf
    *Temp = AllocateMemory(Temp_Size)
    If Not *Temp
      *Client\Event_Disconnect_Manually = #True : ClientQueueEnqueue(*Object, *Client)
      ProcedureReturn #False
    EndIf
    
    PokeS(*Temp, Text, -1, #PB_UTF8 | #PB_String_NoZero)
    
    Result = Frame_Send(*Object, *Client, #True, 0, #Opcode_Text, *Temp, Temp_Size)
    
    FreeMemory(*Temp)
    
    ProcedureReturn Result
  EndProcedure
  
  Procedure Event_Callback(*Object.Object, *Callback.Event_Callback)
    Protected Event_Frame.Event_Frame
    Protected *Client.Client
    Protected *Frame_Data.Frame_Header
    Protected MalformedFrame.i
    Protected TempOffset.i
    
    If Not *Object
      ProcedureReturn #False
    EndIf
    
    If Not *Callback
      ProcedureReturn #False
    EndIf
    
    LockMutex(*Object\Mutex)
    
    *Client = ClientQueueDequeue(*Object)
    If Not *Client
      UnlockMutex(*Object\Mutex)
      ProcedureReturn #False
    EndIf
    
    Repeat
      
      ; #### Event: Client connected and handshake was successful.
      If *Client\Event_Connect
        *Client\Event_Connect = #False
        *Client\ConnectTimeout = 0
        *Client\External_Reference = #True
        ClientQueueEnqueue(*Object, *Client)
        UnlockMutex(*Object\Mutex)
        *Callback(*Object, *Client, #Event_Connect)
        LockMutex(*Object\Mutex)
        Continue
      EndIf
      
      ; #### Connect and handshake timeout. The client will be enqueued for this in Thread().
      If *Client\ConnectTimeout And *Client\ConnectTimeout <= ElapsedMilliseconds()
        *Client\Event_Disconnect_Manually = #True
      EndIf
      
      ; #### Event: Client disconnected (TCP connection got terminated) (Only return this event if there are no incoming frames left to be read by the application)
      If *Client\ID = #Null And ListSize(*Client\RX_Frame()) = 0
        If *Client\External_Reference
          UnlockMutex(*Object\Mutex)
          *Callback(*Object, *Client, #Event_Disconnect)
          LockMutex(*Object\Mutex)
        EndIf
        ; #### Delete the client and all its data.
        ClientQueueRemove(*Object, *Client)
        Client_Free(*Client)
        ChangeCurrentElement(*Object\Client(), *Client)
        DeleteElement(*Object\Client())
        Break
      EndIf
      
      ; #### Disconnect timeout. The client will be enqueued for this in Thread().
      If *Client\Event_Disconnect_Manually And Not *Client\DisconnectTimeout
        *Client\DisconnectTimeout = ElapsedMilliseconds() + #ClientDisconnectTimeout
      EndIf
      
      ; #### Event: Close connection (By the user of the library, by any error that forces a disconnect or by an incoming disconnect request of the client via ws control frame) (Only close the connection if there are no frames left)
      If *Client\Event_Disconnect_Manually And (ListSize(*Client\TX_Frame()) = 0 Or *Client\DisconnectTimeout <= ElapsedMilliseconds()) And ListSize(*Client\RX_Frame()) = 0
        ; #### Forward event to application, but only if there was a connect event for this client before
        If *Client\External_Reference
          UnlockMutex(*Object\Mutex)
          *Callback(*Object, *Client, #Event_Disconnect)
          LockMutex(*Object\Mutex)
        EndIf
        If *Client\ID
          tls_server::CloseConn(*Client\ID)
          ;CloseNetworkConnection(*Client\ID)
          *Client\ID = #Null
        EndIf
        ; #### Delete the client and all its data.
        ClientQueueRemove(*Object, *Client)
        Client_Free(*Client)
        ChangeCurrentElement(*Object\Client(), *Client)
        DeleteElement(*Object\Client())
        Break
      EndIf
      
      ; #### Event: Frame available
      If FirstElement(*Client\RX_Frame())
        *Frame_Data = *Client\RX_Frame()\Data : *Client\RX_Frame()\Data = #Null
        
        Event_Frame\Fin = *Frame_Data\Byte[0] >> 7 & %00000001
        Event_Frame\RSV = *Frame_Data\Byte[0] >> 4 & %00000111
        Event_Frame\Opcode = *Frame_Data\Byte[0] & %00001111
        Event_Frame\Payload = *Frame_Data + *Client\RX_Frame()\Payload_Pos
        Event_Frame\Payload_Size = *Client\RX_Frame()\Payload_Size
        Event_Frame\FrameData = *Frame_Data : *Frame_Data = #Null
        
        ; #### Remove RX_Frame. Its data is either freed below, after it has been read by the user/application, or it is freed in the fragmentation handling code, or when the user is deleted, or when the server is freed.
        DeleteElement(*Client\RX_Frame())
        
        ; #### Enqueue again. Either because there are still frames to be read by the user, or because there are no frames anymore and the client can disconnect.
        ClientQueueEnqueue(*Object, *Client)
        
        ; #### Check if any extension bit is set. This lib doesn't support any extensions.
        If Event_Frame\RSV <> 0
          MalformedFrame = #True
        EndIf
        
        ; #### Check if a control frame is being fragmented.
        If Bool(Event_Frame\Opcode & %1000) And Event_Frame\Fin = #False
          MalformedFrame = #True
        EndIf
        
        ; #### Do default actions for specific opcodes.
        If Not MalformedFrame
          Select Event_Frame\Opcode
            Case #Opcode_Continuation       ; continuation frame
            Case #Opcode_Text               ; text frame
              ; TODO: Check if payload is a valid UTF-8 string and contains valid code points (There may be a corner case when frame fragments are split between code points)
            Case #Opcode_Binary             ; binary frame
            Case #Opcode_Connection_Close   ; connection close
              Protected statusCode.u, reason.s
              If Event_Frame\Payload_Size >= 2
                statusCode = PeekU(Event_Frame\Payload)
                statusCode = ((statusCode & $FF00) >> 8) | ((statusCode & $FF) << 8)
                reason = PeekS(Event_Frame\Payload + 2, Event_Frame\Payload_Size - 2, #PB_UTF8 | #PB_ByteLength)
              EndIf
              ; TODO: Check if status code is valid
              ; TODO: Check if reason is a valid UTF-8 string and contains valid code points
              Client_Disconnect_Mutexless(*Object, *Client, statusCode, reason)
            Case #Opcode_Ping               ; ping
              Frame_Send_Mutexless(*Object, *Client, #True, 0, #Opcode_Pong, Event_Frame\Payload, Event_Frame\Payload_Size)
            Case #Opcode_Pong               ; pong
            Default                         ; undefined
              MalformedFrame = #True
          EndSelect
        EndIf
        
        ; #### Coalesce frame fragments. This will prevent the application/user from receiving fragmented frames.
        ; #### Messy code, i wish there was something like go's defer and some other things.
        If Not MalformedFrame And *Object\HandleFragmentation
          If Not Event_Frame\Fin
            
            If Event_Frame\Opcode = #Opcode_Continuation
              ; #### This frame is in the middle of a fragment series.
              If Not LastElement(*Client\Fragments()) Or Not AddElement(*Client\Fragments())
                MalformedFrame = #True
              Else
                *Client\Fragments() = Event_Frame : Event_Frame\FrameData = #Null : Event_Frame\Payload = #Null
                *Client\Fragments_Size + Event_Frame\Payload_Size
                
                If *Client\Fragments_Size > #Frame_Fragmented_Payload_Max
                  MalformedFrame = #True
                Else
                  Continue ; Don't forward the frame to the user/application.
                EndIf
              EndIf
            Else
              ; #### This frame is the beginning of a fragment series.
              If ListSize(*Client\Fragments()) > 0
                ; #### Another fragment series is already started. Interleaving with other fragments is not allowed.
                MalformedFrame = #True
              Else
                LastElement(*Client\Fragments())
                If Not AddElement(*Client\Fragments())
                  MalformedFrame = #True
                Else
                  *Client\Fragments() = Event_Frame : Event_Frame\FrameData = #Null : Event_Frame\Payload = #Null
                  *Client\Fragments_Size + Event_Frame\Payload_Size
                  
                  If *Client\Fragments_Size > #Frame_Fragmented_Payload_Max
                    MalformedFrame = #True
                  Else
                    Continue ; Don't forward the frame to the user/application.
                  EndIf
                EndIf
              EndIf
            EndIf
          Else
            If Event_Frame\Opcode = #Opcode_Continuation
              ; #### This frame is the end of a fragment series.
              LastElement(*Client\Fragments())
              If Not AddElement(*Client\Fragments())
                MalformedFrame = #True
              Else
                *Client\Fragments() = Event_Frame : Event_Frame\FrameData = #Null : Event_Frame\Payload = #Null
                *Client\Fragments_Size + Event_Frame\Payload_Size
                
                If *Client\Fragments_Size > #Frame_Fragmented_Payload_Max
                  MalformedFrame = #True
                Else
                  
                  ; #### Combine fragments, overwrite Event_Frame to simulate one large incoming frame.
                  If FirstElement(*Client\Fragments())
                    If *Client\Fragments()\Opcode <> #Opcode_Binary And *Client\Fragments()\Opcode <> #Opcode_Text
                      MalformedFrame = #True
                    Else
                      Event_Frame\Fin = #True
                      Event_Frame\RSV = 0
                      Event_Frame\Opcode = *Client\Fragments()\Opcode
                      Event_Frame\FrameData = AllocateMemory(*Client\Fragments_Size+1)
                      Event_Frame\Payload = Event_Frame\FrameData
                      Event_Frame\Payload_Size = *Client\Fragments_Size
                      If Not Event_Frame\FrameData
                        MalformedFrame = #True
                      Else
                        While FirstElement(*Client\Fragments())
                          CopyMemory(*Client\Fragments()\Payload, Event_Frame\Payload + TempOffset, *Client\Fragments()\Payload_Size) : TempOffset + *Client\Fragments()\Payload_Size
                          FreeMemory(*Client\Fragments()\FrameData) : *Client\Fragments()\FrameData = #Null
                          DeleteElement(*Client\Fragments())
                        Wend
                      EndIf
                    EndIf
                  EndIf
                  
                EndIf
              EndIf
            Else
              ; #### This frame is a normal unfragmented frame.
              If Not Bool(Event_Frame\Opcode & %1000) And ListSize(*Client\Fragments()) > 0
                ; #### This frame is not a control frame, but there is a started series of fragmented frames.
                MalformedFrame = #True
              EndIf
            EndIf
           EndIf
        EndIf
        
        If MalformedFrame
          ; #### Close connection as the frame is malformed in some way.
          Client_Disconnect_Mutexless(*Object, *Client, #CloseStatusCode_ProtocolError)
        Else
          ; #### Forward event to application/user.
          UnlockMutex(*Object\Mutex)
          *Callback(*Object, *Client, #Event_Frame, Event_Frame)
          LockMutex(*Object\Mutex)
        EndIf
        
        If Event_Frame\FrameData
          FreeMemory(Event_Frame\FrameData) : Event_Frame\FrameData = #Null
        EndIf
        
        Continue
      EndIf
      
      Break
    ForEver
    
    UnlockMutex(*Object\Mutex)
    ProcedureReturn #True
  EndProcedure
  
  Procedure.i Get_HTTP_Header(*Client.Client)
    If Not *Client
      ProcedureReturn #Null
    EndIf
    
    ProcedureReturn *Client\HTTP_Header
  EndProcedure
  
  Procedure Client_Disconnect_Mutexless(*Object.Object, *Client.Client, statusCode.u=0, reason.s="")
    If Not *Object
      ProcedureReturn #False
    EndIf
    
    If Not *Client
      ProcedureReturn #False
    EndIf
    
    If statusCode
      Protected tempSize = 2 + StringByteLength(reason, #PB_UTF8)
      Protected *tempMemory = AllocateMemory(tempSize)
      If Not *tempMemory
        *Client\Event_Disconnect_Manually = #True : ClientQueueEnqueue(*Object, *Client)
        ProcedureReturn #False
      EndIf
      PokeU(*tempMemory, ((statusCode & $FF00) >> 8) | ((statusCode & $FF) << 8))
      If StringByteLength(reason, #PB_UTF8) > 0
        PokeS(*tempMemory + 2, reason, -1, #PB_UTF8 | #PB_String_NoZero)
      EndIf
      Frame_Send_Mutexless(*Object, *Client, 1, 0, #Opcode_Connection_Close, *tempMemory, tempSize) ; This will also set the \Event_Disconnect_Manually flag
      FreeMemory(*tempMemory)
    Else
      Frame_Send_Mutexless(*Object, *Client, 1, 0, #Opcode_Connection_Close, #Null, 0) ; This will also set the \Event_Disconnect_Manually flag
    EndIf
    
    ProcedureReturn #True
  EndProcedure
  
  Procedure Client_Disconnect(*Object.Object, *Client.Client, statusCode.u=0, reason.s="")
    Protected Result
    
    If Not *Object
      ProcedureReturn #False
    EndIf
    
    LockMutex(*Object\Mutex)
    Result = Client_Disconnect_Mutexless(*Object, *Client, statusCode, reason)
    UnlockMutex(*Object\Mutex)
    
    ProcedureReturn Result
  EndProcedure
  
  Procedure Create(Port, *Event_Thread_Callback.Event_Callback=#Null, Frame_Payload_Max.q=#Frame_Payload_Max, HandleFragmentation=#True)
    Protected *Object.Object
    
    *Object = AllocateStructure(Object)
    If Not *Object
      ProcedureReturn #Null
    EndIf
    
    *Object\Frame_Payload_Max = Frame_Payload_Max
    *Object\HandleFragmentation = HandleFragmentation
    *Object\Event_Thread_Callback = *Event_Thread_Callback
    
    *Object\Mutex = CreateMutex()
    If Not *Object\Mutex
      FreeStructure(*Object)
      ProcedureReturn #Null
    EndIf
    
    If *Event_Thread_Callback
      *Object\ClientQueueSemaphore = CreateSemaphore()
      If Not *Object\ClientQueueSemaphore
        FreeMutex(*Object\Mutex) : *Object\Mutex = #Null
        FreeStructure(*Object)
        ProcedureReturn #Null
      EndIf
    EndIf
    
    *Object\Server_ID = CreateNetworkServer(#PB_Any, Port, #PB_Network_TCP)
    Debug tls_server::ServerUpgrade(*Object\Server_ID,"fullchain.pem")
    If Not *Object\Server_ID
      FreeMutex(*Object\Mutex) : *Object\Mutex = #Null
      If *Object\ClientQueueSemaphore : FreeSemaphore(*Object\ClientQueueSemaphore) : *Object\ClientQueueSemaphore = #Null : EndIf
      FreeStructure(*Object)
      ProcedureReturn #Null
    EndIf
    
    *Object\Network_Thread_ID = CreateThread(@Thread(), *Object)
    If Not *Object\Network_Thread_ID
      FreeMutex(*Object\Mutex) : *Object\Mutex = #Null
      If *Object\ClientQueueSemaphore : FreeSemaphore(*Object\ClientQueueSemaphore) : *Object\ClientQueueSemaphore = #Null : EndIf
      tls_server::CloseServer(*Object\Server_ID)
      ;CloseNetworkServer(*Object\Server_ID)
      *Object\Server_ID = #Null
      FreeStructure(*Object)
      ProcedureReturn #Null
    EndIf
    
    If *Event_Thread_Callback
      *Object\Event_Thread_ID = CreateThread(@Thread_Events(), *Object)
      If Not *Object\Event_Thread_ID
        *Object\Free = #True
        ProcedureReturn #Null
      EndIf
    EndIf
    
    ProcedureReturn *Object
  EndProcedure
  
  Procedure Free(*Object.Object)
    If Not *Object
      ProcedureReturn #False
    EndIf
    
    ; #### Fetch thread ID here, because the *Object is invalid some time after *Object\Free is set true
    Protected Network_Thread_ID.i = *Object\Network_Thread_ID
    
    If *Object\Event_Thread_ID
      *Object\Free_Event = #True
      SignalSemaphore(*Object\ClientQueueSemaphore) ; Misuse the semaphore to get the event thread to quit.
      WaitThread(*Object\Event_Thread_ID)
    EndIf
    *Object\Free = #True
    If Network_Thread_ID
      WaitThread(Network_Thread_ID)
    EndIf
    
    ProcedureReturn #True
  EndProcedure
  
EndModule
Modified server code.
Sorry my English, I'm Russian
AMT Laboratory
lesserpanda
User
User
Posts: 65
Joined: Tue Feb 11, 2020 7:50 am

Re: WebSocket Server

Post by lesserpanda »

Hello, quick question ...

So I want to drop any connections that persistently starts a new connection that is not a user for example. I find out via searching in DB for the user.

I want to drop the request or block the request so it doesn't saturate my server.

Is there a unique key that I can use for that particular origin? I would think IP Address + Origin port but looking through all the HTTP_Header\Field() Map, I wasn't able to find that out.

Any directions much appreciated.


Thanks
Post Reply