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.