[plt-scheme] Client-server example update

Okay, please disegard the sample code I've given before. I've cleaned  
it up a bit, so it doesn't look like a complete mess (see below).

My main questions are:

Is the use of the reader safe if the client sends malicious data  
(assuming the example is modified to work with TCP)?

How can this be modified such that the client can call server methods  
in a more natural manner, e.g. as in (display (call-server 'date)),  
which should block until a response from the server has been obtained?

Any hints and suggestions are welcome.

Best,

Erich

----------
;;; SIMPLE CLIENT-SERVER EXAMPLE
;;; uses pipes for now
;;; run (test) for test

(module server-test mzscheme

   (require (lib "date.ss"))
   (require (lib "kw.ss"))

   (read-accept-compiled #f)
   (read-accept-reader #f)

   (define/kw (warn msg #:rest args)
     (display (string-append "[Warn] " (apply format (cons msg  
args))) (current-error-port))
     (newline (current-error-port)))

   (define/kw (info msg #:rest args)
     (display (string-append "\n[Info] " (apply format (cons msg  
args))))
     (newline))

   (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 dest cmd cont)
       (let ((id (command-id cmd)))
         (hash-table-put! *sent* id cont)
         (write cmd dest)))

   (define/kw (->server body cont)
     (send to-B (apply make-command body) cont))

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

   (define (make-ok-reply cmd result)
     (list (command-id cmd) (list 'ok result)))

   (define (make-error-reply cmd msg)
     (list (command-id cmd) (list 'error msg)))

   (define/kw (make-command name #:rest args)
     (list (new-id) (append (list name) args)))

   (define (command-name cmd)
     (caadr cmd))

   (define (command-id cmd)
     (car cmd))

   (define (command-args cmd)
     (cdadr cmd))

   (define (command-body cmd)
     (cadr cmd))

   (define (make-server name in-port)
     (thread
      (lambda ()
        (let loop ((in (read in-port)))
          (info "~a ~s" name in)
          (with-handlers ((exn:fail:contract?
                           (lambda (exn)
                             (reply to-A
                                    (make-error-reply in (string- 
append (exn-message exn) (format ", in '~s'"  (command-body in))))))))
            (case (command-name in)
              ((time) (reply to-A (make-ok-reply in (apply now  
(command-args in)))))
              ((date) (reply to-A (make-ok-reply in (apply today  
(command-args in)))))
              ((rand) (reply to-A (make-ok-reply in (apply random  
(command-args in)))))
              (else (reply to-A (make-error-reply in (format "illegal  
command: '~s'" (command-name in)))))))
          (loop (read in-port))))))

   (define (handle-reply input)
     (case (command-name input)
       ((ok) (let ((callback (hash-table-get
                              *sent*
                              (command-id input)
                              (lambda () (warn "illegal reply value  
or internal error; no sent command was found for reply ~s" input) #f))))
               (hash-table-remove! *sent* (command-id input))
               (when callback (apply callback (command-args input)))))
       ((error) (warn "server returned an error: ~s" (command-args  
input)))
       (else (warn "illegal or unsupported server reply: ~s" input))))

   (define (make-client name in-port)
     (thread
      (lambda ()
        (let loop ((in (read in-port)))
          (info "~a ~s" name in)
          (if (and (pair? in) (number? (car in)))
              (handle-reply in)
              (info "client command handling not supported or illegal  
reply: '~s'" in))
          (loop (read in-port))))))

   (define rec:from-A (make-server "Server B received from client A:  
" from-A))
   (define rec:from-B (make-client "Client 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))))
   )