stk/Demos/mc-server.stk

#!/bin/sh
:;exec /usr/local/bin/stk -load "$0" "$@"
;;;;
;;;; m c - s e r v e r  . s t k		-- A simple server which accept
;;;;					   multiple client connections
;;;;
;;;; Copyright <20> 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; 
;;;; Permission to use, copy, modify, distribute,and license this
;;;; software and its documentation for any purpose is hereby granted,
;;;; provided that existing copyright notices are retained in all
;;;; copies and that this notice is included verbatim in any
;;;; distributions.  No written agreement, license, or royalty fee is
;;;; required for any of the authorized uses.
;;;; This software is provided ``AS IS'' without express or implied
;;;; warranty.
;;;;
;;;;           Author: Erick Gallesio [eg@kaolin.unice.fr]
;;;;    Creation date: 23-Jul-1996 09:00
;;;; Last file update: 13-Sep-1999 18:01 (eg)

(require "posix")
(require "socket")

(define register-connection
  (let ((sockets '()))

    (lambda (s cnt)
      ;; Accept connection
      (socket-accept-connection s)

      ;; Save socket somewhere to avoid GC problems
      (set! sockets (cons s sockets))
  
      (let ((in   (socket-input s))
	    (out  (socket-output s))
	    (who  (socket-host-name s))
	    (addr (socket-host-address s)))
		 
	;; Display a greeting message
	(format out "Welcome ~A on server ~A\n" who (posix-host-name))
	(flush out)

	;; Signal new connection on standard output
	(format #t  "New connection (#~S) detected from ~A (~A)\n" cnt who addr)

	;; Create a handler for reading inputs from this new connection
	(when-port-readable in 
		(lambda ()
		  ;; And read all the lines coming from distant machine
		  (let ((l (read-line in)))
		    (if (eof-object? l)
			;; delete current handler
			(begin
			  (when-port-readable in #f)
			  (socket-shutdown s)
			  (set! sockets (remove s sockets))
			  (format #t "Connection #~S closed.\n" cnt))
			;; Just write the line read on the socket
			(begin
			  (format out "On connection #~S I've read --> ~A\n" cnt l)
			  (flush out))))))))))

;;;;
;;;; Program starts here
;;;;
(system "clear")

(define s (make-server-socket))

(format #t "Welcome on the multi-server demo
To use it you can open several windows and you can create a new connection with
	telnet ~A ~A
To exit this demo, just type
	(exit)
at the STk prompt
---------------------------------\n\n"
(posix-host-name) (socket-port-number s))

(when-socket-ready s (let ((count 0))
		       (lambda ()
			 (set! count (+ count 1))
			 (register-connection (socket-dup s) count))))


(format #t "Server ~A (~A) is waiting connection on port ~A ...\n"
	(posix-host-name) (socket-local-address s) (socket-port-number s))
(flush (current-output-port))