Timesharing System in Eight lines of Code

Thanks to this marvelously trivial tutorial,

Next is stuff to remember multiple value syntax:

(call-with-values (lambda () (values 4 5))
                  (lambda (a b) b))

(define-values (x y) (values 3 4))

(let-values ([(x y) (values 5 x)]) y)

Headers:

(define SERVICE-PORT 7000)
(define SERVER-HOST "localhost")

Trivial Client:

(define (client)
    (let-values ([(server->me me->server)
                  (tcp-connect SERVER-HOST SERVICE-PORT)])
      (write 'ping me->server)
      (close-output-port me->server)
      (let ([response (read server->me)])
        (display response) (newline)
        (close-input-port server->me))))

Trivial Server:

(define (server)
    (let ([listener (tcp-listen SERVICE-PORT)])
      (let-values ([(client->me me->client)
                    (tcp-accept listener)])
        (if (eq? (read client->me) 'ping)
            (write 'pong me->client)
            (write 'who-are-you? me->client))
        (close-output-port me->client)
        (close-input-port client->me))))

To telnet to (we escalate):

(define (server)
    (let ([listener (tcp-listen SERVICE-PORT)])
      (let-values ([(client->me me->client)
                    (tcp-accept listener)])
        (let z ()(write (read client->me)) (newline)(z))        
        )))

The above is a read-print loop in contrast to a read-eval-print loop. This version (plus this) is a read-categorize-print loop. In these programs a lexical level error is reported at the server and not the client.

Timesharing system:

(define (server)
   (let ([listener (tcp-listen SERVICE-PORT)])
    (let nt () (let-values ([(client->me me->client)
                    (tcp-accept listener)])
        (thread (lambda ()
          (let z ()(write (read client->me))
              (newline)(z)))) (write "new user") (nt)))
))

Timesharing system, numbers users:

(define (server)
   (let ([listener (tcp-listen SERVICE-PORT)])
    (let nt ((c 0)) (let-values ([(client->me me->client)
                    (tcp-accept listener)])
        (thread (lambda ()
          (let z ()(write (list c (read client->me)))
            (newline)(z)))) (display (list "new user" c))
              (nt (+ c 1))))
))

And now a read-eval-print loop for multi-users.

(define (server)
   (let ([listener (tcp-listen 7000)])
    (let nt ((c 0)) (let-values ([(client->me me->client)
                    (tcp-accept listener)])
       (let ((env (scheme-report-environment 5)))
        (thread (lambda ()
          (write (list "Hello" c) me->client)
          (newline me->client)
          (let z ()
            (write (eval (read client->me) env) me->client)
            (newline me->client)(z)))))
       (display (list "new user" c))
       (nt (+ c 1))))))

With the above we have a compartmented timesharing system. Syntax and run errors are still reported at the server. No space accountability. No time accountability. Service denial possible. (write 42) prints at server.

So far we have used only MzScheme's thread and internet primitives; Otherwise it is standard R5RS. To solve the problem with implicit ports we resort to MzScheme's parameters which are an adjunct of the thread logic. I don't know how to solve this problem in R5RS.

(define (server)
   (let ([listener (tcp-listen 7000)])
    (let nt ((c 0)) (let-values ([(client->me me->client)
                    (tcp-accept listener)])
       (let ((env (scheme-report-environment 5)))
        (thread (lambda ()
          (current-input-port client->me)
          (current-output-port me->client)
          (write (list "Hello" c)) (newline)
          (let z ()
            (write (eval (read client->me) env))
            (newline)(z)))))
       (display (list "new user" c))(newline)
       (nt (+ c 1))))))