[4898ef]: contrib / sb-bsd-sockets / sockopt.lisp Maximize Restore History

Download this file

sockopt.lisp    182 lines (152 with data), 7.3 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
(in-package :sb-bsd-sockets)
#|
getsockopt(socket, level, int optname, void *optval, socklen_t *optlen)
setsockopt(socket, level, int optname, void *optval, socklen_t optlen)
^ SOL_SOCKET or a protocol number
In terms of providing a useful interface, we have to face up to the
fact that most of these take different data types - some are integers,
some are booleans, some are foreign struct instances, etc etc
(define-socket-option lisp-name doc level number mangle-arg size mangle-return)
macro-expands to two functions that define lisp-name and (setf ,lisp-name)
and calls the functions mangle-arg and mangle-return on outgoing and incoming
data resp.
Parameters passed to the function thus defined (lisp-name)
are all passed directly into mangle-arg. mangle-arg should return an
alien pointer - this is passed unscathed to the foreign routine, so
wants to have type (* t). Note that even for options that have
integer arguments, this is still a pointer to said integer.
size is the size of the buffer that the return of mangle-arg points
to, and also of the buffer that we should allocate for getsockopt
to write into.
mangle-return is called with an alien buffer and should turn it into
something that the caller will want.
Code for options that not every system has should be conditionalised:
(if (boundp 'sockint::IP_RECVIF)
(define-socket-option so-receive-interface nil (getprotobyname "ip")
sockint::IP_RECVIF ... ))
|#
(defmacro define-socket-option
(lisp-name documentation
level number buffer-type mangle-arg mangle-return mangle-setf-buffer
&optional features info)
(let ((find-level
(if (numberp (eval level))
level
`(get-protocol-by-name ,(string-downcase (symbol-name level)))))
(supportedp (or (null features) (featurep features))))
`(progn
(export ',lisp-name)
(defun ,lisp-name (socket)
,@(when documentation (list (concatenate 'string documentation " " info)))
,(if supportedp
`(sb-alien:with-alien ((size sb-alien:int)
(buffer ,buffer-type))
(setf size (sb-alien:alien-size ,buffer-type :bytes))
(if (= -1 (sockint::getsockopt (socket-file-descriptor socket)
,find-level ,number
(sb-alien:addr buffer)
(sb-alien:addr size)))
(socket-error "getsockopt")
(,mangle-return buffer size)))
`(error 'unsupported-operator
:format-control "Socket option ~S is not supported in this platform."
:format-arguments (list ',lisp-name))))
(defun (setf ,lisp-name) (new-val socket)
,(if supportedp
`(sb-alien:with-alien ((buffer ,buffer-type))
(setf buffer ,(if mangle-arg
`(,mangle-arg new-val)
`new-val))
(when (= -1 (sockint::setsockopt (socket-file-descriptor socket)
,find-level ,number
(,mangle-setf-buffer buffer)
,(if (eql buffer-type 'sb-alien:c-string)
`(length new-val)
`(sb-alien:alien-size ,buffer-type :bytes))))
(socket-error "setsockopt")))
`(error 'unsupported-operator
:format-control "Socket option ~S is not supported on this platform."
:format-arguments (list ',lisp-name)))))))
;;; sockopts that have integer arguments
(defun foreign-int-to-integer (buffer size)
(assert (= size (sb-alien:alien-size sb-alien:int :bytes)))
buffer)
(defmacro define-socket-option-int (name level number &optional features (info ""))
`(define-socket-option ,name nil ,level ,number
sb-alien:int nil foreign-int-to-integer sb-alien:addr ,features ,info))
(define-socket-option-int
sockopt-receive-low-water sockint::sol-socket sockint::so-rcvlowat)
(define-socket-option-int
sockopt-send-low-water sockint::sol-socket sockint::so-sndlowat)
(define-socket-option-int
sockopt-type sockint::sol-socket sockint::so-type)
(define-socket-option-int
sockopt-send-buffer sockint::sol-socket sockint::so-sndbuf)
(define-socket-option-int
sockopt-receive-buffer sockint::sol-socket sockint::so-rcvbuf)
(define-socket-option-int
sockopt-priority sockint::sol-socket sockint::so-priority :linux
"Available only on Linux.")
;;; boolean options are integers really
(defun foreign-int-to-bool (x size)
(if (zerop (foreign-int-to-integer x size))
nil
t))
(defun bool-to-foreign-int (val)
(if val 1 0))
(defmacro define-socket-option-bool (name level c-name &optional features (info ""))
`(define-socket-option ,name
,(format nil "~@<Return the value of the ~A socket option for SOCKET. ~
This can also be updated with SETF.~:@>"
(symbol-name c-name))
,level ,c-name
sb-alien:int bool-to-foreign-int foreign-int-to-bool sb-alien:addr
,features ,info))
(define-socket-option-bool
sockopt-reuse-address sockint::sol-socket sockint::so-reuseaddr)
(define-socket-option-bool
sockopt-keep-alive sockint::sol-socket sockint::so-keepalive)
(define-socket-option-bool
sockopt-oob-inline sockint::sol-socket sockint::so-oobinline)
(define-socket-option-bool
sockopt-bsd-compatible sockint::sol-socket sockint::so-bsdcompat :linux
"Available only on Linux.")
(define-socket-option-bool
sockopt-pass-credentials sockint::sol-socket sockint::so-passcred :linux
"Available only on Linux.")
(define-socket-option-bool
sockopt-debug sockint::sol-socket sockint::so-debug)
(define-socket-option-bool
sockopt-dont-route sockint::sol-socket sockint::so-dontroute)
(define-socket-option-bool
sockopt-broadcast sockint::sol-socket sockint::so-broadcast)
(define-socket-option-bool sockopt-tcp-nodelay :tcp sockint::tcp-nodelay)
(defun identity-1 (x &rest args)
(declare (ignore args))
x)
(define-socket-option sockopt-bind-to-device nil sockint::sol-socket
sockint::so-bindtodevice sb-alien:c-string identity identity-1 identity
:linux "Available only on Linux")
;;; other kinds of socket option
;;; so_peercred takes a ucre structure
;;; so_linger struct linger {
; int l_onoff; /* linger active */
; int l_linger; /* how many seconds to linger for */
; };
#|
(sockopt-reuse-address 2)
(defun echo-server ()
(let ((s (make-inet-socket :stream (get-protocol-by-name "tcp"))))
(setf (sockopt-reuse-address s) t)
(setf (sockopt-bind-to-device s) "lo")
(socket-bind s (make-inet-address "127.0.0.1") 3459)
(socket-listen s 5)
(dotimes (i 10)
(let* ((s1 (socket-accept s))
(stream (socket-make-stream s1 :input t :output t :buffering :none)))
(let ((line (read-line stream)))
(format t "got one ~A ~%" line)
(format stream "~A~%" line))
(close stream)))))
NIL
|#