69 lines
2.1 KiB
Plaintext
69 lines
2.1 KiB
Plaintext
(define (timestamp) (syscall 201 "%c"))
|
|
|
|
(fork-server 'chat-room (lambda ()
|
|
(let this ((visitors #empty))
|
|
(let* ((envelope (wait-mail))
|
|
(sender msg envelope))
|
|
(case msg
|
|
(['join who name]
|
|
(let ((visitors (put visitors who name)))
|
|
(for-each (lambda (who)
|
|
(print-to (car who) name " joined to as"))
|
|
(ff->alist visitors))
|
|
(this visitors)))
|
|
(['talk message]
|
|
(for-each (lambda (who)
|
|
(print-to (car who) (cdr who) ": " message))
|
|
(ff->alist visitors))
|
|
(this visitors))
|
|
(['part who]
|
|
(for-each (lambda (who)
|
|
(print-to (car who) (visitors (car who) "unknown") " leaved"))
|
|
(ff->alist visitors))
|
|
(let ((visitors (del visitors who)))
|
|
(this visitors))))))))
|
|
|
|
|
|
(define (on-accept name fd)
|
|
(lambda ()
|
|
(print "# " (timestamp) "> we got new visitor: " name)
|
|
(mail 'chat-room ['join fd name])
|
|
|
|
(let*((ss1 ms1 (clock)))
|
|
(let loop ((str #null) (stream (force (port->bytestream fd))))
|
|
(cond
|
|
((null? stream)
|
|
#false)
|
|
((function? stream)
|
|
(mail 'chat-room ['talk (list->string (reverse str))])
|
|
(loop #null (force stream)))
|
|
(else
|
|
(loop (cons (car stream) str) (cdr stream)))))
|
|
(syscall 3 fd)
|
|
(let*((ss2 ms2 (clock)))
|
|
(print "# " (timestamp) "> visitor leave us. It takes " (+ (* (- ss2 ss1) 1000) (- ms2 ms1)) "ms.")))
|
|
(mail 'chat-room ['part fd])
|
|
))
|
|
|
|
(define (run port)
|
|
(let ((socket (syscall 41)))
|
|
; bind
|
|
(let loop ((port port))
|
|
(if (not (syscall 49 socket port)) ; bind
|
|
(loop (+ port 2))
|
|
(print "Server binded to " port)))
|
|
; listen
|
|
(if (not (syscall 50 socket)) ; listen
|
|
(shutdown (print "Can't listen")))
|
|
|
|
; accept
|
|
(let loop ()
|
|
(if (syscall 23 socket) ; select
|
|
(let ((fd (syscall 43 socket))) ; accept
|
|
;(print "\n# " (timestamp) ": new request from " (syscall 51 fd))
|
|
(fork (on-accept (syscall 51 fd) fd))))
|
|
(sleep 0)
|
|
(loop))))
|
|
|
|
(run 8080)
|