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