Code: Select all
;
; A websocket server example
;
; https://www.purebasic.fr/english/viewtopic.php?p=426768#p426768
;
EnableExplicit
CompilerIf Not #PB_Compiler_Thread
MessageRequester("Info", "You have To enable 'Thread-Safe'")
End
CompilerEndIf
#ServerSideMasking = #True
CompilerIf #ServerSideMasking
#ServerSideMaskOffset = 4
CompilerElse
#ServerSideMaskOffset = 0
CompilerEndIf
#SpecifcationGUID = "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"
Enumeration WebsocketOpcodes
#ContinuationFrame
#TextFrame
#BinaryFrame
#Reserved3Frame
#Reserved4Frame
#Reserved5Frame
#Reserved6Frame
#Reserved7Frame
#ConnectionCloseFrame
#PingFrame
#PongFrame
#ReservedBFrame
#ReservedCFrame
#ReservedDFrame
#ReservedEFrame
#ReservedFFrame
EndEnumeration
Enumeration
#ReceiveText
#ReceiveEdit
#TransmitText
#TransmitEdit
#TransmitCombo
#TransmitButton
#DisconnectButton
EndEnumeration
Structure ClientInfoStructure
Handshake.i
EndStructure
Structure ServerStructure
Quit.i
Map Client.ClientInfoStructure()
EndStructure
Procedure.s SecWebsocketAccept(SecWebSocketKey.s)
Protected KeyHash.s, SecWebsocketAccept.s, *KeyHash, *KeyHashPtr.Ascii, i.i
KeyHash = StringFingerprint(SecWebSocketKey + #SpecifcationGUID, #PB_Cipher_SHA1, 0, #PB_Ascii)
*KeyHash = AllocateMemory(20, #PB_Memory_NoClear)
If *KeyHash
*KeyHashPtr = *KeyHash
For i = 1 To 40 Step 2
*KeyHashPtr\a = Val("$" + Mid(KeyHash, i, 2))
*KeyHashPtr + 1
Next i
SecWebsocketAccept = Base64Encoder(*KeyHash, MemorySize(*KeyHash))
FreeMemory(*KeyHash)
EndIf
ProcedureReturn SecWebsocketAccept
EndProcedure
Procedure.i Websocket_SendTextFrame(ClientID.i, Text$)
Protected.a Byte
Protected.i Result, Length, Add, i, Ptr
Protected *Buffer
Protected Dim Key.a(3)
Length = StringByteLength(Text$, #PB_UTF8)
Debug Length
If Length < 65535
If Length < 126
Add = 2 + #ServerSideMaskOffset
Else
Add = 4 + #ServerSideMaskOffset
EndIf
*Buffer = AllocateMemory(Length + Add + 1)
If *Buffer
Ptr = 0
Byte = %10000000 | #TextFrame
PokeA(*Buffer + Ptr, Byte)
Ptr + 1
If Add = 2 + #ServerSideMaskOffset
CompilerIf #ServerSideMasking
PokeA(*Buffer + Ptr, %10000000 | Length)
CompilerElse
PokeA(*Buffer + Ptr, %00000000 | Length)
CompilerEndIf
Ptr + 1
Else
CompilerIf #ServerSideMasking
PokeA(*Buffer + Ptr, %10000000 | 126)
CompilerElse
PokeA(*Buffer + Ptr, %00000000 | 126)
CompilerEndIf
Ptr + 1
PokeA(*Buffer + Ptr, Length >> 8)
Ptr + 1
PokeA(*Buffer + Ptr, Length & $FF)
Ptr + 1
EndIf
CompilerIf #ServerSideMasking
For i = 0 To 3
Key(i) = Random(255)
PokeA(*Buffer + Ptr + i, Key(i))
Next i
Ptr + 4
CompilerEndIf
PokeS(*Buffer + Ptr, Text$, -1, #PB_UTF8)
CompilerIf #ServerSideMasking
For i = 0 To Length - 1
PokeA(*Buffer + Ptr + i, PeekA(*Buffer + Ptr + i) ! Key(i % 4))
Next i
CompilerEndIf
If SendNetworkData(ClientID, *Buffer, Length + Add) > 0
Result = #True
EndIf
FreeMemory(*Buffer)
EndIf
EndIf
ProcedureReturn Result
EndProcedure
Procedure WebSocket_ClientDisconnect(ClientID.i, *Server.ServerStructure)
Protected.i i
For i = 0 To MapSize(*Server\Client())
If GetGadgetItemData(#TransmitCombo, i) = ClientID
RemoveGadgetItem(#TransmitCombo, i)
SetGadgetState(#TransmitCombo, 0)
Break
EndIf
Next i
DeleteMapElement(*Server\Client(), Str(ClientId))
StatusBarText(0, 1, "Clients: " + Str(MapSize(*Server\Client())), #PB_StatusBar_Center)
If MapSize(*Server\Client()) = 0
DisableGadget(#TransmitButton, #True)
DisableGadget(#DisconnectButton, #True)
EndIf
;SetGadgetText(#ReceiveText, "")
EndProcedure
Procedure WebSocket_Server(*Server.ServerStructure)
Protected.i SEvent, ClientID, handshake, i, ClientIP, GadgetItem, ReceivedBytes
Protected *Buffer
Protected Header$, Key$, Accept$, Body$
Protected Byte.a
Protected.i Fin, Opcode, Masked, Payload, Ptr, n, Pos1, Pos2
Protected Dim MaskKey.a(3)
*Buffer = AllocateMemory(10240)
If *Buffer
Repeat
SEvent = NetworkServerEvent()
If SEvent
ClientID = EventClient()
ClientIP = GetClientIP(ClientID)
Select SEvent
Case #PB_NetworkEvent_Connect
AddMapElement(*Server\Client(), Str(ClientID))
StatusBarText(0, 1, "Clients: " + Str(MapSize(*Server\Client())), #PB_StatusBar_Center)
DisableGadget(#TransmitButton, #False)
DisableGadget(#DisconnectButton, #False)
;AddGadgetItem(#TransmitCombo, -1, Str(ClientID))
AddGadgetItem(#TransmitCombo, -1, IPString(ClientIP) + " - " + Str(ClientID))
GadgetItem = CountGadgetItems(#TransmitCombo) - 1
SetGadgetItemData(#TransmitCombo, GadgetItem, ClientID)
SetGadgetState(#TransmitCombo, GadgetItem)
Debug "A new client has connected !"
Case #PB_NetworkEvent_Data
FillMemory(*Buffer, 10000)
ReceivedBytes = ReceiveNetworkData(ClientID, *Buffer, 1000)
Debug "Recv: " + Str(ReceivedBytes)
If Not *Server\Client(Str(ClientID))\Handshake
Header$ = PeekS(*Buffer, ReceivedBytes, #PB_UTF8)
Pos1 = FindString(Header$, "Sec-WebSocket-Key: ")
If Pos1
Pos1 + 19
Pos2 = FindString(Header$, #CRLF$, Pos1)
If Pos2
Key$ = Mid(Header$, Pos1, Pos2 - Pos1)
Accept$ = SecWebsocketAccept(Key$)
EndIf
EndIf
Header$ = "HTTP/1.1 101 Switching Protocols" + #CRLF$
Header$ + "Upgrade: WebSocket"+ #CRLF$
Header$ + "Connection: Upgrade"+ #CRLF$
Header$ + "Sec-WebSocket-Accept: " + Accept$ + #CRLF$
Header$ + #CRLF$
SendNetworkString(ClientID, Header$)
*Server\Client(Str(ClientID))\Handshake = #True
Else
Ptr = 0
Byte = PeekA(*Buffer + Ptr)
If Byte & %10000000
Fin = #True
Else
Fin = #False
EndIf
Opcode = Byte & %00001111
Ptr = 1
Debug "Fin:" + Str(Fin)
Debug "Opcode: " + Str(Opcode)
Byte = PeekA(*Buffer + Ptr)
Masked = Byte >> 7
Payload = Byte & $7F
Ptr + 1
If Payload = 126
Payload = PeekA(*Buffer + Ptr) << 8
Ptr + 1
Payload | PeekA(*Buffer + Ptr)
Ptr + 1
ElseIf Payload = 127
Payload = 0
n = 7
For i = Ptr To Ptr + 7
Payload | PeekA(*Buffer + i) << (8 * n)
n - 1
Next i
Ptr + 8
EndIf
Debug "Masked: " + Str(Masked)
Debug "Payload: " + Str(Payload)
If Masked
n = 0
For i = Ptr To Ptr + 3
MaskKey(n) = PeekA(*Buffer + i)
Debug "MaskKey " + Str(n + 1) + ": " + RSet(Hex(MaskKey(n)), 2, "0")
n + 1
Next i
Ptr + 4
EndIf
Select Opcode
Case #TextFrame
If Masked
n = 0
For i = Ptr To Ptr + Payload - 1
PokeA(*Buffer + i, PeekA(*Buffer + i) ! MaskKey(n % 4))
n + 1
Next i
EndIf
Body$ = PeekS(*Buffer + Ptr, Payload, #PB_UTF8)
AddGadgetItem(#ReceiveEdit, -1, IPString(ClientIP) + "-" + Str(ClientID) + ": " + Body$)
Case #ConnectionCloseFrame
WebSocket_ClientDisconnect(ClientID, *Server)
Case #PingFrame
Byte = PeekA(*Buffer) & %11110000
PokeA(*Buffer, Byte | #PongFrame)
SendNetworkData(ClientID, *Buffer, ReceivedBytes)
Default
Debug "Opcode not implemented yet!"
EndSelect
EndIf
Case #PB_NetworkEvent_Disconnect
WebSocket_ClientDisconnect(ClientID, *Server)
EndSelect
Else
Delay(10)
EndIf
Until *Server\Quit
FreeMemory(*Buffer)
EndIf
EndProcedure
;-main
Define.i Port, Exit, WindowEvent, Thread
Define Server.ServerStructure
If InitNetwork() = 0
MessageRequester("Error", "Can't initialize the network !", 0)
End
EndIf
UseSHA1Fingerprint()
Port = 800
If CreateNetworkServer(0, Port)
OpenWindow(0, 0, 0, 640, 400, "WebSocket Server", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
TextGadget(#ReceiveText, 10, 10, 60, 20, "Received")
EditorGadget(#ReceiveEdit, 80, 10, 500, 150)
TextGadget(#TransmitText, 10, 180, 60, 20, "Transmit")
EditorGadget(#TransmitEdit, 80, 180, 500, 150)
ComboBoxGadget(#TransmitCombo, 80, 340, 180, 20)
ButtonGadget(#TransmitButton, 280, 340, 80, 20, "Transmit")
DisableGadget(#TransmitButton, #True)
ButtonGadget(#DisconnectButton, 370, 340, 80, 20, "Disconnect")
DisableGadget(#DisconnectButton, #True)
CreateStatusBar(0, WindowID(0))
AddStatusBarField(70)
AddStatusBarField(100)
StatusBarText(0, 0, "Port: " + Str(Port), #PB_StatusBar_Center)
StatusBarText(0, 1, "Clients: 0", #PB_StatusBar_Center)
Thread = CreateThread(@WebSocket_Server(), @Server)
Exit = #False
Repeat
WindowEvent = WaitWindowEvent()
Select WindowEvent
Case #PB_Event_Gadget
Select EventGadget()
Case #TransmitButton
If Websocket_SendTextFrame(GetGadgetItemData(#TransmitCombo, GetGadgetState(#TransmitCombo)), GetGadgetText(#TransmitEdit))
SetGadgetText(#TransmitEdit, "")
EndIf
SetActiveGadget(#TransmitEdit)
Case #DisconnectButton
CloseNetworkConnection(GetGadgetItemData(#TransmitCombo, GetGadgetState(#TransmitCombo)))
WebSocket_ClientDisconnect(GetGadgetItemData(#TransmitCombo, GetGadgetState(#TransmitCombo)), @Server)
EndSelect
Case #PB_Event_CloseWindow
Exit = #True
EndSelect
Until Exit
If IsThread(Thread)
Server\Quit = #True
WaitThread(Thread, 1000)
EndIf
CloseNetworkServer(0)
Else
MessageRequester("Error", "Can't create the server (port in use ?).", 0)
EndIf
End
Open it in more than one browser tab/window.
Transmit 'close' to close the web socket.