[Chicken-users] threaded TCP server

[Shawn Rutledge]

I tried to write a server which provides a REPL to each incoming
connection, like this:

(define TCPPORT 8888)

(use tcp)
(use srfi-18)
(use environments)

(define listener (tcp-listen TCPPORT))

(let accept-loop ()
        (define-values (i o) (tcp-accept listener))
        (define-values (local-addr remote-addr) (tcp-addresses i))
        (define-values (local-port remote-port) (tcp-port-numbers i))
        (printf "connection accepted from ~s:~s~%" remote-addr remote-port)
        (thread-start! (lambda ()
                (let ([env (environment-copy (scheme-report-environment 5)  
#t)])
                        (environment-extend! env 'exit (lambda ()  
(close-output-port o)
(close-input-port i) ))
                        (write-line "; dsinpd 0.0.1" o)
                        (let reploop ()
                                (pp (eval (read i) env) o)
                                (reploop))
                )
        ))
        (accept-loop))

When I type (exit) into the telnet session, I get errors like this on
the server side:

Warning (#<thread: thread6>): : port already closed: #<output port (tcp)>

        Call history:

        <eval>          (environment-copy (scheme-report-environment 5) #t)
        <eval>          (scheme-report-environment 5)
        <eval>          (environment-extend! env (quote exit) (lambda
() (close-output-port o) (close-input-port i)))
        <eval>          (write-line "; dsinpd 0.0.1" o)
        <eval>          ((letrec ((reploop (##core#loop-lambda () (pp
(eval (read i) env) o) (reploop)))) reploop))
        <eval>          (pp (eval (read i) env) o)
        <eval>          (eval (read i) env)
        <eval>          (read i)
        <syntax>                (exit)
        <eval>          (exit)
        <eval>          (close-output-port o)
        <eval>          (close-input-port i)    <--


But it is necessary to close both ports, otherwise the client is not
disconnected.  The example server.scm on the wiki does not act like
this; so I think it must have to do with the combination of tcp and
lightweight threads.