what's wrong on this f# echo server? - f#

Question

I've written this f# echo server:
open System.Net
open System.Net.Sockets
open System.IO
open System
open System.Text
open System.Collections.Generic
let addr = IPAddress.Parse("127.0.0.1")
let listener = new TcpListener(addr, 2000)
listener.Start()
let rec loop2(c:TcpClient,sr:StreamReader,sw:StreamWriter)=async {
let line=sr.ReadLine()
if not(line=null) then
match line with
|"quit"->
sr.Close()
sw.Close()
c.Close()
|_ ->
if line.Equals("left") then
sw.WriteLine("right")
return! loop2(c,sr,sw)
sw.WriteLine(line)
return! loop2(c,sr,sw)
else
sr.Close()
sw.Close()
c.Close()
}
let loop()=async {
while true do
let c=listener.AcceptTcpClient()
let d = c.GetStream()
let sr = new StreamReader(d)
let sw = new StreamWriter(d)
sw.AutoFlush<-true
Async.Start(loop2(c,sr,sw))
}
Async.RunSynchronously(loop())
This program can do:
echo the client's message
when client said 'left',return 'right'
when client said 'quit',close the connection
but when I run the programming,when a client sent 'left',get 'right',and sent 'quit',i got this exception:
not handled exception: System.ObjectDisposedException: (con't write
to closed) TextWriter。 in
Microsoft.FSharp.Control.CancellationTokenOps.Start#1192-1.Invoke(Exception
e) in .$Control.loop#419-40(Trampoline this,
FSharpFunc2 action) in
Microsoft.FSharp.Control.Trampoline.ExecuteAction(FSharpFunc2
firstAction) in
Microsoft.FSharp.Control.TrampolineHolder.Protect(FSharpFunc`2
firstAction) in
.$Control.-ctor#476-1.Invoke(Object state) in
System.Threading.QueueUserWorkItemCallback.WaitCallback_Context(Object
state) in
System.Threading.ExecutionContext.RunInternal(ExecutionContext
executionContext, ContextCallback callback, Object state,
BooleanpreserveSyncCtx) in
System.Threading.ExecutionContext.Run(ExecutionContext
executionContext, ContextCallback callback, Object state, Boolean
preserveSyncCtx) in
System.Threading.QueueUserWorkItemCallback.System.Threading.IThreadPoolWorkItem.ExecuteWorkItem()
in System.Threading.ThreadPoolWorkQueue.Dispatch() in
System.Threading._ThreadPoolWaitCallback.PerformWaitCallback() . .
.(press any key to continue)
Screenshot of program in action
Screenshot of exception
how can i fix this problem?

Answer 1

The problem is that, unlike what you might expect from its namesake in imperative languages, return in a computation expression doesn't short-circuit. So once the return! in the if line.Equals("right") returns, ie. after the socket has been closed, the code after the if block is run and tries to write to the closed socket. The fix is to put those two lines in an else:
if line.Equals("left") then
sw.WriteLine("right")
return! loop2(c,sr,sw)
else
sw.WriteLine(line)
return! loop2(c,sr,sw)
As an additional style tip, this whole body can be implemented as a match:
let rec loop2(c:TcpClient,sr:StreamReader,sw:StreamWriter)=async {
let line=sr.ReadLine()
match line with
| null | "quit" ->
sr.Close()
sw.Close()
c.Close()
| "left" ->
sw.WriteLine("right")
return! loop2(c,sr,sw)
| _ ->
sw.WriteLine(line)
return! loop2(c,sr,sw)
}

Answer 2

The problem in your code is here:
if line.Equals("left") then
sw.WriteLine("right")
return! loop2(c,sr,sw)
sw.WriteLine(line)
return! loop2(c,sr,sw)
If a "left" is received, it writes "right" and then executes nested loop2s until a "quit" is received. Then, after all of that is complete, it tries to write line and execute more nested loop2s. Of course, by this point, you have disposed of the connection, hence the exception.
It seems like writing line should be in an else block, which would prevent the error:
if line.Equals("left") then
sw.WriteLine("right")
else
sw.WriteLine(line)
return! loop2(c,sr,sw)
Of course, you can also integrate this check with your pattern match. The example below will handle the null checking and each string option all in one structure.
let line = Option.ofObj <| sr.ReadLine()
match line with
|None
|Some("quit") ->
sr.Close()
sw.Close()
|Some("left") ->
sw.WriteLine("right")
return! loop2(c,sr,sw)
|Some(line) ->
sw.WriteLine(line)
return! loop2(c,sr,sw)
Note that your async block is completely useless because you have simply used blocking functions such as AcceptTcpClient(), ReadLine() and WriteLine(). Putting these functions inside an async block does not magically make them asynchronous. If you want to work asynchronously, it has to be async all the way down.
I'm guessing your objective here is to asynchronously accept clients as they arrive, handling each client asynchronously within a different function.
Most of the .NET API in this area is written in terms of Task<'T> rather than the F#-specific async<'T>, so I would recommend creating some helper functions:
let writeLineAsync (sw:StreamWriter) (text : string) =
sw.WriteLineAsync(text).ContinueWith(fun t -> ())
|> Async.AwaitTask
let readLineAsync (sr:StreamReader) =
sr.ReadLineAsync()
|> Async.AwaitTask
let acceptClientAsync (l : TcpListener) =
l.AcceptTcpClientAsync()
|> Async.AwaitTask
Then you can create a properly asynchronous version:
let rec handleClient (c:TcpClient) (sr:StreamReader) (sw:StreamWriter) =
async {
let! line = readLineAsync sr
match Option.ofObj(line) with
|None
|Some("quit")->
sr.Close()
sw.Close()
|Some("left") ->
do! writeLineAsync sw "right"
return! loop2(c,sr,sw)
|Some(line) ->
do! writeLineAsync sw line
return! loop2(c,sr,sw)
}
let loop() =
async {
let! c = acceptClientAsync listener
let sr = new StreamReader(c.GetStream())
let sw = new StreamWriter(c.GetStream())
sw.AutoFlush <- true
do! handleClient c sr sw |> Async.StartChild |> Async.Ignore
return! loop()
}