forked from krissg/junkie
-
Notifications
You must be signed in to change notification settings - Fork 4
/
Copy pathsock-check.scm
executable file
·174 lines (159 loc) · 6.54 KB
/
sock-check.scm
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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
#!../src/junkie -c
; vim:syntax=scheme expandtab filetype=scheme
; coding: iso-8859-1
!#
(use-modules (ice-9 match))
(display "Testing some sock related functions\n")
(let ((logfile "sock-check.log"))
(false-if-exception (delete-file logfile))
(set-log-file logfile)
(set-log-level log-debug "sock")
(set-log-level log-debug "guile"))
(slog log-debug "Check UDP socks")
; We first try to setup a server connection (guess until we found an unused port)
(define (random-between mi ma) ; inclusive
(+ mi (random (1+ (- ma mi)))))
(define (random-port)
(random-between 1024 65535))
(slog log-debug "Check some erroneous make-sock")
(catch 'invalid-argument
(lambda () (make-sock 'quantum-teleportation 123))
(lambda (k . args)
(slog log-debug "Catched exception with args: ~s" args)))
(slog log-debug "test UDP sock")
(define (test-udp-sock-to host port)
(false-if-exception
(let ((sock (make-sock 'udp 'client host port)))
(sock-send sock "hello"))))
(call-with-values
(lambda ()
(let loop ((num-try 0))
(if (>= num-try 10)
(throw 'cannot-create-udp-server)
(let ((port (random-port)))
(catch 'cannot-create-sock
(lambda ()
(values port (make-sock 'udp 'server port)))
(lambda (k . args) (loop (1+ num-try))))))))
(lambda (port srv-sock)
(slog log-debug "UDP server listening on port ~s, socket ~s" port srv-sock)
; now try to connect to it
(assert (test-udp-sock-to "localhost" port)) ; should work
(assert (test-udp-sock-to "localhost" (number->string port))) ; should work as well
(assert (test-udp-sock-to "127.0.0.1" port))
port)) ; and again
(slog log-debug "test TCP sock")
(define (test-tcp-sock-to host port)
(false-if-exception
(let ((sock (make-sock 'tcp 'client host port)))
(sock-send sock "hello"))))
(call-with-values
(lambda ()
(let loop ((num-try 0))
(if (>= num-try 10)
(throw 'cannot-create-tcp-server)
(let ((port (random-port)))
(catch 'cannot-create-sock
(lambda ()
(values port (make-sock 'tcp 'server port)))
(lambda (k . args) (loop (1+ num-try))))))))
(lambda (port srv-sock)
(slog log-debug "TCP server listening on port ~s, socket ~s" port srv-sock)
; now try to connect to it
(assert (test-tcp-sock-to "localhost" port)) ; should work
(assert (test-tcp-sock-to "localhost" (number->string port))) ; should work as well
(assert (test-tcp-sock-to "127.0.0.1" port))
port)) ; and again
(slog log-debug "test UNIX sock")
(let ((file "./sock-check.sock")
(srv-sock #f)
(clt-sock #f)
(test-msg "glop glop"))
(set! srv-sock (make-sock 'unix 'server file))
(slog log-debug "UNIX domain server: ~s" srv-sock)
; now try to connect to it
(set! clt-sock (make-sock 'unix 'client file))
(slog log-debug "UNIX domain client: ~s" clt-sock)
(assert (sock-send clt-sock test-msg))
(assert (string=? (car (sock-recv srv-sock)) test-msg))
; Now let's test garbage collecting of srv-sock
(slog log-debug "GCing sock objects")
(set! srv-sock #f)
(gc)
(slog log-debug "Trying to connect again to server...")
(assert (not (sock-send clt-sock "pas glop"))))
(slog log-debug "test FILE sock")
(define (test-file max-file-size)
(let ((file "./sock-check")
(srv-sock #f)
(clt-sock #f)
(test-msg "glop glop"))
(system (string-append "rm -rf " file))
(set! srv-sock (make-sock 'file 'server file max-file-size))
(slog log-debug "File-msg server: ~s" srv-sock)
; now try to connect to it
(set! clt-sock (make-sock 'file 'client file max-file-size))
(slog log-debug "File-msg client: ~s" clt-sock)
; test the connection with enough messages to trigger several file changes
(let loop ((n 20))
(assert (sock-send clt-sock test-msg))
(assert (string=? (car (sock-recv srv-sock)) test-msg))
(if (> n 0) (loop (- n 1))))))
(test-file 0) ; all msgs in one big file
(test-file 60) ; a few msgs per file
(test-file 1) ; one file per message
(gc)
(slog log-debug "test UDP _buffered_ sock")
(define (test-buf mtu)
(let ((srv-sock #f)
(clt-sock #f)
(ll-srv-sock #f) ; keep a reference so that the underlying C struct wont be freed (nor socket closed)
(ll-clt-sock #f)
(port (random-port))
(test-msg "glop glop pas glop")
(num-rcvd 0)
(num-sent 0))
(set! ll-srv-sock (make-sock 'udp 'server port))
(set! ll-clt-sock (make-sock 'udp 'client "localhost" port))
(set! srv-sock (make-sock 'buffered mtu ll-srv-sock))
(slog log-debug "server: ~s" srv-sock)
; now try to connect to it
(set! clt-sock (make-sock 'buffered mtu ll-clt-sock))
(slog log-debug "client: ~s" clt-sock)
(let ((thread (make-thread (lambda ()
(set-thread-name "buf reader")
(let loop ((done #f))
(for-each (lambda (msg)
(slog log-debug "received: ~s" msg)
(cond
[(string=? "END" msg)
(slog log-debug "Read END")
(set! done #t)]
[(string=? test-msg msg)
(slog log-debug "Read 1 message")
(set! num-rcvd (1+ num-rcvd))]
[else
(assert #f)]))
(sock-recv srv-sock))
(if (not done) (loop #f)))))))
(let loop ((n 20))
(assert (sock-send clt-sock test-msg))
(slog log-debug "Write 1 message")
(set! num-sent (1+ num-sent))
(if (> n 1) (loop (- n 1))))
(assert (sock-send clt-sock "END"))
(slog log-debug "Disconnecting client")
(set! clt-sock #f) ; flush
(gc)
(join-thread thread)
(slog log-debug "Disconnecting server")
(set! srv-sock #f)
(set! ll-srv-sock #f)
(set! ll-clt-sock #f)
(gc)
(slog log-debug "We've sent ~a msgs and read ~a" num-sent num-rcvd)
(assert (= num-sent num-rcvd)))))
(test-buf 32) ; small buffer
(test-buf 100) ; a few msgs per PDU
(test-buf 1000) ; all in one PDU
(exit)