-
Notifications
You must be signed in to change notification settings - Fork 1
/
server.ss
executable file
·53 lines (47 loc) · 1.77 KB
/
server.ss
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
#! /usr/bin/env -S chez-scheme --debug-on-exception --script
;; Simple Echo Server taken from:
;; https://srfi.schemers.org/srfi-106/srfi-106.html
;; Copyright (C) Takashi Kato (2012). All Rights Reserved.
;; Adapted to run via chez-socket by Jerry 2019-2021 Unlicensed.
;;
;; The key difference between this and the canonical example is the need to
;; flush the output port. ie, call `flush-output-port`.
;;
;; Also added a number of debug prints.
(import
(rnrs)
(srfi :106 socket))
(define port "5000")
(define (server-run srv)
(define (get-line-from-binary-port bin)
(utf8->string
(call-with-bytevector-output-port
(lambda (out)
(let loop ((b (get-u8 bin)))
(display "server: recv-char ")(display b)(newline)
(case b
((#!eof)
(display "server: EOF")(newline)
#t)
((#xA) ;; newline (\n)
(display "server: returning")(newline)
#t)
((#xD)
(loop (get-u8 bin))) ;; carriage return (\r)
(else
(put-u8 out b)
(loop (get-u8 bin)))))))))
(display "server: listening on port ")(display port)(newline)
(display srv)(newline)
(call-with-socket (socket-accept srv)
(lambda (sock)
(display "server: accepted peer connection")(newline)
(let ((in (socket-input-port sock))
(out (socket-output-port sock)))
(let loop ((r (get-line-from-binary-port in)))
(display "server: read-line '")(display r)(display "'")(newline)
(unless (string=? r "")
(put-bytevector out (string->utf8 (string-append r "\r\n")))
(flush-output-port out)
(loop (get-line-from-binary-port in))))))))
(server-run (make-server-socket port))