stk/Demos/mc-server.stk

90 lines
2.6 KiB
Plaintext
Raw Normal View History

1999-09-27 07:20:21 -04:00
#!/bin/sh
:;exec /usr/local/bin/stk -load "$0" "$@"
1996-09-27 06:29:02 -04:00
;;;;
;;;; m c - s e r v e r . s t k -- A simple server which accept
;;;; multiple client connections
;;;;
1999-09-05 07:16:41 -04:00
;;;; Copyright <20> 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
1996-09-27 06:29:02 -04:00
;;;;
1999-09-05 07:16:41 -04:00
;;;; 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.
1996-09-27 06:29:02 -04:00
;;;;
;;;; Author: Erick Gallesio [eg@kaolin.unice.fr]
;;;; Creation date: 23-Jul-1996 09:00
1999-09-27 07:20:21 -04:00
;;;; Last file update: 13-Sep-1999 18:01 (eg)
1996-09-27 06:29:02 -04:00
(require "posix")
(require "socket")
(define register-connection
(let ((sockets '()))
(lambda (s cnt)
;; Accept connection
(socket-accept-connection s)
1998-04-10 06:59:06 -04:00
;; Save socket somewhere to avoid GC problems
1996-09-27 06:29:02 -04:00
(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
1999-09-05 07:16:41 -04:00
(format #t "New connection (#~S) detected from ~A (~A)\n" cnt who addr)
1996-09-27 06:29:02 -04:00
;; Create a handler for reading inputs from this new connection
(when-port-readable in
(lambda ()
1998-04-10 06:59:06 -04:00
;; And read all the lines coming from distant machine
1996-09-27 06:29:02 -04:00
(let ((l (read-line in)))
(if (eof-object? l)
;; delete current handler
(begin
(when-port-readable in #f)
1998-04-10 06:59:06 -04:00
(socket-shutdown s)
1999-09-05 07:16:41 -04:00
(set! sockets (remove s sockets))
(format #t "Connection #~S closed.\n" cnt))
1996-09-27 06:29:02 -04:00
;; 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))