option.lisp - clic - Clic is an command line interactive client for gopher writ… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
option.lisp (9993B) | |
--- | |
1 ;;;; -*- Mode: LISP; Base: 10; Syntax: ANSI-Common-lisp; Package: USOCKE… | |
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) &… | |
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 symb… | |
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… | |
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)) … | |
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-usocke… | |
192 (option (eql :reuse-address))… | |
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)) &ke… | |
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)) … | |
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)) &… | |
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)) |