[plt-scheme] Questions about client-server example (synchronizing write, reading sexpr safely, futures, and more)

Hi,

I've got some questions about the toy sample below. It has a few  
obvious deficiencies with which I'll deal later, e.g. the client just  
ceases to work when it raises an exception. Since this is ultimately  
intended for use in a real-world project, there is a few issues about  
which I'd like to hear some advice:

1. The writing of replies is threaded and delayed randomly in order  
to test asynchronous replies (i.e. client sends A, then B and  
receives reply-to-B before of reply-to-A). That means that I should  
make writes atomic, shouldn't I? How? I've looked up write-special- 
evt in the help desk, but can't figure out how to use it. Or is the  
normal write already atomic for ports created by make-pipe? What  
about TCP?

2. Would it be possible to implement client calls to the server that  
work like this:

(+ 10 (call '(rand 10)))

==> 16 ; or something else

(+ 10 (call '(rand 0)))

==> server error: random: expects argument of type <exact integer in  
[1, 2147483647]

I guess this time I really want futures, but how do I get them?

3. Is the use of apply in the sample code safe? I can't see why not,  
but want to be sure.

4. Can the reader be used in a real-world, TCP-based client-server  
implementation or does this pose security risks? Blocking doesn't  
seem to be a problem, since in the end there will be a guard that  
kills an inactive client connection after some time, but I wonder  
about other risks. Do I need special input validation or a customized  
reader? I'd much prefer sexprs over xml, but if anyone can convince  
me of the opposite, please go ahead.

5. Does anyone have a similar client-server example with  
'asynchronous reply handling' to look into? Is there a library that  
already does what I want (passing messages from A to B and handling  
replies from B in any order received and asynchronously)?

With best regards,

Erich

;;; -------------------------------------------------------------
;;; ----- CLIENT-SERVER EXAMPLE ---------------
;;; -------------------------------------------------------------
;;; just uses pipes for now
;;;  to run, call (test) and wait for output

(module server-test mzscheme

   (require (lib "date.ss"))

   (define (today)
     (date->string (seconds->date (current-seconds))))

   (define (now)
     (let ((t (seconds->date (current-seconds))))
       (string-append (number->string (date-hour t)) ":" (number- 
 >string (date-minute t)) ":" (number->string (date-second t)))))

   (define-values  (from-B to-A) (make-pipe))
   (define-values (from-A to-B) (make-pipe))

   (define new-id
     (let ((counter 0))
       (lambda ()
         (set! counter (+ counter 1))
         counter)))

   (define *sent* (make-hash-table))

   (define send
       (lambda (dest message cont)
         (let ((cmd-id (new-id)))
           (hash-table-put! *sent* cmd-id cont)
           (write (list cmd-id message) dest))))

   (define (->server msg cont)
     (send to-B msg cont))

   (define (reply dest message)
     (thread
      (lambda ()
        (sleep (random 30)) ; for testing async command-reply
        (write message dest))))

   (define (make-server name in-port)
     (thread
      (lambda ()
        (let loop ((in (read in-port)))
          (unless (eof-object? in)
            (display name)(print in)(newline)
            (with-handlers ((exn:fail:contract?
                             (lambda (exn) (reply to-A (list (car in)  
(list 'error (string-append (exn-message exn) (format ", in  
'~a'"  (cadr in)))))))))
              (case (caadr in)
                ((time) (reply to-A (list (car in) (list 'ok (apply  
now (cdadr in))))))
                ((date) (reply to-A (list (car in) (list 'ok (apply  
today (cdadr in))))))
                ((rand) (reply to-A (list (car in) (list 'ok (apply  
random (cdadr in))))))
                (else (reply to-A (list (car in) (list 'error (format  
"illegal command: '~s'" (caadr in))))))))
            (loop (read in-port)))))))

   (define (handle-reply input)
     (case (caadr input)
       ((ok) (let ((callback (hash-table-get
                              *sent*
                              (car input)
                              (lambda () (error 'handle-reply  
"illegal reply value or internal error; the command was never sent,  
in: ~a" input)))))
               (hash-table-remove! *sent* (car input))
                (apply callback (cdadr input))))
       ((error) (error 'handle-reply "server returned an error:  
~a" (cdadr input)))
       (else (error 'handle-reply "illegal or unsupported server  
reply: ~a" input))))

   (define (make-client name in-port)
     (thread
      (lambda ()
        (let loop ((in (read in-port)))
          (unless (eof-object? in)
            (display name)(print in)(newline))
          (if (number? (car in))
             (handle-reply in)
             (begin (display (format "client command handling not  
supported or illegal reply: '~a'" in))(newline)))
          (loop (read in-port))))))

   (define rec:from-A (make-server "\nServer B received from client  
A: " from-A))
   (define rec:from-B (make-client "\nClient A received from server  
B: " from-B))

   (define (test)
     (->server '(time) (lambda (t) (display t)(newline)))
     (->server '(date)(lambda (d)(display d)(newline)))
     (->server '(rand) (lambda (r)(display r)(newline)))
     (->server '(rand) (lambda (r)(display r)(newline))))
   )