[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Q] How to do Simple Port-Based Input-Process-Output?



Quoting "Dave Duchesneau":
> Assuming that I want to do the processing portion of the following 
> sequence in Scheme, is there a standard idiom for doing the I/O portion
> of sequence in Scheme also?

I think you're looking for `tcp-listen', `tcp-accept', and
`tcp-connect'. See the MzScheme manual for details.

As an example, here's a simple server-running function:

 (define (run-simple-server port-number session-proc)
  (let ([l (tcp-listen port-number)])
    (let loop ()
      (let-values ([(in out) (tcp-accept l)])
        ;; read from `in', write to `out'
        (session-proc in out)
        
        (close-input-port in)
        (close-output-port out)
        (loop)))))

And here's a use:

 ;; A "hello" server on 40001
 (run-simple-server 40001 (lambda (in out)
                           (let ([name (read in)])
                             (display "Hello " out)
                             (display name out)
                             (newline out))))
                             

In version 200, MzLib provides a more sophisticated `run-server'
procedure that handles each session in its own thread (so multiple
sessions can be active), gracefully deals with exceptions, prevents
resource leaks, and supports session timeouts. The implementation is
four times as long, included below.

Matthew

----------------------------------------

  (define (run-server port-number handler connection-timeout)
    (let ([l (tcp-listen port-number)]
	  [can-break? (break-enabled)])
      (dynamic-wind
       void
       (lambda ()
         ;; loop to handle connections
         (let loop ()
           (with-handlers ([not-break-exn? void])
             ;; Make a custodian for the next session:
             (let ([c (make-custodian)])
               (parameterize ([current-custodian c])
                 ;; disable breaks during session set-up...
                 (parameterize ([break-enabled #f])
                   ;; ... but enable breaks while blocked on an accept:
                   (let-values ([(r w) ((if can-break?
                                            tcp-accept/enable-break
                                            tcp-accept)
                                        l)])
                     ;; Handler thread:
                     (let ([t (thread (lambda () 
                                        (when can-break?
                                          (break-enabled #t))
                                        (handler r w)))])
                       ;; Clean-up and timeout thread:
                       (thread (lambda () 
                                 (object-wait-multiple connection-timeout t)
                                 (when (thread-running? t)
                                   ;; Only happens if timeout is not #f
                                   (break-thread t))
                                 (object-wait-multiple connection-timeout t)
                                 (custodian-shutdown-all c)))))))))
           (loop)))
       (lambda () (tcp-close l))))))