89 lines
2.6 KiB
Plaintext
89 lines
2.6 KiB
Plaintext
#!/usr/local/bin/stk -load
|
|
;;;;
|
|
;;;; m c - s e r v e r . s t k -- A simple server which accept
|
|
;;;; multiple client connections
|
|
;;;;
|
|
;;;; Copyright © 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: 3-Sep-1999 18:58 (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))
|
|
|