Last active
November 8, 2022 22:11
-
-
Save sgtz/95e7db96fd0858a28b5a to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
namespace WebSocket | |
// Appache 2.0 license | |
// References: | |
// [1] Proposed WebSockets Spec December 2011 http://tools.ietf.org/html/rfc6455 | |
// [2] John McCutchan (Google Dart Team Member) http://www.altdevblogaday.com/2012/01/23/writing-your-own-websocket-server/ | |
// [3] A pretty good Python implemenation by mrrrgn https://github.com/mrrrgn/websocket-data-frame-encoder-decoder/blob/master/frame.py | |
// [4] WebSockets Organising body http://www.websocket.org/echo.html | |
// [5] AndrewNewcomb's Gist (starting point) https://gist.github.com/AndrewNewcomb/711664 | |
// [6] C# version (Vladimir's starting point?) http://nugget.codeplex.com | |
// [7] VLADIMIR MATVEEV http://v2matveev.blogspot.com/2010/04/mailboxprocessors-practical-application.html | |
// [8] Matt Moloney's Frame Implementation https://gist.github.com/moloneymb/18959a56c10beb907608 | |
// Disclaimer: very early stages of refactoring + still hacky | |
open System | |
open System.IO | |
open System.Net | |
open System.Net.Sockets | |
open System.Text | |
open System.Threading | |
open System.Runtime.Serialization | |
open System.Security.Cryptography | |
module ServerUtil = | |
let guid6455 = "258EAFA5-E914-47DA-95CA-C5AB0DC85B11" | |
/// headers can occur in any order (See 1.3 in [1]) | |
let isWebSocketsUpgrade (lines: string array) = | |
[| "GET /timer HTTP/1.1"; "Upgrade: websocket"; "Connection: Upgrade"|] | |
|> Array.map(fun x->lines |> Array.exists(fun y->x.ToLower()=y.ToLower())) | |
|> Array.reduce(fun x y->x && y) | |
/// see: [1] | |
let calcWSAccept6455 (secWebSocketKey:string) = | |
let ck = secWebSocketKey + guid6455 | |
let sha1 = SHA1CryptoServiceProvider.Create() | |
let hashBytes = ck |> Encoding.ASCII.GetBytes |> sha1.ComputeHash | |
let Sec_WebSocket_Accept = hashBytes |> Convert.ToBase64String | |
Sec_WebSocket_Accept | |
let createAcceptString6455 acceptCode = | |
"HTTP/1.1 101 Switching Protocols\r\n" + | |
"Upgrade: websocket\r\n" + | |
"Connection: Upgrade\r\n" + | |
"Sec-WebSocket-Accept: " + acceptCode + "\r\n" | |
+ "\r\n" | |
let getKey key arr = | |
try | |
let item = (Array.find (fun (s:String) -> s.StartsWith(key)) arr) | |
item.Substring key.Length | |
with | |
| _ -> "" | |
let makeFrame_ShortTxt (P:byte array) = | |
let message = new MemoryStream() | |
try | |
message.WriteByte(byte 0x81) // see 5.6 & 11.8 in [1]. See [2], and [3] | |
message.WriteByte(byte P.Length) // assume length < 127 bytes. as yet, no implementation of masking, extended payload length, or the mask | |
message.Write(P,0,P.Length) // TODO: cobine with [8] | |
message.ToArray() | |
finally | |
message.Close() | |
open ServerUtil | |
[<DataContract>] | |
type Time = | |
{ [<DataMember(Name = "hour")>] mutable Hour : int | |
[<DataMember(Name = "minute")>] mutable Minute : int | |
[<DataMember(Name = "second")>] mutable Second : int } | |
static member New(dt : DateTime) = {Hour = dt.Hour; Minute = dt.Minute; Second = dt.Second} | |
type Msg = | |
| Connect of MailboxProcessor<Time> | |
| Disconnect of MailboxProcessor<Time> | |
| Tick of Time | |
module WebSocketServer = | |
let port = 1900 | |
let ipAddress = IPAddress.Loopback.ToString() | |
let origin = "http://localhost" | |
let startMailboxProcessor ct f = MailboxProcessor.Start(f, cancellationToken = ct) | |
let timer (ctrl : MailboxProcessor<Msg>) interval = async { | |
while true do | |
do! Async.Sleep interval | |
ctrl.Post(Tick <| Time.New(DateTime.Now)) | |
} | |
let runController (ct : CancellationToken) = | |
startMailboxProcessor ct (fun (inbox : MailboxProcessor<Msg>) -> | |
let listeners = new ResizeArray<_>() | |
async { | |
while not ct.IsCancellationRequested do | |
let! msg = inbox.Receive() | |
match msg with | |
| Connect l -> | |
Console.WriteLine "Connect" | |
listeners.Add(l) | |
| Disconnect l -> | |
Console.WriteLine "Disconnect" | |
listeners.Remove(l) |> ignore | |
| Tick msg -> listeners.ForEach(fun l -> l.Post msg) | |
} | |
) | |
let runWorker (tcp : TcpClient) (ctrl : MailboxProcessor<Msg>) ct = | |
ignore <| startMailboxProcessor ct (fun (inbox : MailboxProcessor<Time>) -> | |
let rec handshake = async { | |
let ns = tcp.GetStream() | |
let bytes = Array.create tcp.ReceiveBufferSize (byte 0) | |
let bytesReadCount = ns.Read (bytes, 0, bytes.Length) | |
if bytesReadCount > 8 then | |
let lines = bytes.[..(bytesReadCount-9)] | |
|> System.Text.UTF8Encoding.UTF8.GetString | |
|> fun hs->hs.Split([|"\r\n"|], StringSplitOptions.RemoveEmptyEntries) | |
match isWebSocketsUpgrade lines with | |
| true -> | |
let acceptStr = | |
(getKey "Sec-WebSocket-Key:" lines | |
).Substring(1) // skip space | |
|> calcWSAccept6455 | |
|> createAcceptString6455 | |
Console.WriteLine acceptStr // debug | |
do! ns.AsyncWrite <| Encoding.ASCII.GetBytes acceptStr | |
return! run ns | |
| _ -> | |
tcp.Close() // validation failed - close connection | |
else | |
tcp.Close() // validation failed - close connection | |
} | |
and run (ns : NetworkStream) = async { | |
let json = System.Runtime.Serialization.Json.DataContractJsonSerializer(typeof<Time>) | |
ctrl.Post(Connect inbox) | |
try | |
while not ct.IsCancellationRequested do | |
let! time = inbox.Receive() | |
let payload = new MemoryStream() | |
json.WriteObject(payload, time) | |
let df = makeFrame_ShortTxt <| payload.ToArray() | |
ns.Write(df,0,df.Length) | |
finally | |
ns.Close() | |
ctrl.Post(Disconnect inbox) | |
} | |
handshake | |
) | |
let runRequestDispatcher () = | |
let listener = new TcpListener(IPAddress.Parse(ipAddress), port) | |
let cts = new CancellationTokenSource() | |
let token = cts.Token | |
let controller = runController token | |
Async.Start (timer controller 1000, token) | |
let main = async { | |
try | |
listener.Start(10) | |
while not cts.IsCancellationRequested do | |
let! client = Async.FromBeginEnd(listener.BeginAcceptTcpClient, listener.EndAcceptTcpClient) | |
//client.NoDelay <- true | |
runWorker client controller token | |
finally | |
listener.Stop() | |
} | |
Async.Start(main, token) | |
{ new IDisposable with member x.Dispose() = cts.Cancel()} | |
let start() = | |
let dispose = runRequestDispatcher () | |
printfn "press any key to stop..." | |
Console.ReadKey() |> ignore | |
dispose.Dispose() | |
module Program = | |
[<EntryPoint>] | |
let main argv = | |
//System.Threading.Server.runRequestDispatcher() | |
WebSocketServer.start() | |
0 // return an integer exit code |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
<html> | |
<head> | |
<script> | |
// instead of using jQuery | |
function $(id) { return document.getElementById(id); }; | |
var ws = new WebSocket("ws://localhost:1900/timer"); | |
ws.onerror = function(ev){ | |
$('serverStatus').innerHTML = 'WebSocket Status: Error'; | |
}; | |
ws.onabort = function() { | |
$('serverStatus').innerHTML = 'WebSocket Status: Abort'; | |
}; | |
ws.onopen = function() { | |
$('serverStatus').innerHTML = 'WebSocket Status: Socket Open'; | |
alert("Opened"); }; | |
ws.onclose = function () { | |
$('serverStatus').innerHTML = 'WebSocket Status: Socket Closed'; | |
alert("Closed"); | |
}; | |
ws.onmessage = function (evt) { | |
var date = eval('(' + evt.data + ')'); | |
$('hour').innerHTML = date.hour; | |
$('minute').innerHTML = date.minute; | |
$('second').innerHTML = date.second; | |
}; | |
</script> | |
<style type="text/css"> | |
table, td, th { | |
font-family: "Trebuchet MS", Arial, Helvetica, sans-serif; | |
border: 1px solid #A7C942; | |
padding: 3px 7px 2px 7px; | |
text-align: center; | |
} | |
td { | |
font-weight: bold; | |
font-size: 20px; | |
} | |
th { | |
font-size: 14px; | |
font-style: italic; | |
background-color: #A7C942; | |
color: white; | |
} | |
</style> | |
</head> | |
<body> | |
<p>Server Status:</p><p id="serverStatus"></p> | |
<table> | |
<tr> | |
<th>Hour</th> | |
<th>Minute</th> | |
<th>Second</th> | |
</tr> | |
<tr> | |
<td id="hour"></td> | |
<td id="minute"></td> | |
<td id="second"></td> | |
</tr> | |
</table> | |
</body> | |
</html> |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment