tusocket.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
---
tusocket.lisp (26070B)
---
1 ;;;; See LICENSE for licensing information.
2
3 (in-package :usocket)
4
5 (defparameter *wildcard-host* #(0 0 0 0)
6 "Hostname to pass when all interfaces in the current system are to
7 be bound. If this variable is passed to socket-listen, IPv6 capable
8 systems will also listen for IPv6 connections.")
9
10 (defparameter *auto-port* 0
11 "Port number to pass when an auto-assigned port number is wanted.")
12
13 (defparameter *version* #.(asdf:component-version (asdf:find-system :usocket))
14 "usocket version string")
15
16 (defconstant +max-datagram-packet-size+ 65507
17 "The theoretical maximum amount of data in a UDP datagram.
18
19 The IPv4 UDP packets have a 16-bit length constraint, and IP+UDP header has 28-byte.
20
21 IP_MAXPACKET = 65535, /* netinet/ip.h */
22 sizeof(struct ip) = 20, /* netinet/ip.h */
23 sizeof(struct udphdr) = 8, /* netinet/udp.h */
24
25 65535 - 20 - 8 = 65507
26
27 (But for UDP broadcast, the maximum message size is limited by the MTU size of the underlying link)")
28
29 (defclass usocket ()
30 ((socket
31 :initarg :socket
32 :accessor socket
33 :documentation "Implementation specific socket object instance.'")
34 (wait-list
35 :initform nil
36 :accessor wait-list
37 :documentation "WAIT-LIST the object is associated with.")
38 (state
39 :initform nil
40 :accessor state
41 :documentation "Per-socket return value for the `wait-for-input' function.
42
43 The value stored in this slot can be any of
44 NIL - not ready
45 :READ - ready to read
46 :READ-WRITE - ready to read and write
47 :WRITE - ready to write
48
49 The last two remain unused in the current version.
50 ")
51 #+(and win32 (or sbcl ecl lispworks))
52 (%ready-p
53 :initform nil
54 :accessor %ready-p
55 :documentation "Indicates whether the socket has been signalled
56 as ready for reading a new connection.
57
58 The value will be set to T by `wait-for-input-internal' (given the
59 right conditions) and reset to NIL by `socket-accept'.
60
61 Don't modify this slot or depend on it as it is really intended
62 to be internal only.
63
64 Note: Accessed, but not used for 'stream-usocket'.
65 "
66 ))
67 (:documentation
68 "The main socket class.
69
70 Sockets should be closed using the `socket-close' method."))
71
72 (defgeneric socket-state (socket)
73 (:documentation "NIL - not ready
74 :READ - ready to read
75 :READ-WRITE - ready to read and write
76 :WRITE - ready to write"))
77
78 (defmethod socket-state ((socket usocket))
79 (state socket))
80
81 (defclass stream-usocket (usocket)
82 ((stream
83 :initarg :stream
84 :accessor socket-stream
85 :documentation "Stream instance associated with the socket."
86 ;;
87 ;;Iff an external-format was passed to `socket-connect' or `socket-listen'
88 ;;the stream is a flexi-stream. Otherwise the stream is implementation
89 ;;specific."
90 ))
91 (:documentation
92 "Stream socket class.
93 '
94 Contrary to other sockets, these sockets may be closed either
95 with the `socket-close' method or by closing the associated stream
96 (which can be retrieved with the `socket-stream' accessor)."))
97
98 (defclass stream-server-usocket (usocket)
99 ((element-type
100 :initarg :element-type
101 :initform #-lispworks 'character
102 #+lispworks 'base-char
103 :reader element-type
104 :documentation "Default element type for streams created by
105 `socket-accept'."))
106 (:documentation "Socket which listens for stream connections to
107 be initiated from remote sockets."))
108
109 (defclass datagram-usocket (usocket)
110 ((connected-p :type boolean
111 :accessor connected-p
112 :initarg :connected-p)
113 #+(or cmu scl lispworks mcl
114 (and clisp ffi (not rawsock)))
115 (%open-p :type boolean
116 :accessor %open-p
117 :initform t
118 :documentation "Flag to indicate if usocket is open,
119 for GC on implementions operate on raw socket fd.")
120 #+(or lispworks mcl
121 (and clisp ffi (not rawsock)))
122 (recv-buffer :documentation "Private RECV buffer.")
123 #+(or lispworks mcl)
124 (send-buffer :documentation "Private SEND buffer."))
125 (:documentation "UDP (inet-datagram) socket"))
126
127 (defun usocket-p (socket)
128 (typep socket 'usocket))
129
130 (defun stream-usocket-p (socket)
131 (typep socket 'stream-usocket))
132
133 (defun stream-server-usocket-p (socket)
134 (typep socket 'stream-server-usocket))
135
136 (defun datagram-usocket-p (socket)
137 (typep socket 'datagram-usocket))
138
139 (defun make-socket (&key socket)
140 "Create a usocket socket type from implementation specific socket."
141 (unless socket
142 (error 'invalid-socket-error))
143 (make-stream-socket :socket socket))
144
145 (defun make-stream-socket (&key socket stream)
146 "Create a usocket socket type from implementation specific socket
147 and stream objects.
148
149 Sockets returned should be closed using the `socket-close' method or
150 by closing the stream associated with the socket.
151 "
152 (unless socket
153 (error 'invalid-socket-error))
154 (unless stream
155 (error 'invalid-socket-stream-error))
156 (make-instance 'stream-usocket
157 :socket socket
158 :stream stream))
159
160 (defun make-stream-server-socket (socket &key (element-type
161 #-lispworks 'character
162 #+lispworks 'base-char))
163 "Create a usocket-server socket type from an
164 implementation-specific socket object.
165
166 The returned value is a subtype of `stream-server-usocket'.
167 "
168 (unless socket
169 (error 'invalid-socket-error))
170 (make-instance 'stream-server-usocket
171 :socket socket
172 :element-type element-type))
173
174 (defun make-datagram-socket (socket &key connected-p)
175 (unless socket
176 (error 'invalid-socket-error))
177 (make-instance 'datagram-usocket
178 :socket socket
179 :connected-p connected-p))
180
181 (defgeneric socket-accept (socket &key element-type)
182 (:documentation
183 "Accepts a connection from `socket', returning a `stream-socket'.
184
185 The stream associated with the socket returned has `element-type' when
186 explicitly specified, or the element-type passed to `socket-listen' otherwise."))
187
188 (defgeneric socket-close (usocket)
189 (:documentation "Close a previously opened `usocket'."))
190
191 ;; also see http://stackoverflow.com/questions/4160347/close-vs-shutdown-socket
192 (defgeneric socket-shutdown (usocket direction)
193 (:documentation "Shutdown communication on the socket in DIRECTION.
194
195 After a shutdown no input and/or output of the indicated DIRECTION
196 can be performed on the `usocket'.
197
198 DIRECTION should be either :INPUT or :OUTPUT or :IO"))
199
200 (defgeneric socket-send (usocket buffer length &key host port)
201 (:documentation "Send packets through a previously opend `usocket'."))
202
203 (defgeneric socket-receive (usocket buffer length &key)
204 (:documentation "Receive packets from a previously opend `usocket'.
205
206 Returns 4 values: (values buffer size host port)"))
207
208 (defgeneric get-local-address (socket)
209 (:documentation "Returns the IP address of the socket."))
210
211 (defgeneric get-peer-address (socket)
212 (:documentation
213 "Returns the IP address of the peer the socket is connected to."))
214
215 (defgeneric get-local-port (socket)
216 (:documentation "Returns the IP port of the socket.
217
218 This function applies to both `stream-usocket' and `server-stream-usocket'
219 type objects."))
220
221 (defgeneric get-peer-port (socket)
222 (:documentation "Returns the IP port of the peer the socket to."))
223
224 (defgeneric get-local-name (socket)
225 (:documentation "Returns the IP address and port of the socket as values.
226
227 This function applies to both `stream-usocket' and `server-stream-usocket'
228 type objects."))
229
230 (defgeneric get-peer-name (socket)
231 (:documentation
232 "Returns the IP address and port of the peer
233 the socket is connected to as values."))
234
235 (defmacro with-connected-socket ((var socket) &body body)
236 "Bind `socket' to `var', ensuring socket destruction on exit.
237
238 `body' is only evaluated when `var' is bound to a non-null value.
239
240 The `body' is an implied progn form."
241 `(let ((,var ,socket))
242 (unwind-protect
243 (when ,var
244 (with-mapped-conditions (,var)
245 ,@body))
246 (when ,var
247 (socket-close ,var)))))
248
249 (defmacro with-client-socket ((socket-var stream-var &rest socket-connect-args)
250 &body body)
251 "Bind the socket resulting from a call to `socket-connect' with
252 the arguments `socket-connect-args' to `socket-var' and if `stream-var' is
253 non-nil, bind the associated socket stream to it."
254 `(with-connected-socket (,socket-var (socket-connect ,@socket-connect-args))
255 ,(if (null stream-var)
256 `(progn ,@body)
257 `(let ((,stream-var (socket-stream ,socket-var)))
258 ,@body))))
259
260 (defmacro with-server-socket ((var server-socket) &body body)
261 "Bind `server-socket' to `var', ensuring socket destruction on exit.
262
263 `body' is only evaluated when `var' is bound to a non-null value.
264
265 The `body' is an implied progn form."
266 `(with-connected-socket (,var ,server-socket)
267 ,@body))
268
269 (defmacro with-socket-listener ((socket-var &rest socket-listen-args)
270 &body body)
271 "Bind the socket resulting from a call to `socket-listen' with arguments
272 `socket-listen-args' to `socket-var'."
273 `(with-server-socket (,socket-var (socket-listen ,@socket-listen-args))
274 ,@body))
275
276 (defstruct (wait-list (:constructor %make-wait-list))
277 %wait ;; implementation specific
278 waiters ;; the list of all usockets
279 map) ;; maps implementation sockets to usockets
280
281 ;; Implementation specific:
282 ;;
283 ;; %setup-wait-list
284 ;; %add-waiter
285 ;; %remove-waiter
286
287 (defun make-wait-list (waiters)
288 (let ((wl (%make-wait-list)))
289 (setf (wait-list-map wl) (make-hash-table))
290 (%setup-wait-list wl)
291 (dolist (x waiters wl)
292 (add-waiter wl x))))
293
294 (defun add-waiter (wait-list input)
295 (setf (gethash (socket input) (wait-list-map wait-list)) input
296 (wait-list input) wait-list)
297 (pushnew input (wait-list-waiters wait-list))
298 (%add-waiter wait-list input))
299
300 (defun remove-waiter (wait-list input)
301 (%remove-waiter wait-list input)
302 (setf (wait-list-waiters wait-list)
303 (remove input (wait-list-waiters wait-list))
304 (wait-list input) nil)
305 (remhash (socket input) (wait-list-map wait-list)))
306
307 (defun remove-all-waiters (wait-list)
308 (dolist (waiter (wait-list-waiters wait-list))
309 (%remove-waiter wait-list waiter))
310 (setf (wait-list-waiters wait-list) nil)
311 (clrhash (wait-list-map wait-list)))
312
313 (defun wait-for-input (socket-or-sockets &key timeout ready-only)
314 "Waits for one or more streams to become ready for reading from
315 the socket. When `timeout' (a non-negative real number) is
316 specified, wait `timeout' seconds, or wait indefinitely when
317 it isn't specified. A `timeout' value of 0 (zero) means polling.
318
319 Returns two values: the first value is the list of streams which
320 are readable (or in case of server streams acceptable). NIL may
321 be returned for this value either when waiting timed out or when
322 it was interrupted (EINTR). The second value is a real number
323 indicating the time remaining within the timeout period or NIL if
324 none.
325
326 Without the READY-ONLY arg, WAIT-FOR-INPUT will return all sockets in
327 the original list you passed it. This prevents a new list from being
328 consed up. Some users of USOCKET were reluctant to use it if it
329 wouldn't behave that way, expecting it to cost significant performance
330 to do the associated garbage collection.
331
332 Without the READY-ONLY arg, you need to check the socket STATE slot for
333 the values documented in usocket.lisp in the usocket class."
334
335 ;; for NULL sockets, return NIL with respect of TIMEOUT.
336 (when (null socket-or-sockets)
337 (when timeout
338 (sleep timeout))
339 (return-from wait-for-input nil))
340
341 (unless (wait-list-p socket-or-sockets)
342 (let ((wl (make-wait-list (if (listp socket-or-sockets)
343 socket-or-sockets (list socket-or-sockets)))))
344 (multiple-value-bind
345 (socks to)
346 (wait-for-input wl :timeout timeout :ready-only ready-only)
347 ;; NOTE: in case waiter is not created by the user, it should be removed here.
348 (remove-all-waiters wl)
349 (return-from wait-for-input
350 (values (if ready-only socks socket-or-sockets) to)))))
351 (let* ((start (get-internal-real-time))
352 (sockets-ready 0))
353 (dolist (x (wait-list-waiters socket-or-sockets))
354 (when (setf (state x)
355 #+(and win32 (or sbcl ecl)) nil ; they cannot rely on LISTEN
356 #-(and win32 (or sbcl ecl))
357 (if (and (stream-usocket-p x)
358 (listen (socket-stream x)))
359 :read
360 nil))
361 (incf sockets-ready)))
362 ;; the internal routine is responsibe for
363 ;; making sure the wait doesn't block on socket-streams of
364 ;; which theready- socket isn't ready, but there's space left in the
365 ;; buffer
366 (wait-for-input-internal socket-or-sockets
367 :timeout (if (zerop sockets-ready) timeout 0))
368 (let ((to-result (when timeout
369 (let ((elapsed (/ (- (get-internal-real-time) start)
370 internal-time-units-per-second)))
371 (when (< elapsed timeout)
372 (- timeout elapsed))))))
373 (values (if ready-only
374 (remove-if #'null (wait-list-waiters socket-or-sockets) :key #'state)
375 socket-or-sockets)
376 to-result))))
377
378 ;;
379 ;; Data utility functions
380 ;;
381
382 (defun integer-to-octet-buffer (integer buffer octets &key (start 0))
383 (do ((b start (1+ b))
384 (i (ash (1- octets) 3) ;; * 8
385 (- i 8)))
386 ((> 0 i) buffer)
387 (setf (aref buffer b)
388 (ldb (byte 8 i) integer))))
389
390 (defun octet-buffer-to-integer (buffer octets &key (start 0))
391 (let ((integer 0))
392 (do ((b start (1+ b))
393 (i (ash (1- octets) 3) ;; * 8
394 (- i 8)))
395 ((> 0 i)
396 integer)
397 (setf (ldb (byte 8 i) integer)
398 (aref buffer b)))))
399
400 (defmacro port-to-octet-buffer (port buffer &key (start 0))
401 `(integer-to-octet-buffer ,port ,buffer 2 :start ,start))
402
403 (defmacro ip-to-octet-buffer (ip buffer &key (start 0))
404 `(integer-to-octet-buffer (host-byte-order ,ip) ,buffer 4 :start ,start))
405
406 (defmacro port-from-octet-buffer (buffer &key (start 0))
407 `(octet-buffer-to-integer ,buffer 2 :start ,start))
408
409 (defmacro ip-from-octet-buffer (buffer &key (start 0))
410 `(octet-buffer-to-integer ,buffer 4 :start ,start))
411
412 ;;
413 ;; IPv4 utility functions
414 ;;
415
416 (defun list-of-strings-to-integers (list)
417 "Take a list of strings and return a new list of integers (from
418 parse-integer) on each of the string elements."
419 (let ((new-list nil))
420 (dolist (element (reverse list))
421 (push (parse-integer element) new-list))
422 new-list))
423
424 (defun ip-address-string-p (string)
425 "Return a true value if the given string could be an IP address."
426 (every (lambda (char)
427 (or (digit-char-p char)
428 (eql char #\.)))
429 string))
430
431 (defun hbo-to-dotted-quad (integer) ; exported
432 "Host-byte-order integer to dotted-quad string conversion utility."
433 (let ((first (ldb (byte 8 24) integer))
434 (second (ldb (byte 8 16) integer))
435 (third (ldb (byte 8 8) integer))
436 (fourth (ldb (byte 8 0) integer)))
437 (format nil "~A.~A.~A.~A" first second third fourth)))
438
439 (defun hbo-to-vector-quad (integer) ; exported
440 "Host-byte-order integer to dotted-quad string conversion utility."
441 (let ((first (ldb (byte 8 24) integer))
442 (second (ldb (byte 8 16) integer))
443 (third (ldb (byte 8 8) integer))
444 (fourth (ldb (byte 8 0) integer)))
445 (vector first second third fourth)))
446
447 (defun vector-quad-to-dotted-quad (vector) ; exported
448 (format nil "~A.~A.~A.~A"
449 (aref vector 0)
450 (aref vector 1)
451 (aref vector 2)
452 (aref vector 3)))
453
454 (defun dotted-quad-to-vector-quad (string) ; exported
455 (let ((list (list-of-strings-to-integers (split-sequence #\. string))))
456 (vector (first list) (second list) (third list) (fourth list))))
457
458 (defgeneric host-byte-order (address)) ; exported
459
460 (defmethod host-byte-order ((string string))
461 "Convert a string, such as 192.168.1.1, to host-byte-order,
462 such as 3232235777."
463 (let ((list (list-of-strings-to-integers (split-sequence #\. string))))
464 (+ (* (first list) 256 256 256) (* (second list) 256 256)
465 (* (third list) 256) (fourth list))))
466
467 (defmethod host-byte-order ((vector vector)) ; IPv4 only
468 "Convert a vector, such as #(192 168 1 1), to host-byte-order, such as
469 3232235777."
470 (+ (* (aref vector 0) 256 256 256) (* (aref vector 1) 256 256)
471 (* (aref vector 2) 256) (aref vector 3)))
472
473 (defmethod host-byte-order ((int integer))
474 int) ; this assume input integer is already host-byte-order
475
476 ;;
477 ;; IPv6 utility functions
478 ;;
479
480 (defun vector-to-ipv6-host (vector) ; exported
481 (with-output-to-string (*standard-output*)
482 (loop with zeros-collapsed-p
483 with collapsing-zeros-p
484 for i below 16 by 2
485 for word = (+ (ash (aref vector i) 8)
486 (aref vector (1+ i)))
487 do (cond
488 ((and (zerop word)
489 (not collapsing-zeros-p)
490 (not zeros-collapsed-p))
491 (setf collapsing-zeros-p t))
492 ((or (not (zerop word))
493 zeros-collapsed-p)
494 (when collapsing-zeros-p
495 (write-string ":")
496 (setf collapsing-zeros-p nil
497 zeros-collapsed-p t))
498 (format t "~:[~;:~]~X" (plusp i) word)))
499 finally (when collapsing-zeros-p
500 (write-string "::")))))
501
502 (defun split-ipv6-address (string)
503 (let ((pos 0)
504 word
505 double-colon-seen-p
506 words-before-double-colon
507 words-after-double-colon)
508 (loop
509 (multiple-value-setq (word pos) (parse-integer string :radix 16 :junk-allowed t :start pos))
510 (labels ((at-end-p ()
511 (= pos (length string)))
512 (looking-at-colon-p ()
513 (char= (char string pos) #\:))
514 (ensure-colon ()
515 (unless (looking-at-colon-p)
516 (error "unsyntactic IPv6 address string ~S, expected a colon at position ~D"
517 string pos))
518 (incf pos)))
519 (cond
520 ((null word)
521 (when double-colon-seen-p
522 (error "unsyntactic IPv6 address string ~S, can only have one double-colon filler mark"
523 string))
524 (setf double-colon-seen-p t))
525 (double-colon-seen-p
526 (push word words-after-double-colon))
527 (t
528 (push word words-before-double-colon)))
529 (if (at-end-p)
530 (return (list (nreverse words-before-double-colon) (nreverse words-after-double-colon)))
531 (ensure-colon))))))
532
533 (defun ipv6-host-to-vector (string) ; exported
534 (assert (> (length string) 2) ()
535 "Unsyntactic IPv6 address literal ~S, expected at least three characters" string)
536 (destructuring-bind (words-before-double-colon words-after-double-colon)
537 (split-ipv6-address (concatenate 'string
538 (when (eql (char string 0) #\:)
539 "0")
540 string
541 (when (eql (char string (1- (length string))) #\:)
542 "0")))
543 (let ((number-of-words-specified (+ (length words-before-double-colon) (length words-after-double-colon))))
544 (assert (<= number-of-words-specified 8) ()
545 "Unsyntactic IPv6 address literal ~S, too many colon separated address components" string)
546 (assert (or (= number-of-words-specified 8) words-after-double-colon) ()
547 "Unsyntactic IPv6 address literal ~S, too few address components and no double-colon filler found" string)
548 (loop with vector = (make-array 16 :element-type '(unsigned-byte 8))
549 for i below 16 by 2
550 for word in (append words-before-double-colon
551 (make-list (- 8 number-of-words-specified) :initial-element 0)
552 words-after-double-colon)
553 do (setf (aref vector i) (ldb (byte 8 8) word)
554 (aref vector (1+ i)) (ldb (byte 8 0) word))
555 finally (return vector)))))
556
557 (defun host-to-hostname (host) ; host -> string
558 "Translate a string, vector quad or 16 byte IPv6 address to a
559 stringified hostname."
560 (etypecase host
561 (string host) ; IPv4 or IPv6
562 ((or (vector t 4) ; IPv4
563 (array (unsigned-byte 8) (4)))
564 (vector-quad-to-dotted-quad host))
565 ((or (vector t 16) ; IPv6
566 (array (unsigned-byte 8) (16)))
567 (vector-to-ipv6-host host))
568 (integer (hbo-to-dotted-quad host)) ; integer input is IPv4 only
569 (null "0.0.0.0"))) ; null is IPv4
570
571 (defun ip= (ip1 ip2) ; exported
572 (etypecase ip1
573 (string (string= ip1 ; IPv4 or IPv6
574 (host-to-hostname ip2)))
575 ((or (vector t 4) ; IPv4
576 (array (unsigned-byte 8) (4)) ; IPv4
577 (vector t 16) ; IPv6
578 (array (unsigned-byte 8) (16))) ; IPv6
579 (equalp ip1 ip2))
580 (integer (= ip1 ; IPv4 only
581 (host-byte-order ip2))))) ; convert ip2 to integer (hbo)
582
583 (defun ip/= (ip1 ip2) ; exported
584 (not (ip= ip1 ip2)))
585
586 ;;
587 ;; DNS helper functions
588 ;;
589
590 (defun get-host-by-name (name)
591 "0.7.1+: if there're IPv4 addresses, return the first IPv4 address."
592 (let* ((hosts (get-hosts-by-name name))
593 (pos (position-if #'(lambda (ip) (= 4 (length ip))) hosts)))
594 (if pos (elt hosts pos)
595 (car hosts))))
596
597 (defun get-random-host-by-name (name)
598 "0.7.1+: if there're IPv4 addresses, only return a random IPv4 address."
599 (let* ((hosts (get-hosts-by-name name))
600 (ipv4-hosts (remove-if-not #'(lambda (ip) (= 4 (length ip))) hosts)))
601 (cond (ipv4-hosts
602 (elt ipv4-hosts (random (length ipv4-hosts))))
603 (hosts
604 (elt hosts (random (length hosts)))))))
605
606 (defun host-to-vector-quad (host) ; internal
607 "Translate a host specification (vector quad, dotted quad or domain name)
608 to a vector quad."
609 (etypecase host
610 (string (let* ((ip (when (ip-address-string-p host)
611 (dotted-quad-to-vector-quad host))))
612 (if (and ip (= 4 (length ip)))
613 ;; valid IP dotted quad? not sure
614 ip
615 (get-random-host-by-name host))))
616 ((or (vector t 4)
617 (array (unsigned-byte 8) (4)))
618 host)
619 (integer (hbo-to-vector-quad host))))
620
621 (defun host-to-hbo (host) ; internal
622 (etypecase host
623 (string (let ((ip (when (ip-address-string-p host)
624 (dotted-quad-to-vector-quad host))))
625 (if (and ip (= 4 (length ip)))
626 (host-byte-order ip)
627 (host-to-hbo (get-host-by-name host)))))
628 ((or (vector t 4)
629 (array (unsigned-byte 8) (4)))
630 (host-byte-order host))
631 (integer host)))
632
633 ;;
634 ;; Other utility functions
635 ;;
636
637 (defun split-timeout (timeout &optional (fractional 1000000))
638 "Split real value timeout into seconds and microseconds.
639 Optionally, a different fractional part can be specified."
640 (multiple-value-bind
641 (secs sec-frac)
642 (truncate timeout 1)
643 (values secs
644 (truncate (* fractional sec-frac) 1))))
645
646 ;;
647 ;; Setting of documentation for backend defined functions
648 ;;
649
650 ;; Documentation for the function
651 ;;
652 ;; (defun SOCKET-CONNECT (host port &key element-type nodelay some-other-keys...) ..)
653 ;;
654 (setf (documentation 'socket-connect 'function)
655 "Connect to `host' on `port'. `host' is assumed to be a string or
656 an IP address represented in vector notation, such as #(192 168 1 1).
657 `port' is assumed to be an integer.
658
659 `element-type' specifies the element type to use when constructing the
660 stream associated with the socket. The default is 'character.
661
662 `nodelay' Allows to disable/enable Nagle's algorithm (http://en.wikipedia.org/wiki/Nagle%27s_algorithm).
663 If this parameter is omitted, the behaviour is inherited from the
664 CL implementation (in most cases, Nagle's algorithm is
665 enabled by default, but for example in ACL it is disabled).
666 If the parameter is specified, one of these three values is possible:
667 T - Disable Nagle's algorithm; signals an UNSUPPORTED
668 condition if the implementation does not support explicit
669 manipulation with that option.
670 NIL - Leave Nagle's algorithm enabled on the socket;
671 signals an UNSUPPORTED condition if the implementation does
672 not support explicit manipulation with that option.
673 :IF-SUPPORTED - Disables Nagle's algorithm if the implementation
674 allows this, otherwises just ignore this option.
675
676 Returns a usocket object.")
677
678 ;; Documentation for the function
679 ;;
680 ;; (defun SOCKET-LISTEN (host port &key reuseaddress backlog element-type) ..)
681 ;;###FIXME: extend with default-element-type
682 (setf (documentation 'socket-listen 'function)
683 "Bind to interface `host' on `port'. `host' should be the
684 representation of an ready-interface address. The implementation is
685 not required to do an address lookup, making no guarantees that
686 hostnames will be correctly resolved. If `*wildcard-host*' or NIL is
687 passed for `host', the socket will be bound to all available
688 interfaces for the system. `port' can be selected by the IP stack by
689 passing `*auto-port*'.
690
691 Returns an object of type `stream-server-usocket'.
692
693 `reuse-address' and `backlog' are advisory parameters for setting socket
694 options at creation time. `element-type' is the element type of the
695 streams to be created by `socket-accept'. `reuseaddress' is supported for
696 backward compatibility (but deprecated); when both `reuseaddress' and
697 `reuse-address' have been specified, the latter takes precedence.
698 ")
699
700 ;;; Small utility functions mapping true/false to 1/0, moved here from option.lisp
701
702 (proclaim '(inline bool->int int->bool))
703
704 (defun bool->int (bool) (if bool 1 0))
705 (defun int->bool (int) (= 1 int))