toption.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) LICENSE
---
toption.lisp (9694B)
---
1 ;;;; SOCKET-OPTION, a high-level socket option get/set framework
2
3 ;;;; See LICENSE for licensing information.
4
5 (in-package :usocket)
6
7 ;;; Interface definition
8
9 (defgeneric socket-option (socket option &key)
10 (:documentation
11 "Get a socket's internal options"))
12
13 (defgeneric (setf socket-option) (new-value socket option &key)
14 (:documentation
15 "Set a socket's internal options"))
16
17 ;;; Handling of wrong type of arguments
18
19 (defmethod socket-option ((socket usocket) (option t) &key)
20 (error 'type-error :datum option :expected-type 'keyword))
21
22 (defmethod (setf socket-option) (new-value (socket usocket) (option t) &key)
23 (declare (ignore new-value))
24 (socket-option socket option))
25
26 (defmethod socket-option ((socket usocket) (option symbol) &key)
27 (if (keywordp option)
28 (error 'unimplemented :feature option :context 'socket-option)
29 (error 'type-error :datum option :expected-type 'keyword)))
30
31 (defmethod (setf socket-option) (new-value (socket usocket) (option symbol) &key)
32 (declare (ignore new-value))
33 (socket-option socket option))
34
35 ;;; Socket option: RECEIVE-TIMEOUT (SO_RCVTIMEO)
36
37 (defmethod socket-option ((usocket stream-usocket)
38 (option (eql :receive-timeout)) &key)
39 (declare (ignorable option))
40 (let ((socket (socket usocket)))
41 (declare (ignorable socket))
42 #+abcl
43 () ; TODO
44 #+allegro
45 () ; TODO
46 #+clisp
47 (socket:socket-options socket :so-rcvtimeo)
48 #+clozure
49 (ccl:stream-input-timeout socket)
50 #+cmu
51 (lisp::fd-stream-timeout (socket-stream usocket))
52 #+ecl
53 (sb-bsd-sockets:sockopt-receive-timeout socket)
54 #+lispworks
55 (get-socket-receive-timeout socket)
56 #+mcl
57 () ; TODO
58 #+mocl
59 () ; unknown
60 #+sbcl
61 (sb-impl::fd-stream-timeout (socket-stream usocket))
62 #+scl
63 ())) ; TODO
64
65 (defmethod (setf socket-option) (new-value (usocket stream-usocket)
66 (option (eql :receive-timeout)) &key)
67 (declare (type number new-value) (ignorable new-value option))
68 (let ((socket (socket usocket))
69 (timeout new-value))
70 (declare (ignorable socket timeout))
71 #+abcl
72 () ; TODO
73 #+allegro
74 () ; TODO
75 #+clisp
76 (socket:socket-options socket :so-rcvtimeo timeout)
77 #+clozure
78 (setf (ccl:stream-input-timeout socket) timeout)
79 #+cmu
80 (setf (lisp::fd-stream-timeout (socket-stream usocket))
81 (coerce timeout 'integer))
82 #+ecl
83 (setf (sb-bsd-sockets:sockopt-receive-timeout socket) timeout)
84 #+lispworks
85 (set-socket-receive-timeout socket timeout)
86 #+mcl
87 () ; TODO
88 #+mocl
89 () ; unknown
90 #+sbcl
91 (setf (sb-impl::fd-stream-timeout (socket-stream usocket))
92 (coerce timeout 'single-float))
93 #+scl
94 () ; TODO
95 new-value))
96
97 ;;; Socket option: SEND-TIMEOUT (SO_SNDTIMEO)
98
99 (defmethod socket-option ((usocket stream-usocket)
100 (option (eql :send-timeout)) &key)
101 (declare (ignorable option))
102 (let ((socket (socket usocket)))
103 (declare (ignorable socket))
104 #+abcl
105 () ; TODO
106 #+allegro
107 () ; TODO
108 #+clisp
109 (socket:socket-options socket :so-sndtimeo)
110 #+clozure
111 (ccl:stream-output-timeout socket)
112 #+cmu
113 (lisp::fd-stream-timeout (socket-stream usocket))
114 #+ecl
115 (sb-bsd-sockets:sockopt-send-timeout socket)
116 #+lispworks
117 (get-socket-send-timeout socket)
118 #+mcl
119 () ; TODO
120 #+mocl
121 () ; unknown
122 #+sbcl
123 (sb-impl::fd-stream-timeout (socket-stream usocket))
124 #+scl
125 ())) ; TODO
126
127 (defmethod (setf socket-option) (new-value (usocket stream-usocket)
128 (option (eql :send-timeout)) &key)
129 (declare (type number new-value) (ignorable new-value option))
130 (let ((socket (socket usocket))
131 (timeout new-value))
132 (declare (ignorable socket timeout))
133 #+abcl
134 () ; TODO
135 #+allegro
136 () ; TODO
137 #+clisp
138 (socket:socket-options socket :so-sndtimeo timeout)
139 #+clozure
140 (setf (ccl:stream-output-timeout socket) timeout)
141 #+cmu
142 (setf (lisp::fd-stream-timeout (socket-stream usocket))
143 (coerce timeout 'integer))
144 #+ecl
145 (setf (sb-bsd-sockets:sockopt-send-timeout socket) timeout)
146 #+lispworks
147 (set-socket-send-timeout socket timeout)
148 #+mcl
149 () ; TODO
150 #+mocl
151 () ; unknown
152 #+sbcl
153 (setf (sb-impl::fd-stream-timeout (socket-stream usocket))
154 (coerce timeout 'single-float))
155 #+scl
156 () ; TODO
157 new-value))
158
159 ;;; Socket option: REUSE-ADDRESS (SO_REUSEADDR), for TCP server
160
161 (defmethod socket-option ((usocket stream-server-usocket)
162 (option (eql :reuse-address)) &key)
163 (declare (ignorable option))
164 (let ((socket (socket usocket)))
165 (declare (ignorable socket))
166 #+abcl
167 () ; TODO
168 #+allegro
169 () ; TODO
170 #+clisp
171 (int->bool (socket:socket-options socket :so-reuseaddr))
172 #+clozure
173 (int->bool (get-socket-option-reuseaddr socket))
174 #+cmu
175 () ; TODO
176 #+lispworks
177 (get-socket-reuse-address socket)
178 #+mcl
179 () ; TODO
180 #+mocl
181 () ; unknown
182 #+(or ecl sbcl)
183 (sb-bsd-sockets:sockopt-reuse-address socket)
184 #+scl
185 ())) ; TODO
186
187 (defmethod (setf socket-option) (new-value (usocket stream-server-usocket)
188 (option (eql :reuse-address)) &key)
189 (declare (type boolean new-value) (ignorable new-value option))
190 (let ((socket (socket usocket)))
191 (declare (ignorable socket))
192 #+abcl
193 () ; TODO
194 #+allegro
195 (socket:set-socket-options socket option new-value)
196 #+clisp
197 (socket:socket-options socket :so-reuseaddr (bool->int new-value))
198 #+clozure
199 (set-socket-option-reuseaddr socket (bool->int new-value))
200 #+cmu
201 () ; TODO
202 #+lispworks
203 (set-socket-reuse-address socket new-value)
204 #+mcl
205 () ; TODO
206 #+mocl
207 () ; unknown
208 #+(or ecl sbcl)
209 (setf (sb-bsd-sockets:sockopt-reuse-address socket) new-value)
210 #+scl
211 () ; TODO
212 new-value))
213
214 ;;; Socket option: BROADCAST (SO_BROADCAST), for UDP client
215
216 (defmethod socket-option ((usocket datagram-usocket)
217 (option (eql :broadcast)) &key)
218 (declare (ignorable option))
219 (let ((socket (socket usocket)))
220 (declare (ignorable socket))
221 #+abcl
222 () ; TODO
223 #+allegro
224 () ; TODO
225 #+clisp
226 (int->bool (socket:socket-options socket :so-broadcast))
227 #+clozure
228 (int->bool (get-socket-option-broadcast socket))
229 #+cmu
230 () ; TODO
231 #+ecl
232 () ; TODO
233 #+lispworks
234 () ; TODO
235 #+mcl
236 () ; TODO
237 #+mocl
238 () ; unknown
239 #+sbcl
240 (sb-bsd-sockets:sockopt-broadcast socket)
241 #+scl
242 ())) ; TODO
243
244 (defmethod (setf socket-option) (new-value (usocket datagram-usocket)
245 (option (eql :broadcast)) &key)
246 (declare (type boolean new-value) (ignorable new-value option))
247 (let ((socket (socket usocket)))
248 (declare (ignorable socket))
249 #+abcl
250 () ; TODO
251 #+allegro
252 (socket:set-socket-options socket option new-value)
253 #+clisp
254 (socket:socket-options socket :so-broadcast (bool->int new-value))
255 #+clozure
256 (set-socket-option-broadcast socket (bool->int new-value))
257 #+cmu
258 () ; TODO
259 #+ecl
260 () ; TODO
261 #+lispworks
262 () ; TODO
263 #+mcl
264 () ; TODO
265 #+mocl
266 () ; unknown
267 #+sbcl
268 (setf (sb-bsd-sockets:sockopt-broadcast socket) new-value)
269 #+scl
270 () ; TODO
271 new-value))
272
273 ;;; Socket option: TCP-NODELAY (TCP_NODELAY), for TCP client
274
275 (defmethod socket-option ((usocket stream-usocket)
276 (option (eql :tcp-no-delay)) &key)
277 (declare (ignore option))
278 (socket-option usocket :tcp-nodelay))
279
280 (defmethod socket-option ((usocket stream-usocket)
281 (option (eql :tcp-nodelay)) &key)
282 (declare (ignorable option))
283 (let ((socket (socket usocket)))
284 (declare (ignorable socket))
285 #+abcl
286 () ; TODO
287 #+allegro
288 () ; TODO
289 #+clisp
290 (int->bool (socket:socket-options socket :tcp-nodelay))
291 #+clozure
292 (int->bool (get-socket-option-tcp-nodelay socket))
293 #+cmu
294 ()
295 #+ecl
296 (sb-bsd-sockets::sockopt-tcp-nodelay socket)
297 #+lispworks
298 (int->bool (get-socket-tcp-nodelay socket))
299 #+mcl
300 () ; TODO
301 #+mocl
302 () ; unknown
303 #+sbcl
304 (sb-bsd-sockets::sockopt-tcp-nodelay socket)
305 #+scl
306 ())) ; TODO
307
308 (defmethod (setf socket-option) (new-value (usocket stream-usocket)
309 (option (eql :tcp-no-delay)) &key)
310 (declare (ignore option))
311 (setf (socket-option usocket :tcp-nodelay) new-value))
312
313 (defmethod (setf socket-option) (new-value (usocket stream-usocket)
314 (option (eql :tcp-nodelay)) &key)
315 (declare (type boolean new-value) (ignorable new-value option))
316 (let ((socket (socket usocket)))
317 (declare (ignorable socket))
318 #+abcl
319 () ; TODO
320 #+allegro
321 (socket:set-socket-options socket :no-delay new-value)
322 #+clisp
323 (socket:socket-options socket :tcp-nodelay (bool->int new-value))
324 #+clozure
325 (set-socket-option-tcp-nodelay socket (bool->int new-value))
326 #+cmu
327 ()
328 #+ecl
329 (setf (sb-bsd-sockets::sockopt-tcp-nodelay socket) new-value)
330 #+lispworks
331 (progn
332 #-(or lispworks4 lispworks5.0)
333 (comm::set-socket-tcp-nodelay socket new-value)
334 #+(or lispworks4 lispworks5.0)
335 (set-socket-tcp-nodelay socket (bool->int new-value)))
336 #+mcl
337 () ; TODO
338 #+mocl
339 () ; unknown
340 #+sbcl
341 (setf (sb-bsd-sockets::sockopt-tcp-nodelay socket) new-value)
342 #+scl
343 () ; TODO
344 new-value))
345
346 (eval-when (:load-toplevel :execute)
347 (export 'socket-option))