Websocket server problem

Just starting out? Need help? Post your questions and find answers here.
karu
Enthusiast
Enthusiast
Posts: 255
Joined: Fri Jan 13, 2006 12:14 am

Websocket server problem

Post by karu »

Hi and sorry my bad english

I want create websocket server. First i need to handshake width client, this is ok, all handshake messages go through and is understandable but real messages after handshake from client are senseless. Weird also that every time server get different messages although client send same message all time.

Code: Select all

    handshake.l
    Port.l = 800
    vastus.s
    headeririda.s
    vastusvoti.s 

    If InitNetwork() = 0
      MessageRequester("Error", "Can't initialize the network !", 0)
      End
    EndIf

    Procedure.s SecWebsocketAccept(SecWebSocketKey.s)

      heex.s
      sheex.s


      SpecifcationGUID.s = "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"
      FullWebSocketKey.s = SecWebSocketKey + SpecifcationGUID
      *Buffer = AllocateMemory(Len(FullWebSocketKey))
      PokeS(*Buffer, FullWebSocketKey)
      KeyHash.s = SHA1Fingerprint(*Buffer, MemorySize(*Buffer))
      For i = 1 To Len(KeyHash) Step 2
        heex.s = Mid(KeyHash, i,2)
        sheex = sheex + Chr(Val("$"+heex))
      Next
      SecWebsocketAccept.s = Space(200)
      Base64Encoder(@sheex, StringByteLength(sheex), @SecWebsocketAccept, 200)

      ProcedureReturn  SecWebsocketAccept
     
    EndProcedure

    *Buffer = AllocateMemory(10000)

    If CreateNetworkServer(0, Port)
      Debug "Server created Port "+Str(Port)
     
      Repeat
         
        SEvent = NetworkServerEvent()
        If SEvent
          ClientID = EventClient()
          Select SEvent
         
            Case #PB_NetworkEvent_Connect
              Debug "A new client has connected !"
             
            Case #PB_NetworkEvent_Data
              FillMemory(*Buffer, 10000)
              bytesidkokku.l = ReceiveNetworkData(ClientID, *Buffer, 1000)
              If handshake = 0
                vastus = (PeekS(*Buffer,bytesidkokku))
                For i = 1 To CountString(vastus, Chr(13) + Chr(10))
                  headeririda = StringField(vastus,i,Chr(13) + Chr(10))
                  headeririda = RemoveString(headeririda, Chr(13))
                  headeririda = RemoveString(headeririda, Chr(10))
                  If Left(headeririda,19) = "Sec-WebSocket-Key: "
                    key.s = Right(headeririda, Len(headeririda) - 19)
                  EndIf
                  vastusvoti = SecWebsocketAccept(key)
                Next
                vastus = "HTTP/1.1 101 Switching Protocols" + Chr(13) + Chr(10)
                vastus = vastus + "Upgrade: WebSocket"+ Chr(13) + Chr(10)
                vastus = vastus + "Connection: Upgrade"+ Chr(13) + Chr(10)
                vastus = vastus + "Sec-WebSocket-Accept: " + vastusvoti + Chr(13) + Chr(10)+ Chr(13) + Chr(10)
                SendNetworkString(ClientID, vastus)
                handshake = 1
              Else
                vastus.s = (PeekS(*Buffer,bytesidkokku))
                Debug vastus
              EndIf
             
            Case #PB_NetworkEvent_Disconnect
              Debug "Client "+Str(ClientID)+" has closed the connection..."
              Quit = 1
       
          EndSelect
        EndIf
       
      Until Quit = 1
     
      CloseNetworkServer(0)
    Else
      MessageRequester("Error", "Can't create the server (port in use ?).", 0)
    EndIf

    End   
infratec
Always Here
Always Here
Posts: 7577
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Websocket server problem

Post by infratec »

Hi,

first:
without the cilient code it's difficult to find a real fault.

But:

use EnableExplicit
you use AllocateMemory() without FreeMemory()

Btw. you don't need *Buffer in SecWebsocketAccept()

Code: Select all

Procedure.s SecWebsocketAccept(SecWebSocketKey.s)
  
  Protected.i i
  Protected.s heex, sheex, SecWebsocketAccept, FullWebSocketKey, SpecifcationGUID, KeyHash
  
  
  SpecifcationGUID = "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"
  FullWebSocketKey = SecWebSocketKey + SpecifcationGUID
  
  KeyHash = SHA1Fingerprint(@FullWebSocketKey, Len(FullWebSocketKey))
  For i = 1 To Len(KeyHash) Step 2
    heex = Mid(KeyHash, i, 2)
    sheex = sheex + Chr(Val("$" + heex))
  Next
  SecWebsocketAccept = Space(Len(FullWebSocketKey) * 1.4)
  Base64Encoder(@sheex, StringByteLength(sheex), @SecWebsocketAccept, Len(SecWebsocketAccept))
  
  ProcedureReturn  SecWebsocketAccept
  
EndProcedure
Bernd
infratec
Always Here
Always Here
Posts: 7577
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Websocket server problem

Post by infratec »

Oh,

I found that

https://blogs.oracle.com/PavelBucek/ent ... ine_client

for testing.

Bernd
infratec
Always Here
Always Here
Posts: 7577
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Websocket server problem

Post by infratec »

Hi,

read RFC6455 :!:

The client sends his data in a frame.
You have to decode the frame.

Bernd
infratec
Always Here
Always Here
Posts: 7577
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Websocket server problem

Post by infratec »

A first hint without many checking for other stuff:

Code: Select all

EnableExplicit



#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



Procedure.s SecWebsocketAccept(SecWebSocketKey.s)
  
  Protected.i i
  Protected.s heex, sheex, SecWebsocketAccept, FullWebSocketKey, KeyHash
    
  
  FullWebSocketKey = SecWebSocketKey + #SpecifcationGUID
  
  KeyHash = SHA1Fingerprint(@FullWebSocketKey, Len(FullWebSocketKey))
  For i = 1 To Len(KeyHash) Step 2
   heex = Mid(KeyHash, i, 2)
   sheex = sheex + Chr(Val("$" + heex))
  Next
  SecWebsocketAccept = Space(Len(FullWebSocketKey) * 1.4)
  Base64Encoder(@sheex, StringByteLength(sheex), @SecWebsocketAccept, Len(SecWebsocketAccept))
  
  ProcedureReturn  SecWebsocketAccept
  
EndProcedure




Define.i Port, handshake, SEvent, ClientID, bytesidkokku, i, Quit
Define *Buffer
Define.s vastus, headeririda, vastusvoti, key

Define Byte.a
Define.i Fin, Opcode, Masked, Payload, Ptr, n
Dim MaskKey.a(3)

If InitNetwork() = 0
  MessageRequester("Error", "Can't initialize the network !", 0)
  End
EndIf


Port = 800
*Buffer = AllocateMemory(10000)

If CreateNetworkServer(0, Port)
  Debug "Server created Port " + Str(Port)
  
  Repeat
    
    SEvent = NetworkServerEvent()
    If SEvent
      ClientID = EventClient()
      Select SEvent
     
        Case #PB_NetworkEvent_Connect
          Debug "A new client has connected !"
         
        Case #PB_NetworkEvent_Data
          FillMemory(*Buffer, 10000)
          bytesidkokku = ReceiveNetworkData(ClientID, *Buffer, 1000)
          Debug "Recv: " + Str(bytesidkokku)
          If Not handshake
            vastus = PeekS(*Buffer, bytesidkokku)
            For i = 1 To CountString(vastus, #CRLF$)
              headeririda = StringField(vastus, i, #CRLF$)
              headeririda = RemoveString(headeririda, #CR$)
              headeririda = RemoveString(headeririda, #LF$)
              If Left(headeririda, 19) = "Sec-WebSocket-Key: "
                key = Right(headeririda, Len(headeririda) - 19)
              EndIf
              vastusvoti = SecWebsocketAccept(key)
            Next
            vastus = "HTTP/1.1 101 Switching Protocols" + #CRLF$
            vastus = vastus + "Upgrade: WebSocket"+ #CRLF$
            vastus = vastus + "Connection: Upgrade"+ #CRLF$
            vastus = vastus + "Sec-WebSocket-Accept: " + vastusvoti + #CRLF$ + #CRLF$
            SendNetworkString(ClientID, vastus)
            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
                  vastus = ""
                  n = 0
                  For i = Ptr To Ptr + Payload - 1
                    vastus + Chr(PeekA(*Buffer + i) ! MaskKey(n % 4))
                    n + 1
                  Next i
                Else
                  vastus = PeekS(*Buffer + Ptr, Payload)
                EndIf
                Debug vastus
              Case #PingFrame
                Byte = PeekA(*Buffer) & %11110000
                PokeA(*Buffer, Byte | #PongFrame)
                SendNetworkData(ClientID, *Buffer, bytesidkokku)
              Default
                Debug "Opcode not implemented yet!"
            EndSelect
          EndIf
         
        Case #PB_NetworkEvent_Disconnect
          Debug "Client " + Str(ClientID) + " has closed the connection..."
          Quit = #True
      EndSelect
      
    Else
      Delay(10)
    EndIf
    
  Until Quit
  
  CloseNetworkServer(0)
Else
  MessageRequester("Error", "Can't create the server (port in use ?).", 0)
EndIf

FreeMemory(*Buffer)

End
Bernd
infratec
Always Here
Always Here
Posts: 7577
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Websocket server problem

Post by infratec »

Extended the listing above.

Now it can also send pongs (as answer to a ping).

Bernd
karu
Enthusiast
Enthusiast
Posts: 255
Joined: Fri Jan 13, 2006 12:14 am

Re: Websocket server problem

Post by karu »

Thanks Bernd, its working :P
infratec
Always Here
Always Here
Posts: 7577
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Websocket server problem

Post by infratec »

Check my extensions above.

Now you can also implement a binary frame.

Bernd
karu
Enthusiast
Enthusiast
Posts: 255
Joined: Fri Jan 13, 2006 12:14 am

Re: Websocket server problem

Post by karu »

infratec wrote:Check my extensions above.

Now you can also implement a binary frame.

Bernd
Thanks, now i must figure out, how i can send messages from server after receiving messages, i tried SendNetworkString(ClientID, "some answer text..."), but it does not work, probably message text from server must also somehow format.
JavaScript

Code: Select all

<!DOCTYPE html>

<meta charset="utf-8" />

<title>WebSocket Test</title>

<script language="javascript" type="text/javascript">

  var wsUri = "ws://192.168.1.1:800";
  var output;

  function init()
  {
    output = document.getElementById("output");
    testWebSocket();
  }

  function testWebSocket()
  {
    websocket = new WebSocket(wsUri);
    websocket.onopen = function(evt) { onOpen(evt) };
    websocket.onclose = function(evt) { onClose(evt) };
    websocket.onmessage = function(evt) { onMessage(evt) };
    //websocket.onerror = function(evt) { onError(evt) };
  }

  function onOpen(evt)
  {
    writeToScreen("CONNECTED");
    doSend("WebSocket rocks");
  }

  function onClose(evt)
  {
    writeToScreen("DISCONNECTED");
  }

  function onMessage(evt)
  {
    writeToScreen('<span style="color: blue;">RESPONSE: ' + evt.data+'</span>');
    websocket.close();
  }

  function onError(evt)
  {
    writeToScreen('<span style="color: red;">ERROR:</span> ' + evt.data);
  }

  function doSend(message)
  {
    writeToScreen("SENT: " + message); 
    websocket.send(message);
  }

  function writeToScreen(message)
  {
    var pre = document.createElement("p");
    pre.style.wordWrap = "break-word";
    pre.innerHTML = message;
    output.appendChild(pre);
  }

  window.addEventListener("load", init, false);

</script>

<h2>WebSocket Test</h2>

<div id="output"></div>

</html> 
infratec
Always Here
Always Here
Posts: 7577
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Websocket server problem

Post by infratec »

You have to use the same frame format if you want to send something.

Again: read RFC6455

the frame format is described inside.
infratec
Always Here
Always Here
Posts: 7577
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Websocket server problem

Post by infratec »

Hi,

try this:

Code: Select all

Procedure.i Websocket_SendTextFrame(ClientID.i, Text$)
  
  Protected.a Byte
  Protected.i Result, Length, i
  Protected *Buffer
  Protected Dim Key.a(3)
  
  Length = Len(Text$)
  If Length < 126
    *Buffer = AllocateMemory(Length + 6)
    If *Buffer
      Byte = %10000000 | #TextFrame
      PokeA(*Buffer + 0, Byte)
      PokeA(*Buffer + 1, %10000000 | Length)
      
      For i = 0 To 3
        Key(i) = Random(255)
        PokeA(*Buffer + 2 + i, Key(i))
      Next i
      
      For i = 0 To Length - 1
        PokeA(*Buffer + 6 + i, PeekA(@Text$ + i) ! Key(i % 4))
      Next i
      
      If SendNetworkData(ClientID, *Buffer, MemorySize(*Buffer)) > 0
        Result = #True
      EndIf
      
      FreeMemory(*Buffer)
    EndIf
  EndIf
  
  ProcedureReturn Result
  
EndProcedure
Bernd
karu
Enthusiast
Enthusiast
Posts: 255
Joined: Fri Jan 13, 2006 12:14 am

Re: Websocket server problem

Post by karu »

Bernd, thanks again
infratec
Always Here
Always Here
Posts: 7577
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Websocket server problem

Post by infratec »

Hi,

a more or less complete Web Socket Server for multiple clients:

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
for easy testing:

Code: Select all

<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html>
 <head>
  <meta http-equiv="Content-Type" content="text/html;charset=utf-8">
  <title>WebSocket Test</title>

<script type="text/javascript">
  
  var wsUri = "ws://127.0.0.1:800";
  
  function init()
  {
    testWebSocket();
  }

  function testWebSocket()
  {
   websocket = new WebSocket(wsUri);
   websocket.onopen = function(evt) { onOpen(evt) };
   websocket.onclose = function(evt) { onClose(evt) };
   websocket.onmessage = function(evt) { onMessage(evt) };
   websocket.onerror = function(evt) { onError(evt) };
  }

  function onOpen(evt)
  {
   document.getElementById('status').innerHTML = "connected";
  }

  function onClose(evt)
  {
   document.getElementById('status').innerHTML = "disconnected";
  }

  function onMessage(evt)
  {
   document.getElementById('receive_text').value = evt.data;
  }

  function onError(evt)
  {
   document.getElementById('status').innerHTML = "Error " + evt.data;
  }
  
  function doSendInput()
  {
   websocket.send(document.getElementById('transmit_text').value);
   document.getElementById('transmit_text').value = "";
  }
  
  window.addEventListener("load", init, false);
  
</script>
 </head>
 <body>
  <h2>WebSocket Test</h2>
  
  <form name="chat" action="">
   <table>
    <tr>
     <td>Transmit:</td>
     <td><input name="transmit_text" id="transmit_text" type="text" size="30"></td>
     <td><input name="transmit_submit" type="button" value="Transmit" onClick="doSendInput()"></td>
    </tr>
    <tr>
     <td>Receive:</td>
     <td><input name="receive_text" id="receive_text" type="text" size="30"></td>
     <td></td>
    </tr>
    <tr>
     <td colspan="3" height="10"></td>
    </tr>
    <tr>
     <td>Status:</td>
     <td><div id="status"></div>
     <td></td>
    </tr>
   </table>
  </form>
  
 </body>
</html>
Open it in more than one browser tab/window.
Transmit 'close' to close the web socket.

Or use: https://blogs.oracle.com/PavelBucek/ent ... ine_client

Bernd
Last edited by infratec on Wed Jan 26, 2022 11:50 am, edited 9 times in total.
infratec
Always Here
Always Here
Posts: 7577
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Websocket server problem

Post by infratec »

Updated the stuff above:

1. Web page can now also transmit
2. Show also ip address of the browser

Bernd
karu
Enthusiast
Enthusiast
Posts: 255
Joined: Fri Jan 13, 2006 12:14 am

Re: Websocket server problem

Post by karu »

Problem! I write äääääääää or üüüüüüüüüüü etc to pb client, webclient disconnects (ERROR: undefined), why?
Post Reply