90 lines
2.6 KiB
Executable File

:;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 © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <>
;;;; 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 []
;;;; 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
(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
(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
at the STk prompt
(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))