1 (in-package :sb-bsd-sockets)
4 <H2> Socket Options </h2>
5 <a name="sockopt"> </a>
6 <p> A subset of socket options are supported, using a fairly
7 general framework which should make it simple to add more as required
8 - see sockopt.lisp for details. The name mapping from C is fairly
9 straightforward: <tt>SO_RCVLOWAT</tt> becomes
10 <tt>sockopt-receive-low-water</tt> and <tt>(setf
11 sockopt-receive-low-water)</tt>.
15 getsockopt(socket, level, int optname, void *optval, socklen_t *optlen)
16 setsockopt(socket, level, int optname, void *optval, socklen_t optlen)
17 ^ SOL_SOCKET or a protocol number
19 In terms of providing a useful interface, we have to face up to the
20 fact that most of these take different data types - some are integers,
21 some are booleans, some are foreign struct instances, etc etc
23 (define-socket-option lisp-name level number mangle-arg size mangle-return)
25 macro-expands to two functions that define lisp-name and (setf ,lisp-name)
26 and calls the functions mangle-arg and mangle-return on outgoing and incoming
29 Parameters passed to the function thus defined (lisp-name)
30 are all passed directly into mangle-arg. mangle-arg should return an
31 alien pointer - this is passed unscathed to the foreign routine, so
32 wants to have type (* t). Note that even for options that have
33 integer arguments, this is still a pointer to said integer.
35 size is the size of the buffer that the return of mangle-arg points
36 to, and also of the buffer that we should allocate for getsockopt
39 mangle-return is called with an alien buffer and should turn it into
40 something that the caller will want.
42 Code for options that not every system has should be conditionalised:
44 (if (boundp 'sockint::IP_RECVIF)
45 (define-socket-option so-receive-interface (getprotobyname "ip")
46 sockint::IP_RECVIF ... ))
51 (defmacro define-socket-option
52 (lisp-name level number buffer-type mangle-arg mangle-return mangle-setf-buffer)
54 (if (numberp (eval level))
56 `(get-protocol-by-name ,(string-downcase (symbol-name level))))))
59 (defun ,lisp-name (socket &aux (fd (socket-file-descriptor socket)))
60 (sb-alien:with-alien ((size sb-alien:integer)
61 (buffer ,buffer-type))
62 (setf size (sb-alien:alien-size ,buffer-type :bytes))
63 (if (= -1 (sockint::getsockopt fd ,find-level ,number
64 (sb-alien:addr buffer)
65 (sb-alien:addr size)))
66 (socket-error "getsockopt")
67 (,mangle-return buffer size))))
68 (defun (setf ,lisp-name) (new-val socket
69 &aux (fd (socket-file-descriptor socket)))
70 (sb-alien:with-alien ((buffer ,buffer-type))
71 (setf buffer ,(if mangle-arg
72 `(,mangle-arg new-val)
74 (when (= -1 (sockint::setsockopt fd ,find-level ,number
75 (,mangle-setf-buffer buffer)
76 ,(if (eql buffer-type 'sb-alien:c-string)
78 `(sb-alien:alien-size ,buffer-type :bytes))))
79 (socket-error "setsockopt")))))))
81 ;;; sockopts that have integer arguments
83 (defun foreign-int-to-integer (buffer size)
84 (assert (= size (sb-alien:alien-size sb-alien:integer :bytes)))
87 (defmacro define-socket-option-int (name level number)
88 `(define-socket-option ,name ,level ,number
89 sb-alien:integer nil foreign-int-to-integer sb-alien:addr))
91 (define-socket-option-int
92 sockopt-receive-low-water sockint::sol-socket sockint::so-rcvlowat)
93 (define-socket-option-int
94 sockopt-send-low-water sockint::sol-socket sockint::so-sndlowat)
95 (define-socket-option-int
96 sockopt-type sockint::sol-socket sockint::so-type)
97 (define-socket-option-int
98 sockopt-send-buffer sockint::sol-socket sockint::so-sndbuf)
99 (define-socket-option-int
100 sockopt-receive-buffer sockint::sol-socket sockint::so-rcvbuf)
101 #+linux(define-socket-option-int
102 sockopt-priority sockint::sol-socket sockint::so-priority)
104 ;;; boolean options are integers really
106 (defun foreign-int-to-bool (x size)
107 (if (zerop (foreign-int-to-integer x size))
111 (defun bool-to-foreign-int (val)
114 (defmacro define-socket-option-bool (name level number)
115 `(define-socket-option ,name ,level ,number
116 sb-alien:integer bool-to-foreign-int foreign-int-to-bool sb-alien:addr))
118 (define-socket-option-bool
119 sockopt-reuse-address sockint::sol-socket sockint::so-reuseaddr)
120 (define-socket-option-bool
121 sockopt-keep-alive sockint::sol-socket sockint::so-keepalive)
122 (define-socket-option-bool
123 sockopt-oob-inline sockint::sol-socket sockint::so-oobinline)
124 #+linux(define-socket-option-bool
125 sockopt-bsd-compatible sockint::sol-socket sockint::so-bsdcompat)
126 #+linux(define-socket-option-bool
127 sockopt-pass-credentials sockint::sol-socket sockint::so-passcred)
128 (define-socket-option-bool
129 sockopt-debug sockint::sol-socket sockint::so-debug)
130 (define-socket-option-bool
131 sockopt-dont-route sockint::sol-socket sockint::so-dontroute)
132 (define-socket-option-bool
133 sockopt-broadcast sockint::sol-socket sockint::so-broadcast)
135 (define-socket-option-bool sockopt-tcp-nodelay :tcp sockint::tcp-nodelay)
137 (defun identity-1 (x &rest args)
138 (declare (ignore args))
141 #+linux(define-socket-option sockopt-bind-to-device sockint::sol-socket
142 sockint::so-bindtodevice sb-alien:c-string identity identity-1 identity)
144 ;;; other kinds of socket option
146 ;;; so_peercred takes a ucre structure
147 ;;; so_linger struct linger {
148 ; int l_onoff; /* linger active */
149 ; int l_linger; /* how many seconds to linger for */
154 (sockopt-reuse-address 2)
156 (defun echo-server ()
157 (let ((s (make-inet-socket :stream (get-protocol-by-name "tcp"))))
158 (setf (sockopt-reuse-address s) t)
159 (setf (sockopt-bind-to-device s) "lo")
160 (socket-bind s (make-inet-address "127.0.0.1") 3459)
163 (let* ((s1 (socket-accept s))
164 (stream (socket-make-stream s1 :input t :output t :buffering :none)))
165 (let ((line (read-line stream)))
166 (format t "got one ~A ~%" line)
167 (format stream "~A~%" line))