1: ;;
    2: ;; Sample to use <listener> and <selector> for server application
    3: ;;  $Id: scheme-server.scm,v 1.2 2003/10/01 12:30:51 shirok Exp $
    4: ;;
    5: ;; NOTE: This program is just for demonstation.  DO NOT RUN THIS
    6: ;; PROGRAM ON THE MACHINE THAT IS NOT PROTECTED PROPERLY, or anybody
    7: ;; can obtain your account remotely.
    8: 
    9: (use gauche.net)
   10: (use gauche.selector)
   11: (use gauche.listener)
   12: 
   13: (define (scheme-server port)
   14:   (let ((selector (make <selector>))
   15:         (servers  (make-server-sockets #f port :reuse-addr? #t))
   16:         (cid      0))
   17: 
   18:     (for-each
   19:      (lambda (server)
   20: 
   21:        (define (accept-handler sock flag)
   22:          (let* ((client (socket-accept server))
   23:                 (id     cid)
   24:                 (input  (socket-input-port client :buffering :none))
   25:                 (output (socket-output-port client))
   26:                 (finalize (lambda ()
   27:                             (selector-delete! selector input #f #f)
   28:                             (socket-close client)
   29:                             (format #t "client #~a disconnected\n" id)))
   30:                 (listener (make <listener>
   31:                             :input-port input
   32:                             :output-port output
   33:                             :error-port output
   34:                             :prompter (lambda () (format #t "client[~a]> " id))
   35:                             :finalizer finalize))
   36:                 (handler (listener-read-handler listener))
   37:                 )
   38:            (format #t "client #~a from ~a\n" cid (socket-address client))
   39:            (inc! cid)
   40:            (listener-show-prompt listener)
   41:            (selector-add! selector input (lambda _ (handler)) '(r))))
   42: 
   43:        (selector-add! selector
   44:                       (socket-fd server)
   45:                       accept-handler
   46:                       '(r)))
   47:      servers)
   48:     (format #t "scheme server started on port ~s\n" port)
   49:     (do () (#f) (selector-select selector))))
   50: 
   51: (define (main args)
   52:   (scheme-server 1359)
   53:   0)