Harbour websocket server

774 views
Skip to first unread message

Antonio Linares

unread,
Apr 18, 2020, 3:16:49 AM4/18/20
to Harbour Users
Here you have a first prototype of a Harbour websocket server:


Basically this server allows you to communicate between a web browser and a Harbour app (no matter where it is!), using websockets.

It is actually working fine for messages <= 125 chars. I expect to complete it for all messages sizes soon. Help is welcome :-)

In this version the websocket server implements an echo service, just to check that it properly works. It sends you back whatever you may send to it.
You can easily change its source code to implement any other conversation you may have in mind.

How to test it:

1. Build wsserver.exe using hbmk2 wsserver.prg. Use the hbmk2 flag -mt to build it multithreading! 

2. Run wsserver.exe. It will display all messages that arrive to it. "loop" is shown on the screen. Press esc any time to end it.

3. If you have IIS or Apache installed on your PC, simply run this HTML page:

<html>
<head>
</head>
<body>
<input type="text" id="msg">
<button onclick="Send( document.getElementById( 'msg' ).value )">Send</button>
<script>
var socket = new WebSocket( "ws://localhost:9000" );

socket.onopen = function(e) {
alert("[open] Connection established");
alert("Sending to server");
socket.send( "Harbour web sockets server" );
};

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] ${error.message}`);
};

function Send( cMsg ) {
socket.send( cMsg );
}

</script>
</body>
</html>

4. Whatever you send to the server from the web page, it will get back to you (sort of a karma reminder :-)

5. Write exit to tell the server to end your session. 

Enjoy it 

best regards

Antonio

Antonio Linares

unread,
Apr 18, 2020, 4:51:34 AM4/18/20
to Harbour Users
No need to use Apache neither IIS, simply build wsserver.exe run it and click here:


unslash your imagination on the web using Harbour! :-)

This wsserver is part of the research we are doing to get the most from Harbour on the web
Don't miss to use mod_harbour and embrace the web finally ;-)

--
--
You received this message because you are subscribed to the Google
Groups "Harbour Users" group.
Unsubscribe: harbour-user...@googlegroups.com
Web: http://groups.google.com/group/harbour-users

---
You received this message because you are subscribed to a topic in the Google Groups "Harbour Users" group.
To unsubscribe from this topic, visit https://groups.google.com/d/topic/harbour-users/CBcrRAHnQSA/unsubscribe.
To unsubscribe from this group and all its topics, send an email to harbour-user...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/harbour-users/fbeecf44-d521-4253-b628-94547743323b%40googlegroups.com.


--
Antonio Linares
www.fivetechsoft.com

Pritpal Bedi

unread,
Apr 18, 2020, 8:22:26 AM4/18/20
to Harbour Users
Hi Antonio




Wow! Excellent piece of work. 
I will be using this protocol in many applications.

Thank you for sharing...


Pritpal Bedi
a student of software analysis & concepts

Antonio Linares

unread,
Apr 22, 2020, 5:28:26 AM4/22/20
to Harbour Users
There is a new version that supports all msgs length already available from the repo:


best regards

Antonio

Ottó Trapp

unread,
Apr 29, 2020, 9:11:16 AM4/29/20
to Harbour Users
Hello Antonio,

I Tried your work, it is very nice!

I made a small addition / correction to it in my test:

#define OPC_CONT   0x00
#define OPC_TEXT   0x01
#define OPC_BIN    0x02
#define OPC_CLOSE  0x08
#define OPC_PING   0x09
#define OPC_PONG   0x0A

...

function Mask( cText, nOPCode )

   local nLen := Len( cText ) 
   local cHeader 
   local lMsgIsComplete := .T.
   local nFirstByte := 0
   
   default nOPCode to OPC_TEXT

   if lMsgIsComplete
      nFirstByte := hb_bitSet( nFirstByte, 7 )    // 1000 0000
   endif
   
   // setting OP code
   nFirstByte := hb_bitOr( nFirstByte, nOPCode )  // 1000 XXXX -> is set
...

Thanks for sharing your code!

Best Regards,
Otto

Antonio Linares

unread,
Apr 29, 2020, 9:57:02 AM4/29/20
to Harbour Users
Dear Ottó,

Many thanks for your enhancements.

Would you mind to create a fork from https://github.com/FiveTechSoft/wsserver then make your corrections on your fork
and finally do a "Pull request" from it. This way we can use the great tools that GitHub/Git provide to cooperate on its development.

many thanks

best regards

Antonio

--
--
You received this message because you are subscribed to the Google
Groups "Harbour Users" group.
Unsubscribe: harbour-user...@googlegroups.com
Web: http://groups.google.com/group/harbour-users

---
You received this message because you are subscribed to a topic in the Google Groups "Harbour Users" group.
To unsubscribe from this topic, visit https://groups.google.com/d/topic/harbour-users/CBcrRAHnQSA/unsubscribe.
To unsubscribe from this group and all its topics, send an email to harbour-user...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/harbour-users/7ba1d985-04ef-4fba-8ecb-22b40587824a%40googlegroups.com.


--
Antonio Linares
www.fivetechsoft.com

Pritpal Bedi

unread,
Apr 29, 2020, 2:41:11 PM4/29/20
to Harbour Users
Hi Antonio

Is it possible that client is also a harbour app ?
OR 
Websockets are only available from within a modern browser only.

Antonio Linares

unread,
Apr 29, 2020, 3:19:16 PM4/29/20
to Harbour Users
Dear Pritpal,

Client can be a Harbour app also as far as it uses the websocket protocol (handshake, sent frames, answers, etc)

Inspecting with the browser is a very good way to check it. You may start inspecting standard WebSockets and then
mimic the same behavior with a Harbour client app.


best regards

Antonio

--
--
You received this message because you are subscribed to the Google
Groups "Harbour Users" group.
Unsubscribe: harbour-user...@googlegroups.com
Web: http://groups.google.com/group/harbour-users

---
You received this message because you are subscribed to a topic in the Google Groups "Harbour Users" group.
To unsubscribe from this topic, visit https://groups.google.com/d/topic/harbour-users/CBcrRAHnQSA/unsubscribe.
To unsubscribe from this group and all its topics, send an email to harbour-user...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/harbour-users/ca607742-af10-4362-bf5c-7218cbfc1670%40googlegroups.com.


--
Antonio Linares
www.fivetechsoft.com

Ottó Trapp

unread,
Apr 30, 2020, 4:32:54 AM4/30/20
to Harbour Users
Dear Antonio,

I did a fork, commited my change and did a pull request to show my change.

Thanks!

Best Regards,
Otto

Web: http://groups.google.com/group/harbour-users

---
You received this message because you are subscribed to a topic in the Google Groups "Harbour Users" group.
To unsubscribe from this topic, visit https://groups.google.com/d/topic/harbour-users/CBcrRAHnQSA/unsubscribe.
To unsubscribe from this group and all its topics, send an email to harbou...@googlegroups.com.


--
Antonio Linares
www.fivetechsoft.com

Antonio Linares

unread,
Apr 30, 2020, 9:41:20 AM4/30/20
to Harbour Users
Dear Ottó,

Excellent, thank you so much! :-)

best regards

Antonio

Unsubscribe: harbour-user...@googlegroups.com

Web: http://groups.google.com/group/harbour-users

---
You received this message because you are subscribed to a topic in the Google Groups "Harbour Users" group.
To unsubscribe from this topic, visit https://groups.google.com/d/topic/harbour-users/CBcrRAHnQSA/unsubscribe.
To unsubscribe from this group and all its topics, send an email to harbour-user...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/harbour-users/c6a93671-696c-482e-aa61-905903b03801%40googlegroups.com.


--
Antonio Linares
www.fivetechsoft.com

fdaniele

unread,
May 6, 2020, 5:30:48 AM5/6/20
to Harbour Users
Dear mr. Linaers

is possible to use the mod_harbour in socket system ?

in pratiche, the pages of mod_harbour that works on wserver (without apache or other web service) 

thanks and regards

Daniele



Antonio Linares

unread,
May 6, 2020, 6:48:28 AM5/6/20
to Harbour Users
Daniel,

Yes, in fact the way mod_harbour works was originally implemented on Android and iOS, without using Apache.

But later, we found that combining it with Apache (and IIS) as a mod, could easily take Harbour to the web

best regards

Antonio 

--
--
You received this message because you are subscribed to the Google
Groups "Harbour Users" group.
Unsubscribe: harbour-user...@googlegroups.com
Web: http://groups.google.com/group/harbour-users

---
You received this message because you are subscribed to a topic in the Google Groups "Harbour Users" group.
To unsubscribe from this topic, visit https://groups.google.com/d/topic/harbour-users/CBcrRAHnQSA/unsubscribe.
To unsubscribe from this group and all its topics, send an email to harbour-user...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/harbour-users/f756fe56-b9d1-45d7-9c3e-e126820fd44e%40googlegroups.com.


--
Antonio Linares
www.fivetechsoft.com

Pritpal Bedi

unread,
Nov 6, 2021, 11:09:40 PM11/6/21
to Harbour Users
Hi Antonio

I am working on WebSocket client based on TIPClient just like TIPClientHTTP. Until handshake all is well but when I try to send text from client garbage is received by server ( your code ). Despite my best efforts I am unable to resolve the issue. My understanding reaches that socket created with hbtip lib is not supporting the dual communication. I may be wrong though. Any help is appreciated. There is a small change in TIPClient class where "WS" and "WSS" protocol is resolved.



Below is the class code employed:

//----------------------------------------------------------------//
//                        WS_Client Demo
//----------------------------------------------------------------//

FUNCTION _ws_client_( cServer, nPort, cEndpoint ) // Main()
   LOCAL hWS, cReply

   SetMode( 25,80 )
   ? "Working ..."
   
   hb_default( @cServer, "ws://127.0.0.1" )
   hb_default( @nPort, 9000 )
   hb_default( @cEndpoint, "/chat" )

   hWS := TIPClientWS():new( cServer, nPort )
   IF hWS:connect( cEndPoint )
      IF hWS:sendText( "I am good and good on WebSockets!" )
         cReply := hWS:readFrame()
         Alert( cReply )      
      ENDIF 
   ELSE 
      Alert( "Not Connected!" )   
   ENDIF
   RETURN hWS

//----------------------------------------------------------------//
//                        WS_Client Class
//----------------------------------------------------------------//

CREATE CLASS TIPClientWS INHERIT TIPClient

   DATA   cMethod
   DATA   nReplyCode
   DATA   cReplyDescr
   DATA   nVersion                                INIT 13
   DATA   nSubversion                             INIT 0
   DATA   hHeaders                                INIT { => }
   DATA   hFields                                 INIT { => }
   DATA   nLength
   DATA   cNonce
   
   METHOD New( cServer, nPort )
   METHOD Connect( cEndpoint )
   METHOD ReadHeaders( lClear )
   METHOD StandardFields( cEndpoint )
   METHOD SendText( cText )
   METHOD ReadFrame()
   
   ENDCLASS


METHOD New( cServer, nPort ) CLASS TIPClientWS
   LOCAL oUrl
   
   ::nConnTimeout := 3000
   hb_HCaseMatch( ::hHeaders, .F. )
   
   oUrl := TUrl():new( cServer + iif( Empty( nPort ), "", ":" + hb_ntos( nPort ) ) )
   
   ::super:new( oUrl, "ws", NIL )
   ::nDefaultPort := iif( ::oUrl:cProto == "wss", 443, 80 )
   
   ::open()
   
   RETURN Self


METHOD Connect( cEndpoint ) CLASS TIPClientWS

   ::cNonce := hb_base64Encode( cld_getRandomJunkString( 16 ) )
   
   IF ::standardFields( cEndpoint )
      IF ::readHeaders()
         IF ::nReplyCode == 101
            IF hb_HHasKey( ::hHeaders, "Upgrade" ) .AND. Upper( ::hHeaders[ "Upgrade" ] ) == "WEBSOCKET"
               IF hb_HHasKey( ::hHeaders, "Connection" ) .AND. Upper( ::hHeaders[ "Connection" ] ) == "UPGRADE"
                  IF hb_HHasKey( ::hHeaders, "Sec-WebSocket-Accept" )
                     IF ::hHeaders[ "Sec-WebSocket-Accept" ] == hb_base64Encode( hb_SHA1( ::cNonce + "258EAFA5-E914-47DA-95CA-C5AB0DC85B11", .T. ) )
                        RETURN .T.
                     ENDIF 
                  ENDIF
               ENDIF 
            ENDIF
         ENDIF
      ENDIF 
   ENDIF
   RETURN .F.


METHOD StandardFields( cEndpoint ) CLASS TIPClientWS
   LOCAL field, s

   s := "GET " + cEndpoint + " HTTP/1.1" + ::cCRLF 
   //
   ::hFields[ "Host"                   ] := "http://127.0.0.1"
   ::hFields[ "Upgrade"                ] := "websocket"
   ::hFields[ "Connection"             ] := "Upgrade"
   ::hFields[ "Sec-WebSocket-Key"      ] := ::cNonce
   ::hFields[ "Origin"                 ] := "http://harbour.org"
   ::hFields[ "Sec-WebSocket-Protocol" ] := "chat"
   ::hFields[ "Sec-WebSocket-Version"  ] := hb_ntos( ::nVersion )
   //
   FOR EACH field IN ::hFields
      s += field:__enumKey() + ": " + field + ::cCRLF
   NEXT
   s += ::cCRLF 
   
   ::inetSendAll( ::SocketCon, s )
   
   RETURN ::inetErrorCode( ::SocketCon ) == 0


METHOD ReadHeaders( lClear ) CLASS TIPClientWS
   LOCAL cLine, nPos, aVersion, aHead

   IF ( cLine := hb_defaultValue( ::inetRecvLine( ::SocketCon, @nPos, 500 ), "" ) ) == ""
      RETURN .F.
   ENDIF

   // Get Protocol version
   aVersion := hb_regex( "^HTTP/(.)\.(.) ([0-9][0-9][0-9]) +(.*)$", cLine )
   ::cReply := cLine

   IF Empty( aVersion )
      ::nVersion := 0
      ::nSubversion := 9
      ::nReplyCode := 0
      ::cReplyDescr := ""
   ELSE
      ::nVersion := Val( aVersion[ 2 ] )
      ::nSubversion := Val( aVersion[ 3 ] )
      ::nReplyCode := Val( aVersion[ 4 ] )
      ::cReplyDescr := aVersion[ 5 ]
   ENDIF

   ::nLength := -1
   IF hb_defaultValue( lClear, .F. ) .AND. ! Empty( ::hHeaders )
      ::hHeaders := {=>}
   ENDIF
   cLine := ::inetRecvLine( ::SocketCon, @nPos, 500 )
   DO WHILE ::inetErrorCode( ::SocketCon ) == 0 .AND. HB_ISSTRING( cLine ) .AND. ! cLine == ""

      IF Len( aHead := hb_regexSplit( ":", cLine,,, 1 ) ) != 2
         cLine := ::inetRecvLine( ::SocketCon, @nPos, 500 )
         LOOP
      ENDIF

      ::hHeaders[ aHead[ 1 ] ] := LTrim( aHead[ 2 ] )

      cLine := ::inetRecvLine( ::SocketCon, @nPos, 500 )
   ENDDO
   IF ::inetErrorCode( ::SocketCon ) != 0
      RETURN .F.
   ENDIF
   RETURN .T.


METHOD ReadFrame() CLASS TIPClientWS
   LOCAL cBuffer
   LOCAL cRequest
   LOCAL nLen
   
   DO WHILE .T.
      cRequest := ""
      nLen := 1

      DO WHILE nLen > 0
         cBuffer := Space( 4096 )
         IF ( nLen := ::inetRecv( ::SocketCon, @cBuffer, 3000 ) ) > 0
            cRequest += Left( cBuffer, nLen )
         ELSE
            IF nLen == -1 .AND. ::inetErrorCode( ::SocketCon ) == HB_SOCKET_ERR_TIMEOUT
               nLen := 0
            ENDIF
         ENDIF
      ENDDO
      IF ! Empty( cRequest )
         ? cRequest
         cRequest := cld_wsUnMask( cRequest )
      ENDIF 
      
      EXIT    
   ENDDO   
   RETURN cRequest
   
   
METHOD SendText( cText ) CLASS TIPClientWS
   
   cText := cld_wsMask( cText, OPC_TEXT )
   ? cText
   ::inetSendAll( ::SocketCon, cText, Len( cText ) )
   
   RETURN ::inetErrorCode( ::SocketCon ) == 0
   
   

//////////////////////////////////////////

This is what I received on server 

Harbour websockets server running on port 9000
accept socket request
new client connected
Request... iG♫☻-  ♥- ♠☻&DA☻' +s♫♫"E§▲h


Pritpal Bedi

unread,
Nov 7, 2021, 3:54:42 AM11/7/21
to Harbour Users
Hi

Communication protocol is correct. Seems issue is with Mask() and UnMask() functions. Looking at. Please disregard previous message.

Antonio Linares

unread,
Nov 7, 2021, 4:49:50 AM11/7/21
to Harbour Users
Hi Pritpal,

Glad to know that you found it. We appreciate if you share any changes on functions Mask() and Unmask().

On our tests they seem to be working properly

best regards

To view this discussion on the web visit https://groups.google.com/d/msgid/harbour-users/be48ba77-a99c-4904-98c8-8c6b57c2cb16n%40googlegroups.com.


--
Antonio Linares
www.fivetechsoft.com

Pritpal Bedi

unread,
Nov 7, 2021, 2:11:41 PM11/7/21
to Harbour Users
Hi Antonio

You are correct in the context of web browser as a client which correctly masks the payload. But Mask() function fails in the context of client being Harbour application. Mask() for client needs to be written reverse of UnMask() where message is to be xOred per mask string.

It is hard for me to manipulate bits. Can anyboy help ?
Reply all
Reply to author
Forward
0 new messages