' FRAME DECODING: http://tools.ietf.org/html/rfc6455 -- See "5.2.  Base Framing Protocol"

' Code by Nilium -- used by Base64 functions!

Const etable$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Global dtable@[256]

' Basic WebSockets server...

' For testing, use:

' http://www.websocket.org/echo.html

' or this Chrome extension:

' https://chrome.google.com/webstore/detail/pfdhoblngboilpfeibdedpjgfnlcodoo

' Misc...

Rem

http://tools.ietf.org/html/rfc6455#page-36
http://www.htmlgoodies.com/html5/tutorials/making-html5-websockets-work.html#fbid=MQV91wYw7gh
http://www.developerfusion.com/article/143158/an-introduction-to-websockets/
http://www.websocket.org/aboutwebsocket.html
http://www.altdevblogaday.com/2012/01/23/writing-your-own-websocket-server/

End Rem

Const WS_MAGIC:String = "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"

Const BIT_FIN:Int = 0
Const BIT_RSV1:Int = 1
Const BIT_RSV2:Int = 2
Const BIT_RSV3:Int = 3
Const BIT_MASK:Int = 8

InitBase64

Local tcp:TSocket = CreateTCPSocket ()

If Not tcp Then RuntimeError "No TCP socket!"

If Not BindSocket (tcp, 80) Then CloseSocket tcp; RuntimeError "Couldn't bind TCP to port 80!"

SocketListen tcp, 5

Repeat

	Local incoming:TSocket = SocketAccept (tcp)

	If incoming

		Local stream:TStream = CreateSocketStream (incoming)

		If stream

			Local message:String = ""

			While Not Eof (stream)

				If SocketReadAvail (incoming)

					message = ReadLine (stream)

					Print "MSG: " + message

					Select message

						Case ""

							If incoming And stream

								WriteLine stream, "HTTP/1.1 101 Switching Protocols"
								WriteLine stream, "Upgrade: websocket"
								WriteLine stream, "Connection: Upgrade"
								WriteLine stream, "Sec-WebSocket-Accept: " + accept
								WriteLine stream, ""

								Local msg:String = ""

								' Do stuff!

								Repeat

									Local bytes:TBank = FillBank (incoming, stream)

									If bytes

										Local chars:String = ""

										For Local loop:Int = 0 Until BankSize (bytes)

											Print ""
											Print "New byte!"
											Print ""

											Local _byte:Byte = PeekByte (bytes, loop)
											Print "Byte: " + _byte

											chars = chars + _byte

											Local bytearray:Byte [] = [0:Byte, 0:Byte, 0:Byte, 0:Byte, 0:Byte, 0:Byte, 0:Byte, 0:Byte]

											For Local byteloop:Int = 0 To 7
												bytearray [byteloop] = _byte & 1 Shl byteloop
											Next

											'Const BIT_FIN:Int = 0
											'Const BIT_RSV1:Int = 1
											'Const BIT_RSV2:Int = 2
											'Const BIT_RSV3:Int = 3
											'Const BIT_MASK:Int = 8

											If bytearray [BIT_FIN] Then Print "FIN marker set -- final fragment in message."
											If bytearray [BIT_RSV1] Then Print "RSV1 marker set -- no extensions supported, should terminate!"
											If bytearray [BIT_RSV2] Then Print "RSV2 marker set -- no extensions supported, should terminate!"
											If bytearray [BIT_RSV3] Then Print "RSV3 marker set -- no extensions supported, should terminate!"
											'If bytearray [BIT_MASK] Then Print "MASK marker set -- message contents are masked."

											Local opcode:Short = (bytearray [7] | bytearray [6] | bytearray [5] | bytearray [4]) Shr 1

											Print Bin (_byte)
											Print "Opcode: $" + Hex (opcode)
											Print ""

											Select opcode
												Case $0
													Print "Continuation frame"
												Case $1
													Print "Text frame"
												Case $2
													Print "Binary frame"
												Case $3, $4, $5, $6, $7
													Print "Reserved data frame opcode"
												Case $8
													Print "Connection close"
												Case $9
													Print "Ping"
												Case $A
													Print "Pong"
												Case $B, $C, $D, $E, $F
													Print "Reserved control frame opcode"
											End Select

										Next

										chars = Left (chars, Len (chars) - 2)

										Print "[" + chars + "]"

										bytes = Null

									EndIf

								Forever

							EndIf

						Default

							If Left (message, 19) = "Sec-WebSocket-Key: "

								Local key:String = Right (message, Len (message) - 19)
								Local accept:String = CreateResponse (key)

							EndIf

					End Select

				Else
					Delay 10
				EndIf

			Wend

		EndIf

	Else

		Print "Waiting for connection..."
		Delay 500

	EndIf

Until KeyHit (KEY_ESCAPE)

If stream Then CloseStream stream
If incoming Then CloseSocket incoming
If tcp Then CloseSocket tcp

End

Function FillBank:TBank (socket:TSocket, stream:TStream)

	Local getbytes:Int = SocketReadAvail (socket)

	If getbytes

		Print getbytes + " bytes received"

		Local bank:TBank = CreateBank (getbytes)

		If bank
			For Local loop:Int = 0 Until getbytes
				PokeByte bank, loop, ReadByte (stream)
			Next
		EndIf

	EndIf

	Return bank

End Function

' Adds \r prior to \n, as required by WebSockets...

Function WriteLineR:Int (stream:TStream, str:String)
	WriteLine stream, str + "~r"
End Function

Function CreateResponse:String (key:String)

	' To test using known-working data, uncomment either 'key' line below
	' and compare the result (found in the 'response' string)...

	' From http://tools.ietf.org/html/rfc6455
	' Result should be "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="

		' key = "dGhlIHNhbXBsZSBub25jZQ=="

	' From http://en.wikipedia.org/wiki/WebSocket
	' Result should be: "HSmrc0sMlYUkAGmm5OPpG2HaGWk="

		' key = "x3JJHMbDL1EzLkh9GBhXDw=="

	' From http://www.codeproject.com/Articles/209041/HTML5-Web-Socket-in-Essence
	' Result should be: "VAuGgaNDB/reVQpGfDF8KXeZx5o="

		' key = "V2ViU29ja2V0IHJvY2tzIQ=="

	key = SHA1 (key + WS_MAGIC)

	Local keybytes:Byte [] = HexToByteArray (key)
	Local response:String = EncodeBase64 (keybytes, keybytes.Length)

	Return response

End Function

Function HexToByteArray:Byte [] (hx:String)

	Local bytes:Byte [Len (hx) / 2]

	For Local loop:Int = 1 To Len (hx) Step 2
		bytes [loop / 2] = Byte ("$" + Mid (hx, loop, 2))
	Next

	Return bytes

End Function

' Code by Nilium!

Function InitBase64 ()
	For Local __di:Int = 0 To etable.Length-1
	    dtable[etable[__di]] = __di
	Next
End Function

Function EncodeBase64$( in@ Ptr, sizein:Int )
    If sizein <= 0 Then Return Null
    Local out:Byte[64]
    Local s$

    Local p@ Ptr = out
    Local cc% = 0

    For Local i% = 0 To sizein-1 Step 3
        Local c1@, c2@
        c1 = in[i]&$FF
        c2 = in[i+1]&$FF

        p[0] = etable[in[0] Shr 2]
        If i+1 < sizein Then
            p[1] = etable[((in[0] & $3) Shl 4) | ((in[1] & $F0) Shr 4)]
            If i+2 < sizein Then
                p[2] = etable[((in[1] & $F) Shl 2) | ((in[2] & $C0) Shr 6)]
                p[3] = etable[in[2] & $3F]
            ElseIf i+1 < sizein Then
                p[2] = etable[((in[1] & $F) Shl 2)]
            EndIf
        Else
            p[1] = etable[((in[0] & $3) Shl 4)]
        EndIf

        in :+ 3
        p :+ 4
        cc :+ 4
        If cc = 64 Then
            s :+ String.FromBytes(out,cc)
            p = out
            cc = 0
        EndIf
    Next
    Select sizein Mod 3
        Case 0
            s :+ String.FromBytes(out, cc)
        Case 1
            s :+ String.FromBytes(out, cc-2)+"=="
        Case 2
            s :+ String.FromBytes(out, cc-1)+"="
    End Select
    Return s
End Function

' Assumes you're passing a valid string to it
Function DecodeBase64:Byte[]( in$ )
    Local f% = in.Find("=")
    in = in.Replace("=","~0")
    Local rm% = 0
    If f = -1 Then
        rm = 0
        f = in.Length-1
    ElseIf f = in.Length-1 Then
        rm = 1
    ElseIf f = in.Length-2 Then
        rm = 2
    EndIf
    Local out@[((in.Length/4)*3)-rm]
    Local p@ Ptr = out
    Local bc% = 0
    For Local cc:Int = 0 To f Step 4
        p[0] = (dtable[in[cc]] Shl 2) | (dtable[in[cc+1]] Shr 4)
        If out.Length > (bc+1) Then p[1] = ((dtable[in[cc+1]] & $F) Shl 4) | ((dtable[in[cc+2]]&$3C) Shr 2)
        If out.Length > (bc+2) Then p[2] = ((dtable[in[cc+2]] & $3) Shl 6) | dtable[in[cc+3]]
        bc :+ 3
        p :+ 3
    Next
    Return out
End Function

' Code by EdzUp/Yan (?)...

Function SHA1:String(in$)

	Function Rol(val, shift)
		Return (val Shl shift) | (val Shr (32 - shift))
	End Function

	Local h0:Long = $67452301
	Local h1:Long = $EFCDAB89
	Local h2:Long = $98BADCFE
	Local h3:Long = $10325476
	Local h4:Long = $C3D2E1F0
	Local a:Long = 0
	Local b:Long = 0
	Local c:Long = 0
	Local d:Long = 0
	Local e:Long = 0
	Local i:Long = 0
	Local f:Long = 0
	Local t:Long = 0

	Local intCount:Long = (((in$.length + 8) Shr 6) + 1) Shl 4
	Local data:Long[intCount]

	For c=0 Until in$.length
		data[c Shr 2] = (data[c Shr 2] Shl 8) | (in$[c] & $FF)
	Next

	data[in$.length Shr 2] = ((data[in$.length Shr 2] Shl 8) | $80) Shl ((3 - (in$.length & 3)) Shl 3)
	data[data.length - 2] = (Long(in$.length) * 8) Shr 32
	data[data.length - 1] = (Long(in$.length) * 8) & $FFFFFFFF

	For Local chunkStart:Long=0 Until intCount Step 16

		a = h0
		b = h1
		c = h2
		d = h3
		e = h4

		Local w:Long[] = data[chunkStart..chunkStart + 16]
		w = w[..80]

		For i=16 To 79
			w[i] = Rol(w[i - 3] ~ w[i - 8] ~ w[i - 14] ~ w[i - 16], 1)
		Next

		For i=0 To 19
			t = Rol(a, 5) + (d ~ (b & (c ~ d))) + e + $5A827999 + w[i]

			e = d ; d = c
			c = Rol(b, 30)
			b = a ; a = t
		Next

		For i=20 To 39
			t = Rol(a, 5) + (b ~ c ~ d) + e + $6ED9EBA1 + w[i]

			e = d ; d = c
			c = Rol(b, 30)
			b = a ; a = t
		Next

		For i = 40 To 59
			t = Rol(a, 5) + ((b & c) | (d & (b | c))) + e + $8F1BBCDC + w[i]

			e = d ; d = c
			c = Rol(b, 30)
			b = a ; a = t
		Next

		For i = 60 To 79
			t = Rol(a, 5) + (b ~ c ~ d) + e + $CA62C1D6 + w[i]

			e = d ; d = c
			c = Rol(b, 30)
			b = a ; a = t
		Next

		h0 :+ a ; h1 :+ b ; h2 :+ c
		h3 :+ d ; h4 :+ e

	Next

	Return (Hex(h0) + Hex(h1) + Hex(h2) + Hex(h3) + Hex(h4)).ToLower()

End Function