Page 1 of 2

Websocket Client

Posted: Wed Dec 02, 2015 2:21 pm
by Netzvamp
I've developed an websocket client.

This is not a SERVER, this is a CLIENT who connect to a server.

I've developed it to query an external API/Service running on a websocket-server.

It's not fully tested, and misses some features (look TODO in source), but works with the testserver at echo.websocket.org.

https://gist.github.com/Netzvamp/8623def14501de15c9e4

My question to improve it further:
Is there an easy way to open an encrypted (TSL/SSL) connections to send raw data? Looks like Win32-API is only for HTTPS, but not usable for websockets and not crossplatform.
I've seen cryptlib, does anyone have experience with this lib? Are there better solutions?

Re: Websocket Client

Posted: Wed Dec 02, 2015 2:33 pm
by infratec

Re: Websocket Client

Posted: Wed Dec 02, 2015 2:55 pm
by Netzvamp
Yes, i know them. But these are SERVERS, this is an CLIENT who connect to an server. I've developed it, cause i have an external API-Server/Service based on websocket and i needed to query data with purebasic.

Re: Websocket Client

Posted: Sun Aug 26, 2018 2:47 pm
by nimda
Hello, just to notice a little bug: pong answer has to be masked, or the server disconnects you. Great script though, thank you Netzvamp :wink:

Re: Websocket Client

Posted: Fri Oct 30, 2020 7:58 pm
by Kwai chang caine
Someone have a simple PHP websocket server code who works with this great client ?

I have found this and not understand how use it, because there are also an IP to enter on the server and the client :shock:
https://medium.com/@cn007b/super-simple ... 2cd5893575

Code: Select all

<?php

$address = '0.0.0.0';
$port = 12345;

// Create WebSocket.
$server = socket_create(AF_INET, SOCK_STREAM, SOL_TCP);
socket_set_option($server, SOL_SOCKET, SO_REUSEADDR, 1);
socket_bind($server, $address, $port);
socket_listen($server);
$client = socket_accept($server);

// Send WebSocket handshake headers.
$request = socket_read($client, 5000);
preg_match('#Sec-WebSocket-Key: (.*)\r\n#', $request, $matches);
$key = base64_encode(pack(
    'H*',
    sha1($matches[1] . '258EAFA5-E914-47DA-95CA-C5AB0DC85B11')
));
$headers = "HTTP/1.1 101 Switching Protocols\r\n";
$headers .= "Upgrade: websocket\r\n";
$headers .= "Connection: Upgrade\r\n";
$headers .= "Sec-WebSocket-Version: 13\r\n";
$headers .= "Sec-WebSocket-Accept: $key\r\n\r\n";
socket_write($client, $headers, strlen($headers));

// Send messages into WebSocket in a loop.
while (true) {
    sleep(1);
    $content = 'Now: ' . time();
    $response = chr(129) . chr(strlen($content)) . $content;
    socket_write($client, $response);
}?>

Re: Websocket Client

Posted: Sat Oct 31, 2020 10:18 am
by infratec
You don't need to enter tne server IP :wink:

0.0.0.0 means that it listens on all interfaces.
Only if you want to restrict it to one interface, you have to change it to the IP of the interface you want to use.
But since a server has fixed IP addresses you only need to do this once.

Re: Websocket Client

Posted: Sat Oct 31, 2020 3:36 pm
by Kwai chang caine
Waaaahh !!! finaly a good news 8) after all this search without succes :|
So you say to me, normally this two codes above must work ? :shock:
I have try several time without succes yesterday ....
Good...i try another time today, now i know that can works, perhaps i have missing something :wink:

What adress i must write ?

Code: Select all

Http://www.myserver.fr/my/path/index.php
Http://www.myserver.fr
www.myserver.fr

Re: Websocket Client

Posted: Sun Nov 01, 2020 8:33 pm
by infratec
To start the 'server' you have to call
http://www.myserver.fr/my/path/index.php

But yout client needs to communicate with www.myserver.fr port 12345

Re: Websocket Client

Posted: Sun Nov 01, 2020 8:40 pm
by Kwai chang caine
Thanks INFRATEC for your precious explanation, that works now 8)
But after several try, i discovered WebSocket lock the loop and wait client request :|
So one time more, it's not what i search to do :|
I want each part can send to other everytime, and the other answer if he want....but apparently, it's not simple in PHP :|
I continue my searchs.....again thanks 8)

Re: Websocket Client

Posted: Sat Mar 23, 2024 5:13 am
by skinkairewalker
I'm trying to use this code to stress test a websocket server, but the client simply crashes without reporting any errors.

screenshot : https://prnt.sc/9OhwqmUCwg7y

Does anyone have any idea what could be happening?

Code: Select all

; Websocketclient by Netzvamp
; Version: 2016/01/08

DeclareModule WebsocketClient
  Declare OpenWebsocketConnection(URL.s)
  Declare SendTextFrame(connection, message.s)
  Declare ReceiveFrame(connection, *MsgBuffer)
  Declare SetSSLProxy(ProxyServer.s = "", ProxyPort.l = 8182)
  
  Enumeration
    #frame_text
    #frame_binary
    #frame_closing
    #frame_ping
    #frame_unknown
  EndEnumeration
  
EndDeclareModule

Module WebsocketClient
  
  ;TODO: Add function to send binary frame
  ;TODO: We don't support fragmetation right now
  ;TODO: We should send an closing frame, but server will also just close
  ;TODO: Support to send receive bigger frames
  
  Declare Handshake(Connection, Servername.s, Path.s)
  Declare ApplyMasking(Array Mask.a(1), *Buffer)
  
  Global Proxy_Server.s, Proxy_Port.l
  
  Macro dbg(txt)
    CompilerIf #PB_Compiler_Debugger
      Debug "WebsocketClient: " + FormatDate("%yyyy-%mm-%dd %hh:%ii:%ss",Date()) + " > " + txt
    CompilerEndIf
  EndMacro
  
  Procedure SetSSLProxy(ProxyServer.s = "", ProxyPort.l = 8182)
    Proxy_Server.s = ProxyServer.s
    Proxy_Port.l = ProxyPort.l
  EndProcedure
  
  Procedure OpenWebsocketConnection(URL.s)
    Protokol.s = GetURLPart(URL.s, #PB_URL_Protocol)
    Servername.s = GetURLPart(URL.s, #PB_URL_Site)
    Port.l = Val(GetURLPart(URL.s, #PB_URL_Port))
    If Port.l = 0 : Port.l = 80 : EndIf
    Path.s = GetURLPart(URL.s, #PB_URL_Path)
    If Path.s = "" : Path.s = "/" : EndIf
    

    If Protokol.s = "wss" ; If we connect with encryption (https)
      If Proxy_Port
        Connection = OpenNetworkConnection(Proxy_Server.s, Proxy_Port.l, #PB_Network_TCP, 1000)
      Else
        dbg("We need an SSL-Proxy like stunnel for encryption. Configure the proxy with SetSSLProxy().")
      EndIf
    ElseIf Protokol.s = "ws"
      Connection = OpenNetworkConnection(Servername.s, Port.l, #PB_Network_TCP, 1000)
    EndIf
    
    If Connection
      If Handshake(Connection, Servername.s, Path.s)
        dbg("Connection and Handshake ok")
        ProcedureReturn Connection
      Else
        dbg("Handshake-Error")
        ProcedureReturn #False
      EndIf
    Else
      dbg("Couldn't connect")
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure Handshake(Connection, Servername.s, Path.s)
    Request.s = "GET /" + Path.s + " HTTP/1.1"+ #CRLF$ +
                "Host: " + Servername.s + #CRLF$ +
                "Upgrade: websocket" + #CRLF$ +
                "Connection: Upgrade" + #CRLF$ +
                "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==" + #CRLF$ +
                "Sec-WebSocket-Version: 13" + #CRLF$ + 
                "User-Agent: CustomWebsocketClient"+ #CRLF$ + #CRLF$
                
    SendNetworkString(Connection, Request.s, #PB_UTF8)
    *Buffer = AllocateMemory(65536)
    
    ; We wait for answer
    Repeat
      Size = ReceiveNetworkData(connection, *Buffer, 65536)
      Answer.s = Answer.s + PeekS(*Buffer, Size, #PB_UTF8)
      If FindString(Answer, #CRLF$ + #CRLF$)
        Break
      EndIf
    Until Size <> 65536
    
    Answer.s = UCase(Answer.s)
    
    ; Check answer
    If FindString(Answer.s, "HTTP/1.1 101") And FindString(Answer.s, "CONNECTION: UPGRADE") And FindString(Answer.s, "UPGRADE: WEBSOCKET")
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure ApplyMasking(Array Mask.a(1), *Buffer)
    For i = 0 To MemorySize(*Buffer) - 1
      PokeA(*Buffer + i, PeekA(*Buffer + i) ! Mask(i % 4))
    Next
  EndProcedure
  
  Procedure SendTextFrame(connection, message.s)
    
    ; Put String in Buffer
    MsgLength.l = StringByteLength(message.s, #PB_UTF8)
    *MsgBuffer = AllocateMemory(MsgLength)
    PokeS(*MsgBuffer, message.s, MsgLength, #PB_UTF8|#PB_String_NoZero)
    
    dbg("Messagelength to send: " + Str(MsgLength))
    
    ; The Framebuffer, we fill with senddata
    If MsgLength <= 125
      Fieldlength = 6
    ElseIf MsgLength >= 126 And MsgLength <= 65535
      Fieldlength = 8
    Else
      Fieldlength = 14
    EndIf
    
    dbg("Fieldlength to send: " + Str(Fieldlength))
    
    
    *FrameBuffer = AllocateMemory(Fieldlength + MsgLength)
    
    ; We generate 4 random masking bytes
    Dim Mask.a(3)
    Mask(0) = Random(255,0)
    Mask(1) = Random(255,0) 
    Mask(2) = Random(255,0) 
    Mask(3) = Random(255,0) 
    
    pos = 0 ; The byteposotion in the framebuffer
    
    ; First Byte: FIN(1=finished with this Frame),RSV(0),RSV(0),RSV(0),OPCODE(4 byte)=0001(text) 
    PokeB(*FrameBuffer, %10000001) : pos + 1 ; = 129
    
    ; Second Byte: Masking(1),length(to 125bytes, else we have to extend)
    If MsgLength <= 125                                             ; Length fits in first byte
      PokeA(*Framebuffer + pos, MsgLength + 128)    : pos + 1       ; + 128 for Masking
    ElseIf MsgLength >= 126 And MsgLength <= 65535                  ; We have to extend length to third byte
      PokeA(*Framebuffer + pos, 126 + 128)          : pos + 1       ; 126 for 2 extra length bytes and + 128 for Masking
      PokeA(*FrameBuffer + pos, (MsgLength >> 8))   : pos + 1       ; First Byte
      PokeA(*FrameBuffer + pos, MsgLength)          : pos + 1       ; Second Byte
    Else                                                            ; It's bigger than 65535, we also use 8 extra bytes
      PokeA(*Framebuffer + pos, 127 + 128)          : pos + 1       ; 127 for 8 extra length bytes and + 128 for Masking
      PokeA(*Framebuffer + pos, 0)                  : pos + 1       ; 8 Bytes for payload lenght. We don't support giant packages for now, so first bytes are zero :P
      PokeA(*Framebuffer + pos, 0)                  : pos + 1
      PokeA(*Framebuffer + pos, 0)                  : pos + 1
      PokeA(*Framebuffer + pos, 0)                  : pos + 1
      PokeA(*Framebuffer + pos, MsgLength >> 24)    : pos + 1
      PokeA(*Framebuffer + pos, MsgLength >> 16)    : pos + 1
      PokeA(*Framebuffer + pos, MsgLength >> 8)     : pos + 1
      PokeA(*Framebuffer + pos, MsgLength)          : pos + 1       ; = 10 Byte
    EndIf
    ; Write Masking Bytes
    PokeA(*FrameBuffer + pos, Mask(0))              : pos + 1
    PokeA(*FrameBuffer + pos, Mask(1))              : pos + 1
    PokeA(*FrameBuffer + pos, Mask(2))              : pos + 1
    PokeA(*FrameBuffer + pos, Mask(3))              : pos + 1
    
    ApplyMasking(Mask(), *MsgBuffer)
    
    CopyMemory(*MsgBuffer, *FrameBuffer + pos, MsgLength)
    
    ;For x = 0 To 100 Step 5
      ;Debug Str(PeekA(*FrameBuffer + x)) + " | " + Str(PeekA(*FrameBuffer + x + 1)) + " | " + Str(PeekA(*FrameBuffer + x + 2)) + " | " + Str(PeekA(*FrameBuffer + x + 3)) + " | " + Str(PeekA(*FrameBuffer + x + 4))
    ;Next
    
    If SendNetworkData(connection, *FrameBuffer, Fieldlength + MsgLength) = Fieldlength + MsgLength
      dbg("Textframe send, Bytes: " + Str(Fieldlength + MsgLength))
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
    
  EndProcedure
  
  Procedure ReceiveFrame(connection, *MsgBuffer)
    
    *FrameBuffer = AllocateMemory(65536)
    
    Repeat
      *FrameBuffer = ReAllocateMemory(*FrameBuffer, 65536)
      Size = ReceiveNetworkData(connection, *FrameBuffer, 65536)
      ;Answer.s = Answer.s + PeekS(*FrameBuffer, Size, #PB_UTF8)
    Until Size <> 65536
    
    dbg("Received Frame, Bytes: " + Str(Size))
    
    *FrameBuffer = ReAllocateMemory(*FrameBuffer, Size)
    
    ;     ; debug: output any single byte
    ;     If #PB_Compiler_Debugger
    ;       For x = 0 To Size - 1 Step 1
    ;         dbg_bytes.s + Str(PeekA(*FrameBuffer + x)) + " | "
    ;       Next
    ;       dbg(dbg_bytes)
    ;     EndIf
    
    ; Getting informations about package
    If PeekA(*FrameBuffer) & %10000000 > #False
      ;dbg("Frame not fragmented")
      fragmentation.b = #False
    Else
      dbg("Frame fragmented! This not supported for now!")
      fragmentation.b = #True
    EndIf
    
    ; Check for Opcodes
    If PeekA(*FrameBuffer) = %10000001 ; Textframe
      dbg("Text frame")
      frame_typ.w = #frame_text
    ElseIf PeekA(*FrameBuffer) = %10000010 ; Binary Frame
      dbg("Binary frame")
      frame_typ.w = #frame_binary
    ElseIf PeekA(*FrameBuffer) = %10001000 ; Closing Frame
      dbg("Closing frame")
      frame_typ.w = #frame_closing
    ElseIf PeekA(*FrameBuffer) = %10001001 ; Ping
      ; We just answer pings
      *pongbuffer = AllocateMemory(2)
      PokeA(*pongbuffer, 138)
      PokeA(*pongbuffer+1, 0)
      SendNetworkData(connection, *pongbuffer, 2)
      dbg("Received Ping, answered with Pong")
      frame_typ.w = #frame_ping
      ProcedureReturn
    Else
      dbg("Opcode unknown")
      frame_typ.w = #frame_unknown
      ProcedureReturn #False
    EndIf
    
    ; Check masking
    If PeekA(*FrameBuffer + 1) & %10000000 = 128 : masking.b = #True : Else : masking.b = #False : EndIf
    
    dbg("Masking: " + Str(masking))
    
    pos.l = 1
    
    ; check size
    If PeekA(*FrameBuffer + 1) & %01111111 <= 125 ; size is in this byte
      frame_size.l = PeekA(*FrameBuffer + pos) & %01111111 : pos + 1
    ElseIf PeekA(*FrameBuffer + 1) & %01111111 >= 126 ; Size is in 2 extra bytes
      frame_size.l = PeekA(*FrameBuffer + 2) << 8 + PeekA(*FrameBuffer + 3) : pos + 2
    EndIf
    dbg("FrameSize: " + Str(frame_size.l))
    
    If masking = #True
      Dim Mask.a(3)
      Mask(0) = PeekA(*FrameBuffer + pos) : pos + 1
      Mask(1) = PeekA(*FrameBuffer + pos) : pos + 1
      Mask(2) = PeekA(*FrameBuffer + pos) : pos + 1
      Mask(3) = PeekA(*FrameBuffer + pos) : pos + 1
      
      ReAllocateMemory(*MsgBuffer,frame_size)
      CopyMemory(*FrameBuffer + pos, *MsgBuffer, frame_size)
      
      ApplyMasking(Mask(), *MsgBuffer)
    Else
      ReAllocateMemory(*MsgBuffer,frame_size)
      CopyMemory(*FrameBuffer + pos, *MsgBuffer, frame_size)
    EndIf
    
    ProcedureReturn frame_typ
    
  EndProcedure
  
EndModule


CompilerIf #PB_Compiler_IsMainFile
  
  ; Minimal example to send and receive textmessages
  ; The preconfigured testserver "echo.websocket.org" will just echo back everything you've send.

  
  Global connection
  
  connection = WebsocketClient::OpenWebsocketConnection("ws://localhost:80/game/ws")
  
  Debug "Connected on game/ws"
  
    
  
  ; Proxy Setting:
  ; If you need an encyrpted connection (https/wss), you currently have to use an 
  ; proxy software like stunnel (https://www.stunnel.org) to redirect unencrypted data into an encrypted connection
  ; Example stunnel.conf section:
  ;   [websocket]
  ;   client = yes
  ;   accept = 127.0.0.1:8182
  ;   connect = echo.websocket.org:443
  ;WebsocketClient::SetSSLProxy("127.0.0.1",8182)
  
  Repeat
    
    If connection
      
      NetworkEvent = NetworkClientEvent(connection)
      
      Select NetworkEvent
          
        Case #PB_NetworkEvent_Data
          Debug "We've got Data"
          *FrameBuffer = AllocateMemory(1)
          Frametyp = WebsocketClient::ReceiveFrame(connection,*FrameBuffer)
          If Frametyp = WebsocketClient::#frame_text
            Debug  "< " + PeekS(*FrameBuffer,MemoryStringLength(*FrameBuffer,#PB_UTF8|#PB_ByteLength),#PB_UTF8|#PB_ByteLength) 
            If WebsocketClient::SendTextFrame(connection, "HelloWorldServer.") = #False
              Debug "Couldn't send. Are we disconnected?"
            EndIf 
          ElseIf Frametyp = WebsocketClient::#frame_binary
            Debug  "< Received Binaryframe" 
          EndIf
          
        Case #PB_NetworkEvent_Disconnect
          If disconnected = #False
            Debug "Disconnected"
          EndIf
          disconnected = #True
          NetworkEvent = #PB_NetworkEvent_None
          
        Case #PB_NetworkEvent_None
          
      EndSelect
      
    EndIf
  ForEver
  
CompilerEndIf

Re: Websocket Client

Posted: Thu Sep 19, 2024 12:41 pm
by dige
May be using Purifier (Compiler options) enable helps? And set PurifierGranularity(1, 1, 1, 1)

Re: Websocket Client

Posted: Tue Apr 15, 2025 7:21 am
by stevie1401
I've set up a WebSocket test server.

Accessible at ws://doko-cafe.de:8090

I used the code from Dadio3:

Code: Select all

Structure Chat_Message
  Type.s
  Author.s
  Message.s
  Timestamp.q
EndStructure

Structure Chat_Username_Change
  Type.s
  Username.s
EndStructure

Structure Chat_Userlist
  Type.s
  
  List Username.s()
EndStructure

Structure Client
  *WebSocket_Client
  
  Username.s
EndStructure

Global NewList Client.Client()

XIncludeFile "Includes/WebSocket_Server.pbi"

Procedure WebSocket_Event(*Server, *Client, Event, *Event_Frame.WebSocket_Server::Event_Frame)
  Protected Chat_Message.Chat_Message
  Protected Chat_Username_Change.Chat_Username_Change
  Protected Chat_Userlist.Chat_Userlist
  Protected JSON_ID.i
  Protected JSON2_ID.i
  Protected JSON_String.s
  
  Select Event
    Case WebSocket_Server::#Event_Connect
      PrintN(" #### Client connected: " + *Client)
      AddElement(Client())
      Client()\WebSocket_Client = *Client
      
      JSON2_ID = CreateJSON(#PB_Any)
      If JSON2_ID
        
        Chat_Userlist\Type = "Userlist"
        ForEach Client()
          AddElement(Chat_Userlist\UserName())
          Chat_Userlist\UserName() = Client()\Username
        Next
        
        InsertJSONStructure(JSONValue(JSON2_ID), Chat_Userlist, Chat_Userlist)
        
        WebSocket_Server::Frame_Text_Send(*Server, *Client, ComposeJSON(JSON2_ID))
        
        FreeJSON(JSON2_ID)
      EndIf
      
    Case WebSocket_Server::#Event_Disconnect
      PrintN(" #### Client disconnected: " + *Client)
      ForEach Client()
        If Client()\WebSocket_Client = *Client
          DeleteElement(Client())
          Break
        EndIf
      Next
      
      JSON2_ID = CreateJSON(#PB_Any)
      If JSON2_ID
        
        Chat_Userlist\Type = "Userlist"
        ForEach Client()
          AddElement(Chat_Userlist\UserName())
          Chat_Userlist\UserName() = Client()\Username
        Next
        
        InsertJSONStructure(JSONValue(JSON2_ID), Chat_Userlist, Chat_Userlist)
        
        JSON_String = ComposeJSON(JSON2_ID)
        ForEach Client()
          WebSocket_Server::Frame_Text_Send(*Server, Client()\WebSocket_Client, JSON_String)
        Next
        
        FreeJSON(JSON2_ID)
      EndIf
      
    Case WebSocket_Server::#Event_Frame
      Select *Event_Frame\Opcode
        Case WebSocket_Server::#Opcode_Ping
          PrintN(" #### Ping from *Client " + *Client)
        Case WebSocket_Server::#Opcode_Text
          JSON_ID = ParseJSON(#PB_Any, PeekS(*Event_Frame\Payload, *Event_Frame\Payload_Size, #PB_UTF8|#PB_ByteLength))
          If JSON_ID
            
            Select GetJSONString(GetJSONMember(JSONValue(JSON_ID), "Type"))
              Case "Message"
                ExtractJSONStructure(JSONValue(JSON_ID), Chat_Message, Chat_Message)
                PrintN(Chat_Message\Author + ": " + Chat_Message\Message)
                
                Debug PeekS(*Event_Frame\Payload, *Event_Frame\Payload_Size, #PB_UTF8|#PB_ByteLength)
                
                JSON2_ID = CreateJSON(#PB_Any)
                If JSON2_ID
                  
                  ForEach Client()
                    If Client()\WebSocket_Client = *Client
                      Chat_Message\Author = Client()\Username
                      ;Chat_Message\Timestamp = Date()
                      Break
                    EndIf
                  Next
                  
                  InsertJSONStructure(JSONValue(JSON2_ID), Chat_Message, Chat_Message)
                  
                  JSON_String = ComposeJSON(JSON2_ID)
                  ;Debug JSON_String
                  ForEach Client()
                    WebSocket_Server::Frame_Text_Send(*Server, Client()\WebSocket_Client, JSON_String)
                  Next
                  
                  FreeJSON(JSON2_ID)
                EndIf
                
              Case "Username_Change"
                ExtractJSONStructure(JSONValue(JSON_ID), Chat_Username_Change, Chat_Username_Change)
                ForEach Client()
                  If Client()\WebSocket_Client = *Client
                    Client()\Username = Chat_Username_Change\Username
                    Break
                  EndIf
                Next
                
                JSON2_ID = CreateJSON(#PB_Any)
                If JSON2_ID
                  
                  Chat_Userlist\Type = "Userlist"
                  ForEach Client()
                    AddElement(Chat_Userlist\UserName())
                    Chat_Userlist\UserName() = Client()\Username
                  Next
                  
                  InsertJSONStructure(JSONValue(JSON2_ID), Chat_Userlist, Chat_Userlist)
                  
                  JSON_String = ComposeJSON(JSON2_ID)
                  ForEach Client()
                    WebSocket_Server::Frame_Text_Send(*Server, Client()\WebSocket_Client, JSON_String)
                  Next
                  
                  FreeJSON(JSON2_ID)
                EndIf
                
            EndSelect
            
            FreeJSON(JSON_ID)
          EndIf
      EndSelect
      
  EndSelect
EndProcedure

OpenConsole()

*Server = WebSocket_Server::Create(8090)

Repeat
  While WebSocket_Server::Event_Callback(*Server, @WebSocket_Event())
  Wend
  
  Delay(10)
ForEver
; IDE Options = PureBasic 6.21 Beta 5 (Linux - x64)
; ExecutableFormat = Console
; CursorPosition = 160
; EnableThread
; EnableXP
; Executable = testserver_polling
; CompileSourceDirectory
Then I tested the client code:

Code: Select all

; Websocketclient by Netzvamp
; Version: 2016/01/08

PurifierGranularity(1, 1, 1, 1)

DeclareModule WebsocketClient
  Declare OpenWebsocketConnection(URL.s)
  Declare SendTextFrame(connection, message.s)
  Declare ReceiveFrame(connection, *MsgBuffer)
  Declare SetSSLProxy(ProxyServer.s = "", ProxyPort.l = 8182)
  
  Enumeration
    #frame_text
    #frame_binary
    #frame_closing
    #frame_ping
    #frame_unknown
  EndEnumeration
  
EndDeclareModule

Module WebsocketClient
  
  ;TODO: Add function to send binary frame
  ;TODO: We don't support fragmetation right now
  ;TODO: We should send an closing frame, but server will also just close
  ;TODO: Support to send receive bigger frames
  
  Declare Handshake(Connection, Servername.s, Path.s)
  Declare ApplyMasking(Array Mask.a(1), *Buffer)
  
  Global Proxy_Server.s, Proxy_Port.l
  
  Macro dbg(txt)
    CompilerIf #PB_Compiler_Debugger
      Debug "WebsocketClient: " + FormatDate("%yyyy-%mm-%dd %hh:%ii:%ss",Date()) + " > " + txt
    CompilerEndIf
  EndMacro
  
  Procedure SetSSLProxy(ProxyServer.s = "", ProxyPort.l = 8182)
    Proxy_Server.s = ProxyServer.s
    Proxy_Port.l = ProxyPort.l
  EndProcedure
  
  Procedure OpenWebsocketConnection(URL.s)
    Protokol.s = GetURLPart(URL.s, #PB_URL_Protocol)
    Servername.s = GetURLPart(URL.s, #PB_URL_Site)
    Port.l = Val(GetURLPart(URL.s, #PB_URL_Port))
    If Port.l = 0 : Port.l = 80 : EndIf
    Path.s = GetURLPart(URL.s, #PB_URL_Path)
    If Path.s = "" : Path.s = "/" : EndIf
    

    If Protokol.s = "wss" ; If we connect with encryption (https)
      If Proxy_Port
        Connection = OpenNetworkConnection(Proxy_Server.s, Proxy_Port.l, #PB_Network_TCP, 1000)
      Else
        dbg("We need an SSL-Proxy like stunnel for encryption. Configure the proxy with SetSSLProxy().")
      EndIf
    ElseIf Protokol.s = "ws"
      Connection = OpenNetworkConnection(Servername.s, Port.l, #PB_Network_TCP, 1000)
    EndIf
    
    If Connection
      If Handshake(Connection, Servername.s, Path.s)
        dbg("Connection and Handshake ok")
        ProcedureReturn Connection
      Else
        dbg("Handshake-Error")
        ProcedureReturn #False
      EndIf
    Else
      dbg("Couldn't connect")
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure Handshake(Connection, Servername.s, Path.s)
    Request.s = "GET /" + Path.s + " HTTP/1.1"+ #CRLF$ +
                "Host: " + Servername.s + #CRLF$ +
                "Upgrade: websocket" + #CRLF$ +
                "Connection: Upgrade" + #CRLF$ +
                "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==" + #CRLF$ +
                "Sec-WebSocket-Version: 13" + #CRLF$ + 
                "User-Agent: CustomWebsocketClient"+ #CRLF$ + #CRLF$
                
    SendNetworkString(Connection, Request.s, #PB_UTF8)
    *Buffer = AllocateMemory(65536)
    
    ; We wait for answer
    Repeat
      Size = ReceiveNetworkData(connection, *Buffer, 65536)
      Answer.s = Answer.s + PeekS(*Buffer, Size, #PB_UTF8)
      If FindString(Answer, #CRLF$ + #CRLF$)
        Break
      EndIf
    Until Size <> 65536
    
    Answer.s = UCase(Answer.s)
    
    ; Check answer
    If FindString(Answer.s, "HTTP/1.1 101") And FindString(Answer.s, "CONNECTION: UPGRADE") And FindString(Answer.s, "UPGRADE: WEBSOCKET")
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndProcedure
  
  Procedure ApplyMasking(Array Mask.a(1), *Buffer)
    For i = 0 To MemorySize(*Buffer) - 1
      PokeA(*Buffer + i, PeekA(*Buffer + i) ! Mask(i % 4))
    Next
  EndProcedure
  
  Procedure SendTextFrame(connection, message.s)
    
    ; Put String in Buffer
    MsgLength.l = StringByteLength(message.s, #PB_UTF8)
    *MsgBuffer = AllocateMemory(MsgLength)
    PokeS(*MsgBuffer, message.s, MsgLength, #PB_UTF8|#PB_String_NoZero)
    
    dbg("Messagelength to send: " + Str(MsgLength))
    
    ; The Framebuffer, we fill with senddata
    If MsgLength <= 125
      Fieldlength = 6
    ElseIf MsgLength >= 126 And MsgLength <= 65535
      Fieldlength = 8
    Else
      Fieldlength = 14
    EndIf
    
    dbg("Fieldlength to send: " + Str(Fieldlength))
    
    
    *FrameBuffer = AllocateMemory(Fieldlength + MsgLength)
    
    ; We generate 4 random masking bytes
    Dim Mask.a(3)
    Mask(0) = Random(255,0)
    Mask(1) = Random(255,0) 
    Mask(2) = Random(255,0) 
    Mask(3) = Random(255,0) 
    
    pos = 0 ; The byteposotion in the framebuffer
    
    ; First Byte: FIN(1=finished with this Frame),RSV(0),RSV(0),RSV(0),OPCODE(4 byte)=0001(text) 
    PokeB(*FrameBuffer, %10000001) : pos + 1 ; = 129
    
    ; Second Byte: Masking(1),length(to 125bytes, else we have to extend)
    If MsgLength <= 125                                             ; Length fits in first byte
      PokeA(*Framebuffer + pos, MsgLength + 128)    : pos + 1       ; + 128 for Masking
    ElseIf MsgLength >= 126 And MsgLength <= 65535                  ; We have to extend length to third byte
      PokeA(*Framebuffer + pos, 126 + 128)          : pos + 1       ; 126 for 2 extra length bytes and + 128 for Masking
      PokeA(*FrameBuffer + pos, (MsgLength >> 8))   : pos + 1       ; First Byte
      PokeA(*FrameBuffer + pos, MsgLength)          : pos + 1       ; Second Byte
    Else                                                            ; It's bigger than 65535, we also use 8 extra bytes
      PokeA(*Framebuffer + pos, 127 + 128)          : pos + 1       ; 127 for 8 extra length bytes and + 128 for Masking
      PokeA(*Framebuffer + pos, 0)                  : pos + 1       ; 8 Bytes for payload lenght. We don't support giant packages for now, so first bytes are zero :P
      PokeA(*Framebuffer + pos, 0)                  : pos + 1
      PokeA(*Framebuffer + pos, 0)                  : pos + 1
      PokeA(*Framebuffer + pos, 0)                  : pos + 1
      PokeA(*Framebuffer + pos, MsgLength >> 24)    : pos + 1
      PokeA(*Framebuffer + pos, MsgLength >> 16)    : pos + 1
      PokeA(*Framebuffer + pos, MsgLength >> 8)     : pos + 1
      PokeA(*Framebuffer + pos, MsgLength)          : pos + 1       ; = 10 Byte
    EndIf
    ; Write Masking Bytes
    PokeA(*FrameBuffer + pos, Mask(0))              : pos + 1
    PokeA(*FrameBuffer + pos, Mask(1))              : pos + 1
    PokeA(*FrameBuffer + pos, Mask(2))              : pos + 1
    PokeA(*FrameBuffer + pos, Mask(3))              : pos + 1
    
    ApplyMasking(Mask(), *MsgBuffer)
    
    CopyMemory(*MsgBuffer, *FrameBuffer + pos, MsgLength)
    
    ;For x = 0 To 100 Step 5
      ;Debug Str(PeekA(*FrameBuffer + x)) + " | " + Str(PeekA(*FrameBuffer + x + 1)) + " | " + Str(PeekA(*FrameBuffer + x + 2)) + " | " + Str(PeekA(*FrameBuffer + x + 3)) + " | " + Str(PeekA(*FrameBuffer + x + 4))
    ;Next
    
    If SendNetworkData(connection, *FrameBuffer, Fieldlength + MsgLength) = Fieldlength + MsgLength
      dbg("Textframe send, Bytes: " + Str(Fieldlength + MsgLength))
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
    
  EndProcedure
  
  Procedure ReceiveFrame(connection, *MsgBuffer)
    
    *FrameBuffer = AllocateMemory(65536)
      Size = ReceiveNetworkData(connection, *FrameBuffer, 65536)
;     Repeat
;       *FrameBuffer = ReAllocateMemory(*FrameBuffer, 65536)
;       Size = ReceiveNetworkData(connection, *FrameBuffer, 65536)
;       ;Answer.s = Answer.s + PeekS(*FrameBuffer, Size, #PB_UTF8)
;     Until Size <> 65536
;     
    dbg("Received Frame, Bytes: " + Str(Size))
    
    *FrameBuffer = ReAllocateMemory(*FrameBuffer, Size)
    
        ; debug: output any single byte
        If #PB_Compiler_Debugger
          For x = 0 To Size - 1 Step 1
            dbg_bytes.s + Str(PeekA(*FrameBuffer + x)) + " | "
          Next
          dbg(dbg_bytes)
        EndIf
    
    ; Getting informations about package
    If PeekA(*FrameBuffer) & %10000000 > #False
      ;dbg("Frame not fragmented")
      fragmentation.b = #False
    Else
      dbg("Frame fragmented! This not supported for now!")
      fragmentation.b = #True
    EndIf
    
    ; Check for Opcodes
    If PeekA(*FrameBuffer) = %10000001 ; Textframe
      dbg("Text frame")
      frame_typ.w = #frame_text
    ElseIf PeekA(*FrameBuffer) = %10000010 ; Binary Frame
      dbg("Binary frame")
      frame_typ.w = #frame_binary
    ElseIf PeekA(*FrameBuffer) = %10001000 ; Closing Frame
      dbg("Closing frame")
      frame_typ.w = #frame_closing
    ElseIf PeekA(*FrameBuffer) = %10001001 ; Ping
      ; We just answer pings
      *pongbuffer = AllocateMemory(2)
      PokeA(*pongbuffer, 138)
      PokeA(*pongbuffer+1, 0)
      SendNetworkData(connection, *pongbuffer, 2)
      dbg("Received Ping, answered with Pong")
      frame_typ.w = #frame_ping
      ProcedureReturn
    Else
      dbg("Opcode unknown")
      frame_typ.w = #frame_unknown
      ProcedureReturn #False
    EndIf
    
    ; Check masking
    If PeekA(*FrameBuffer + 1) & %10000000 = 128 : masking.b = #True : Else : masking.b = #False : EndIf
    
    dbg("Masking: " + Str(masking))
    
    pos.l = 1
    
    ; check size
    If PeekA(*FrameBuffer + 1) & %01111111 <= 125 ; size is in this byte
      frame_size.l = PeekA(*FrameBuffer + pos) & %01111111 : pos + 1
    ElseIf PeekA(*FrameBuffer + 1) & %01111111 >= 126 ; Size is in 2 extra bytes
      frame_size.l = PeekA(*FrameBuffer + 2) << 8 + PeekA(*FrameBuffer + 3) : pos + 2
    EndIf
    dbg("FrameSize: " + Str(frame_size.l))
    
    If masking = #True
      Dim Mask.a(3)
      Mask(0) = PeekA(*FrameBuffer + pos) : pos + 1
      Mask(1) = PeekA(*FrameBuffer + pos) : pos + 1
      Mask(2) = PeekA(*FrameBuffer + pos) : pos + 1
      Mask(3) = PeekA(*FrameBuffer + pos) : pos + 1
      
      ReAllocateMemory(*MsgBuffer,frame_size)
      CopyMemory(*FrameBuffer + pos, *MsgBuffer, frame_size)
      
      ApplyMasking(Mask(), *MsgBuffer)
    Else
      ReAllocateMemory(*MsgBuffer,frame_size)
      CopyMemory(*FrameBuffer + pos, *MsgBuffer, frame_size)
    EndIf
    
    ProcedureReturn frame_typ
    
  EndProcedure
  
EndModule


CompilerIf #PB_Compiler_IsMainFile
  
  ; Minimal example to send and receive textmessages
  ; The preconfigured testserver "echo.websocket.org" will just echo back everything you've send.

  ;WebsocketClient::SetSSLProxy("https://doko-cafe.de",443)
  Global connection
  
  connection = WebsocketClient::OpenWebsocketConnection("ws://doko-cafe.de:8090")
  
  
  
  
    
  
  ; Proxy Setting:
  ; If you need an encyrpted connection (https/wss), you currently have to use an 
  ; proxy software like stunnel (https://www.stunnel.org) to redirect unencrypted data into an encrypted connection
  ; Example stunnel.conf section:
  ;   [websocket]
  ;   client = yes
  ;   accept = 127.0.0.1:8182
    ; connect = echo.websocket.org:443
  ;WebsocketClient::SetSSLProxy("127.0.0.1",1302)
  
  
  ;connect = "127.0.0.1:1302"
  
  Repeat
    
    If connection
      
      NetworkEvent = NetworkClientEvent(connection)
      
      Select NetworkEvent
          
        Case #PB_NetworkEvent_Data
          Debug "We've got Data"
          *FrameBuffer = AllocateMemory(1)
          Frametyp = WebsocketClient::ReceiveFrame(connection,*FrameBuffer)
          If Frametyp = WebsocketClient::#frame_text
            Debug  "< " + PeekS(*FrameBuffer,MemoryStringLength(*FrameBuffer,#PB_UTF8|#PB_ByteLength),#PB_UTF8|#PB_ByteLength) 
            If WebsocketClient::SendTextFrame(connection, "HelloWorldServer.") = #False
              Debug "Couldn't send. Are we disconnected?"
            EndIf 
          ElseIf Frametyp = WebsocketClient::#frame_binary
            Debug  "< Received Binaryframe" 
          EndIf
          
        Case #PB_NetworkEvent_Disconnect
          If disconnected = #False
            Debug "Disconnected"
          EndIf
          disconnected = #True
          NetworkEvent = #PB_NetworkEvent_None
          
        Case #PB_NetworkEvent_None
          
      EndSelect
      
    EndIf
    Delay(1)
  ForEver
  
CompilerEndIf


On Linux, I get the following error message:

Code: Select all

munmap_chunk(): invalid pointer
And it breaks at this line:
ProcedureReturn frame_typ

On Windows, it works, but I get the following output:

Code: Select all

WebsocketClient: 2025-04-15 08:20:12 > Connection and Handshake ok
We've got Data
WebsocketClient: 2025-04-15 08:20:12 > Received Frame, Bytes: 37
WebsocketClient: 2025-04-15 08:20:12 > 129 | 35 | 123 | 34 | 85 | 115 | 101 | 114 | 110 | 97 | 109 | 101 | 34 | 58 | 91 | 34 | 34 | 93 | 44 | 34 | 84 | 121 | 112 | 101 | 34 | 58 | 34 | 85 | 115 | 101 | 114 | 108 | 105 | 115 | 116 | 34 | 125 | 
WebsocketClient: 2025-04-15 08:20:12 > Text frame
WebsocketClient: 2025-04-15 08:20:12 > Masking: 0
WebsocketClient: 2025-04-15 08:20:12 > FrameSize: 35
< {"Username":[""],"Type":"Userlist"}
 

WebsocketClient: 2025-04-15 08:20:12 > Messagelength to send: 17
WebsocketClient: 2025-04-15 08:20:12 > Fieldlength to send: 6
WebsocketClient: 2025-04-15 08:20:12 > Textframe send, Bytes: 23
What's wrong with the client code?
Or is it another Linux bug?

Re: Websocket Client

Posted: Thu Apr 17, 2025 9:28 pm
by infratec
In this client module are a lot of bugs and memory leaks.

Bugfixes with integrated wss, added CloseConnection(), added SindBinaryFrame(), added Status at CloseConnection, allow unmasked transfers,
added ping, restructured:

Code: Select all

; Websocketclient
;
; https://datatracker.ietf.org/doc/html/rfc6455
;
; by Netzvamp
; Version: 2016/01/08
;
; modified by infratec 2025/04/20

DeclareModule WebsocketClient
  
  #Opcode_Continue = $00
  #Opcode_Text = $01
  #Opcode_Binary = $02
  #Opcode_Closing = $08
  #Opcode_Ping = $09
  #Opcode_Pong = $0A
  #Opcode_Unknown = $FF
  
  
  Enumeration StatusCodes
    #StatusCode_NormalClosure = 1000
    #StatusCode_GoingAway
    #StatusCode_ProtocolError
    #StatusCode_NotAcceptedType
    #StatusCode_Reserved_1
    #StatusCode_Reserved_2
    #StatusCode_DontUse
    #StatusCode_MessageDoesNotFitType
    #StatusCode_PolicyViolation
    #StatusCode_MessageToBig
    #StatusCode_ServerDoesNotHandleTheNeededExtension
    #StatusCode_UnexpectedCondition
    
    #StatusCode_Reserved_3 = 1015
  EndEnumeration
  
  
  Structure WebsocketClient_Structure
    Connection.i
    Protokol$
    Servername$
    Path$
    Parameters$
    Port.i
    *ReceiveBuffer
    frame_fragmentation.i
    frame_masking.i
    frame_type.i
    frame_size.i
    Status.i
    Status$
  EndStructure
  
  
  Declare.i OpenConnection(*WebsocketClient.WebsocketClient_Structure, URL$)
  Declare.i SendPingFrame(*WebsocketClient.WebsocketClient_Structure)
  Declare.i SendTextFrame(*WebsocketClient.WebsocketClient_Structure, Text$, Masked.i=#True)
  Declare.i SendBinaryFrame(*WebsocketClient.WebsocketClient_Structure, *Payload, Masked.i=#True)
  Declare.i ReceiveFrame(*WebsocketClient.WebsocketClient_Structure)
  Declare CloseConnection(*WebsocketClient.WebsocketClient_Structure, Status.i=#StatusCode_NormalClosure)
  
EndDeclareModule

Module WebsocketClient
  
  EnableExplicit
  
  ;TODO: We don't support fragmetation right now
  ;TODO: Support to send/receive bigger frames
  
  Macro dbg(txt)
    CompilerIf #PB_Compiler_Debugger
      Debug "WebsocketClient: " + FormatDate("%yyyy-%mm-%dd %hh:%ii:%ss",Date()) + " > " + txt
    CompilerEndIf
  EndMacro
  
  
  Declare.i SendCloseFrame(*WebsocketClient.WebsocketClient_Structure, Status.i=#StatusCode_NormalClosure)
  
  
  Procedure.i Handshake(*WebsocketClient.WebsocketClient_Structure)
    
    Protected Request$, *Buffer, Size.i, Answer$, TimeoutCounter.i, Ok.i, Result.i
    
    
    Request$ = "GET " + *WebsocketClient\Path$ + " HTTP/1.1"+ #CRLF$ +
               "Host: " + *WebsocketClient\Servername$ + #CRLF$ +
               "Upgrade: websocket" + #CRLF$ +
               "Connection: Upgrade" + #CRLF$ +
               "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==" + #CRLF$ +
               "Sec-WebSocket-Version: 13" + #CRLF$ + #CRLF$
    
    Debug Request$
    
    SendNetworkString(*WebsocketClient\Connection, Request$)
    
    *Buffer = AllocateMemory(65536, #PB_Memory_NoClear)
    If *Buffer
      
      ; We wait for answer
      TimeoutCounter = 1000
      Repeat
        Size = ReceiveNetworkData(*WebsocketClient\connection, *Buffer, 65536)
        If Size > 0
          Answer$ + PeekS(*Buffer, Size, #PB_UTF8|#PB_ByteLength)
          Debug Answer$
          If FindString(Answer$, #CRLF$ + #CRLF$)
            Ok = #True
            Break
          EndIf
        Else
          Delay(1)
          TimeoutCounter - 1
        EndIf
      Until Ok Or TimeoutCounter = 0
      
      FreeMemory(*Buffer)
    EndIf
    
    If Ok
      Answer$ = UCase(Answer$)
      
      ; Check answer
      If FindString(Answer$, "HTTP/1.1 101") And FindString(Answer$, "CONNECTION: UPGRADE") And FindString(Answer$, "UPGRADE: WEBSOCKET")
        Result = #True
      EndIf
      
    EndIf
    
    ProcedureReturn Result
    
  EndProcedure
  
  
  Procedure.i OpenConnection(*WebsocketClient.WebsocketClient_Structure, URL$)
    
    *WebsocketClient\Protokol$ = GetURLPart(URL$, #PB_URL_Protocol)
    *WebsocketClient\Servername$ = GetURLPart(URL$, #PB_URL_Site)
    
    *WebsocketClient\Port = Val(GetURLPart(URL$, #PB_URL_Port))
    If *WebsocketClient\Port = 0
      If *WebsocketClient\Protokol$ = "wss"
        *WebsocketClient\Port = 443
      Else
        *WebsocketClient\Port = 80
      EndIf
    EndIf
    
    *WebsocketClient\Path$ = GetURLPart(URL$, #PB_URL_Path)
    If *WebsocketClient\Path$ = "" 
      *WebsocketClient\Path$ = "/"
    Else
      If Left(*WebsocketClient\Path$, 1) <> "/"
        *WebsocketClient\Path$ = "/" + *WebsocketClient\Path$
      EndIf
    EndIf
    
    *WebsocketClient\Parameters$ = GetURLPart(URL$, #PB_URL_Parameters)
    If *WebsocketClient\Parameters$ <> ""
      *WebsocketClient\Path$ + "?" + *WebsocketClient\Parameters$
    EndIf
    
    If *WebsocketClient\Protokol$ = "wss" ; If we connect with encryption (https)
      UseNetworkTLS()
      *WebsocketClient\Connection = OpenNetworkConnection(*WebsocketClient\Servername$, *WebsocketClient\Port, #PB_Network_TCP|#PB_Network_TLSv1, 1000)
    ElseIf *WebsocketClient\Protokol$ = "ws"
      *WebsocketClient\Connection = OpenNetworkConnection(*WebsocketClient\Servername$, *WebsocketClient\Port, #PB_Network_TCP, 1000)
    EndIf
    
    If *WebsocketClient\Connection
      If Handshake(*WebsocketClient)
        dbg("Connection and Handshake ok")
      Else
        dbg("Handshake-Error")
        CloseNetworkConnection(*WebsocketClient\Connection)
        *WebsocketClient\Connection = 0
      EndIf
    Else
      dbg("Couldn't connect")
    EndIf
    
    ProcedureReturn *WebsocketClient\Connection
    
  EndProcedure
  
  
  Procedure.i SendFrame(*WebsocketClient.WebsocketClient_Structure, Opcode.i, *Payload, PayloadSize.q, Masked.i=#True)
    
    Protected.i Pos, Size, i, Result, HeaderSize
    Protected.i Dim Mask.a(3)
    Protected *SendBuffer
    
    
    dbg("PayloadSize to send: " + Str(PayloadSize))
    
    ; The Framebuffer, we fill with senddata
    If PayloadSize <= 125
      HeaderSize = 2
    ElseIf PayloadSize >= 126 And PayloadSize <= 65535
      HeaderSize = 4
    Else
      HeaderSize = 10
    EndIf
    
    If Masked
      HeaderSize + 4
    EndIf
    
    dbg("Headersize to send: " + Str(HeaderSize))
    
    *SendBuffer = AllocateMemory(HeaderSize + PayloadSize)
    If *SendBuffer
      
      PokeA(*SendBuffer, Opcode | $80)
      
      Pos = 1 ; The byteposition in the framebuffer
      
      ; Second Byte: Masking(1),length(to 125bytes, else we have to extend)
      If PayloadSize <= 125                                           ; Length fits in first byte
        PokeA(*Sendbuffer + Pos, PayloadSize)               : Pos + 1
      ElseIf PayloadSize >= 126 And PayloadSize <= 65535              ; We have to extend length to third byte
        PokeA(*Sendbuffer + Pos, 126)                       : Pos + 1 ; 126 For 2 extra length bytes
        PokeA(*SendBuffer + Pos, (PayloadSize >> 8))        : Pos + 1 ; First Byte
        PokeA(*SendBuffer + Pos, PayloadSize)               : Pos + 1 ; Second Byte
      Else                                                            ; It's bigger than 65535, we use 8 extra bytes
        PokeA(*Sendbuffer + Pos, 127)                       : Pos + 1 ; 127 for 8 extra length bytes
        PokeA(*SendBuffer + Pos, (PayloadSize >> 56) & $FF) : Pos + 1
        PokeA(*SendBuffer + Pos, (PayloadSize >> 48) & $FF) : Pos + 1
        PokeA(*SendBuffer + Pos, (PayloadSize >> 40) & $FF) : Pos + 1
        PokeA(*SendBuffer + Pos, (PayloadSize >> 32) & $FF) : Pos + 1
        PokeA(*Sendbuffer + Pos, (PayloadSize >> 24) & $FF) : Pos + 1
        PokeA(*Sendbuffer + Pos, (PayloadSize >> 16) & $FF) : Pos + 1
        PokeA(*Sendbuffer + Pos, (PayloadSize >> 8) & $FF)  : Pos + 1
        PokeA(*Sendbuffer + Pos, (PayloadSize & $FF))       : Pos + 1
      EndIf
      
      If Not Masked
        CopyMemory(*Payload, *SendBuffer + Pos, PayloadSize)
      Else
        ; We generate 4 random masking bytes
        
        PokeA(*SendBuffer + 1, PeekA(*SendBuffer + 1) | $80)  ; set mask bit
        
        Mask(0) = Random(255)
        Mask(1) = Random(255) 
        Mask(2) = Random(255) 
        Mask(3) = Random(255) 
        
        ; Write Masking Bytes
        PokeA(*SendBuffer + Pos, Mask(0)) : Pos + 1
        PokeA(*SendBuffer + Pos, Mask(1)) : Pos + 1
        PokeA(*SendBuffer + Pos, Mask(2)) : Pos + 1
        PokeA(*SendBuffer + Pos, Mask(3)) : Pos + 1
        
        CopyMemory(*Payload, *SendBuffer + Pos, PayloadSize)
        
        Size = PayloadSize - 1
        For i = 0 To Size
          PokeA(*SendBuffer + Pos + i, PeekA(*SendBuffer + Pos + i) ! Mask(i % 4))
        Next
      EndIf
      
      ;ShowMemoryViewer(*SendBuffer, MemorySize(*SendBuffer))
      
      If SendNetworkData(*WebsocketClient\connection, *SendBuffer, MemorySize(*SendBuffer)) = MemorySize(*SendBuffer)
        dbg("Frame send, Bytes: " + Str(MemorySize(*SendBuffer)))
        Result = #True
      EndIf
      FreeMemory(*SendBuffer)
    EndIf
    
    ProcedureReturn Result
    
  EndProcedure
  
  
  Procedure.i SendPingFrame(*WebsocketClient.WebsocketClient_Structure)
    
    Protected *Payload, PayloadSize.q, Result.i
    
    
    If *WebsocketClient\Connection
      *Payload = UTF8("Ping")
      If *Payload
        PayloadSize = MemorySize(*Payload) - 1
        Result = SendFrame(*WebsocketClient, #Opcode_Ping, *Payload, PayloadSize, #True)
        FreeMemory(*Payload)
      EndIf
    EndIf
    
    ProcedureReturn Result
    
  EndProcedure
  
  
  Procedure.i SendTextFrame(*WebsocketClient.WebsocketClient_Structure, Text$, Masked.i=#True)
    
    Protected PayloadSize.q, *Payload, HeaderSize.i, *SendBuffer, Result.i
    
    
    If *WebsocketClient\Connection
      ; Put String in Buffer
      *Payload = UTF8(Text$)
      If *Payload
        PayloadSize = MemorySize(*Payload) - 1
        Result = SendFrame(*WebsocketClient, #Opcode_Text, *Payload, PayloadSize, Masked)
        FreeMemory(*Payload)
      EndIf
    EndIf
    
    ProcedureReturn Result
    
  EndProcedure
  
  
  Procedure.i SendBinaryFrame(*WebsocketClient.WebsocketClient_Structure, *Payload, Masked.i=#True)
    
    Protected.i Result, HeaderSize
    Protected.q PayloadSize
    Protected *SendBuffer
    
    
    If *WebsocketClient\Connection
      If *Payload
        PayloadSize = MemorySize(*Payload)
        Result = SendFrame(*WebsocketClient, #Opcode_Binary, *Payload, PayloadSize, Masked)
      EndIf
    EndIf
    
    ProcedureReturn Result
    
  EndProcedure
  
  
  Procedure GetPayload(*WebsocketClient.WebsocketClient_Structure, *FrameBuffer, Pos.i)
    
    Protected.i Size, i
    Protected Dim Mask.a(3)
    
    
    *WebsocketClient\ReceiveBuffer = AllocateMemory(*WebsocketClient\frame_size, #PB_Memory_NoClear)
    
    If *WebsocketClient\frame_masking = #False
      CopyMemory(*FrameBuffer + Pos, *WebsocketClient\ReceiveBuffer, *WebsocketClient\frame_size)
    Else
      Mask(0) = PeekA(*FrameBuffer + Pos) : Pos + 1
      Mask(1) = PeekA(*FrameBuffer + Pos) : Pos + 1
      Mask(2) = PeekA(*FrameBuffer + Pos) : Pos + 1
      Mask(3) = PeekA(*FrameBuffer + Pos) : Pos + 1
      
      CopyMemory(*FrameBuffer + Pos, *WebsocketClient\ReceiveBuffer, *WebsocketClient\frame_size)
      
      Size = *WebsocketClient\frame_size - 1
      For i = 0 To Size
        PokeA(*WebsocketClient\ReceiveBuffer + i, PeekA(*WebsocketClient\ReceiveBuffer + i) ! Mask(i % 4))
      Next
    EndIf
    
  EndProcedure
  
  
  Procedure.i ReceiveFrame(*WebsocketClient.WebsocketClient_Structure)
    
    Protected.i Size, pos, TimeoutCounter
    Protected.q PayloadSize
    Protected *FrameBuffer, *pongbuffer
    
    
    *FrameBuffer = AllocateMemory(65536, #PB_Memory_NoClear)
    If *FrameBuffer
      
      TimeoutCounter = 1000
      Repeat
        Size = ReceiveNetworkData(*WebsocketClient\connection, *FrameBuffer, MemorySize(*FrameBuffer))
        If Size < 1
          Delay(1)
          TimeoutCounter - 1
        Else
          TimeoutCounter = 1000
        EndIf
      Until Size > -1 Or TimeoutCounter = 0
      
      dbg("Received Frame, Bytes: " + Str(Size))
      
      ;ShowMemoryViewer(*FrameBuffer, Size)
      
      If Size > 0
        
        ; Getting informations about package
        If PeekA(*FrameBuffer) & %10000000 > #False
          ;dbg("Frame not fragmented")
          *WebsocketClient\frame_fragmentation = #False
        Else
          dbg("Frame fragmented! This not supported for now!")
          *WebsocketClient\frame_fragmentation = #True
        EndIf
        
        ; Check masking
        If PeekA(*FrameBuffer + 1) & %10000000 = 128
          *WebsocketClient\frame_masking = #True
        Else
          *WebsocketClient\frame_masking = #False
        EndIf
        dbg("Masking: " + Str(*WebsocketClient\frame_masking))
        
        PayloadSize = PeekA(*FrameBuffer + 1) & $7F
        Pos = 2
        If PayloadSize > 125
          If PayloadSize = 126
            PayloadSize = (PeekA(*FrameBuffer + 2) << 8) | PeekA(*FrameBuffer + 3)
            Pos = 4
          Else
            PayloadSize = (PeekA(*FrameBuffer + 2) << 56) | (PeekA(*FrameBuffer + 3) << 48) | (PeekA(*FrameBuffer + 4) << 40)  | (PeekA(*FrameBuffer + 5) << 32) | (PeekA(*FrameBuffer + 6) << 24) | (PeekA(*FrameBuffer + 7) << 16) | (PeekA(*FrameBuffer + 8) << 8) | PeekA(*FrameBuffer + 9)
            Pos = 10
          EndIf
        EndIf
        *WebsocketClient\frame_size = PayloadSize
        dbg("PayloadSize: " + Str(PayloadSize))
        
        ; Check for Opcodes
        *WebsocketClient\frame_type = PeekA(*FrameBuffer) & $0F
        Select *WebsocketClient\frame_type
          Case #Opcode_Continue
            
          Case #Opcode_Text
            dbg("Text frame")
            GetPayload(*WebsocketClient, *FrameBuffer, Pos)
            
          Case #Opcode_Binary
            dbg("Binary frame")
            GetPayload(*WebsocketClient, *FrameBuffer, Pos)
            
          Case #Opcode_Closing
            dbg("Closing frame")
            If PayloadSize > 1
              *WebsocketClient\Status = PeekA(*FrameBuffer + Pos) << 8
              Pos + 1
              *WebsocketClient\Status | PeekA(*FrameBuffer + Pos)
              Pos + 1
              PayloadSize - 2
              If PayloadSize > 0
                *WebsocketClient\Status$ = PeekS(*FrameBuffer + Pos, PayloadSize, #PB_UTF8|#PB_ByteLength)
              Else
                *WebsocketClient\Status$ = ""
              EndIf
            EndIf
            
            SendCloseFrame(*WebsocketClient)
            CloseNetworkConnection(*WebsocketClient\Connection)
            *WebsocketClient\Connection = 0
            
          Case #Opcode_Ping
            dbg("Ping frame, answere with Pong")
            PokeA(*FrameBuffer + 0, $8A)         ; FIN bit and opcode for pong
            SendNetworkData(*WebsocketClient\Connection, *FrameBuffer, Size)
            
          Case #Opcode_Pong
            dbg("Pong frame")
            GetPayload(*WebsocketClient, *FrameBuffer, Pos)
            
          Default
            dbg("Opcode unknown")
            *WebsocketClient\frame_type = #Opcode_Unknown
            
        EndSelect
        
      EndIf
      
      FreeMemory(*FrameBuffer)
    EndIf
    
    ProcedureReturn *WebsocketClient\frame_type
    
  EndProcedure
  
  
  Procedure.i SendCloseFrame(*WebsocketClient.WebsocketClient_Structure, Status.i=#StatusCode_NormalClosure)
    
    Protected Result.i, *Buffer
    
    
    If *WebsocketClient\Connection
      *Buffer = AllocateMemory(8)
      If *Buffer
        PokeA(*Buffer + 0, $88) ; FIN bit + opcode x8
        PokeA(*Buffer + 1, $82) ; MASK bit + 2 bytes payload
        
        ; MASK bytes
        PokeA(*Buffer + 2, Random(255))
        PokeA(*Buffer + 3, Random(255))
        PokeA(*Buffer + 4, Random(255))
        PokeA(*Buffer + 5, Random(255))
        
        ; masked status in network byte order
        PokeA(*Buffer + 6, (Status >> 8) ! PeekA(*Buffer + 2))
        PokeA(*Buffer + 7, (Status & $FF) ! PeekA(*Buffer + 3))
        
        If SendNetworkData(*WebsocketClient\Connection, *Buffer, MemorySize(*Buffer)) = MemorySize(*Buffer)
          Result = #True
        EndIf
        
        FreeMemory(*Buffer)
      EndIf
    EndIf
    
    ProcedureReturn Result
    
  EndProcedure
  
  
  Procedure CloseConnection(*WebsocketClient.WebsocketClient_Structure, Status.i=#StatusCode_NormalClosure)
    
    If SendCloseFrame(*WebsocketClient, Status)
      ReceiveFrame(*WebsocketClient)
    EndIf
    
    If *WebsocketClient\Connection
      CloseNetworkConnection(*WebsocketClient\Connection)
      *WebsocketClient\Connection = #Null
    EndIf
    
  EndProcedure
  
EndModule




CompilerIf #PB_Compiler_IsMainFile
  ;-Demo
  
  ; Minimal example to send and receive textmessages
  ; The preconfigured testserver "echo.websocket.org" will just echo back everything you've send.
  
  EnableExplicit
  
  
  Enumeration Gadgets
    #String_send
    #String_url
    #Button_connect
    #Frame3D_io
    #Button_send
    #Checkbox_Masked
    #Button_Ping
    #ListView_Output
  EndEnumeration
  
  
  Define.i NetworkEvent, disconnected, event
  Define Send$
  Define WebsocketClient.WebsocketClient::WebsocketClient_Structure
  
  
  OpenWindow(0, 0, 0, 600, 400, "Websocketclient :: Test-GUI", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered)
  
  StringGadget(#String_url, 10, 10, 470, 25, "wss://echo.websocket.org")
  ;StringGadget(#String_url, 10, 10, 470, 25, "wss://doko-cafe.de/test")
  ButtonGadget(#Button_connect, 490, 10, 100, 25, "Connect")
  
  FrameGadget(#Frame3D_io, 10, 40, 580, 350, "Input/Output")
  
  StringGadget(#String_send, 20, 60, 400, 25, "")
  CheckBoxGadget(#Checkbox_Masked, 430, 60, 50, 20, "Mask")
  SetGadgetState(#Checkbox_Masked, #True)
  ButtonGadget(#Button_send, 490, 60, 90, 25, "Send")
  DisableGadget(#Button_send, #True)
  
  ButtonGadget(#Button_Ping, 490, 90, 90, 25, "Ping")
  DisableGadget(#Button_Ping, #True)
  
  ListViewGadget(#ListView_Output, 20, 130, 560, 250)
  
  Repeat
    event = WaitWindowEvent(1)
    Select event
      Case #PB_Event_CloseWindow
        Break
        
      Case #PB_Event_Menu
        Select EventMenu()
        EndSelect
        
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #Button_connect
            If GetGadgetText(#Button_connect) = "Connect"
              Debug "Connect clicked"
              WebsocketClient\Status = 0
              WebsocketClient\Status$ = ""
              If WebsocketClient::OpenConnection(@WebsocketClient, GetGadgetText(#String_url))
                AddGadgetItem(#ListView_Output, -1, "# Connected to " + GetGadgetText(#String_url))
                SetGadgetText(#Button_connect, "Disconnect")
                If GetGadgetText(#String_send) <> ""
                  DisableGadget(#Button_send, #False)
                EndIf
                DisableGadget(#Button_Ping, #False)
              EndIf
            Else
              WebsocketClient::CloseConnection(@WebsocketClient)
              If WebsocketClient\Status > 0
                AddGadgetItem(#ListView_Output, -1, "< Closing status: " + Str(WebsocketClient\Status) + " " + WebsocketClient\Status$)
              EndIf
              SetGadgetText(#Button_connect, "Connect")
              DisableGadget(#Button_send, #True)
              DisableGadget(#Button_Ping, #True)
            EndIf
          Case #String_send
            If EventType() = #PB_EventType_Change
              If GetGadgetText(#String_send) <> ""
                If WebsocketClient\Connection
                  DisableGadget(#Button_send, #False)
                EndIf
              Else
                DisableGadget(#Button_send, #True)
              EndIf
            EndIf
          Case #Button_send
            If Len(GetGadgetText(#String_send)) > 0 And WebsocketClient\connection
              Debug "Send clicked"
              If WebsocketClient::SendTextFrame(@WebsocketClient, GetGadgetText(#String_send), GetGadgetState(#Checkbox_Masked)) = #False
                ;If WebsocketClient::SendTextFrame(@WebsocketClient, "<-" + Space(800) + "->", GetGadgetState(#Checkbox_Masked)) = #False
                Debug "Couldn't send. Are we disconnected?"
              Else
                AddGadgetItem(#ListView_Output, -1, "> " + GetGadgetText(#String_send))
              EndIf
            EndIf
          Case #Button_Ping
            If WebsocketClient::SendPingFrame(@WebsocketClient)
              AddGadgetItem(#ListView_Output, -1, "> Ping sent")
            EndIf
        EndSelect
    EndSelect
    
    
    If WebsocketClient\connection
      
      NetworkEvent = NetworkClientEvent(WebsocketClient\connection)
      
      Select NetworkEvent
          
        Case #PB_NetworkEvent_None
          
        Case #PB_NetworkEvent_Data
          Debug "NetworkEvent_Data"
          WebsocketClient::ReceiveFrame(@WebsocketClient)
          If WebsocketClient\ReceiveBuffer
            If WebsocketClient\frame_type = WebsocketClient::#Opcode_Text
              Debug "< " + PeekS(WebsocketClient\ReceiveBuffer, MemorySize(WebsocketClient\ReceiveBuffer), #PB_UTF8|#PB_ByteLength)
              AddGadgetItem(#ListView_Output, -1, "< " + PeekS(WebsocketClient\ReceiveBuffer, MemorySize(WebsocketClient\ReceiveBuffer), #PB_UTF8|#PB_ByteLength))
            ElseIf WebsocketClient\frame_type = WebsocketClient::#Opcode_Binary
              AddGadgetItem(#ListView_Output, -1, "< Received Binaryframe" )
            ElseIf WebsocketClient\frame_type = WebsocketClient::#Opcode_Pong
              Debug "< " + PeekS(WebsocketClient\ReceiveBuffer, MemorySize(WebsocketClient\ReceiveBuffer), #PB_UTF8|#PB_ByteLength)
              AddGadgetItem(#ListView_Output, -1, "< " + PeekS(WebsocketClient\ReceiveBuffer, MemorySize(WebsocketClient\ReceiveBuffer), #PB_UTF8|#PB_ByteLength))
            EndIf
            FreeMemory(WebsocketClient\ReceiveBuffer)
            WebsocketClient\ReceiveBuffer = #Null
          Else
            If WebsocketClient\frame_type = WebsocketClient::#Opcode_Closing
              SetGadgetText(#Button_connect, "Connect")
              DisableGadget(#Button_send, #True)
              DisableGadget(#Button_Ping, #True)
              AddGadgetItem(#ListView_Output, -1, "< Closing status: " + Str(WebsocketClient\Status) + " " + WebsocketClient\Status$)
            EndIf
          EndIf
          
        Case #PB_NetworkEvent_Disconnect
          If WebsocketClient\Connection
            Debug "NetworkEvent_Disconnect"
            CloseNetworkConnection(WebsocketClient\Connection)
          EndIf
          SetGadgetText(#Button_connect, "Connect")
          DisableGadget(#Button_send, #True)
          DisableGadget(#Button_Ping, #True)
          WebsocketClient\Connection = 0
          
      EndSelect
      
    EndIf
  ForEver
  
CompilerEndIf
wss tested with:
wss://demo.piesocket.com/v3/channel_123?api_key=VCXCEuvhGcBDP7XhiJJUDvR1e1D3eiVjgZ9VRiaV&notify_self

and
wss://echo.websocket.org

Re: Websocket Client

Posted: Fri Apr 18, 2025 2:53 pm
by stevie1401
Thank you very much!
The code works with ws, but I can't connect with wss.
Could you please try establishing a connection to doko-cafe.de?

I'm getting the same errors on Linux as with the old code.
On Windows, the client doesn't stop receiving and enters a continuous loop.

Re: Websocket Client

Posted: Fri Apr 18, 2025 4:49 pm
by infratec
Your server is not working correct with wss :!:

Try this as test.html

Code: Select all

<!DOCTYPE html>
<html lang="en">
 <head>
  <script> 
   let socket = new WebSocket("wss://javascript.info/article/websocket/demo/hello");
   
   socket.onopen = function(e) {
    alert("[open] Connection established");
    alert("Sending to server");
    socket.send("My name is John");
   };
   
   socket.onmessage = function(event) {
    alert(`[message] Data received from server: ${event.data}`);
   };

   socket.onclose = function(event) {
    if (event.wasClean) {
     alert(`[close] Connection closed cleanly, code=${event.code} reason=${event.reason}`);
   } else {
    // e.g. server process killed or network down
    // event.code is usually 1006 in this case
    alert('[close] Connection died');
   }
  };

  socket.onerror = function(error) {
   alert(`[error]`);
  };
  </script>
 </head>
 <body>
 </body>
</html>
And replace the wss address with yours. It is not working,