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, 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
(defmacro define-socket-option
(lisp-name documentation
- level number buffer-type mangle-arg mangle-return mangle-setf-buffer)
+ 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))))))
+ (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 &aux (fd (socket-file-descriptor socket)))
- ,@(when documentation (list documentation))
- (sb-alien:with-alien ((size sb-alien:integer)
- (buffer ,buffer-type))
- (setf size (sb-alien:alien-size ,buffer-type :bytes))
- (if (= -1 (sockint::getsockopt fd ,find-level ,number
- (sb-alien:addr buffer)
- (sb-alien:addr size)))
- (socket-error "getsockopt")
- (,mangle-return buffer size))))
- (defun (setf ,lisp-name) (new-val socket
- &aux (fd (socket-file-descriptor socket)))
- (sb-alien:with-alien ((buffer ,buffer-type))
- (setf buffer ,(if mangle-arg
- `(,mangle-arg new-val)
- `new-val))
- (when (= -1 (sockint::setsockopt fd ,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")))))))
+ (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:integer :bytes)))
+ (assert (= size (sb-alien:alien-size sb-alien:int :bytes)))
buffer)
-(defmacro define-socket-option-int (name level number)
+(defmacro define-socket-option-int (name level number &optional features (info ""))
`(define-socket-option ,name nil ,level ,number
- sb-alien:integer nil foreign-int-to-integer sb-alien:addr))
+ 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)
sockopt-send-buffer sockint::sol-socket sockint::so-sndbuf)
(define-socket-option-int
sockopt-receive-buffer sockint::sol-socket sockint::so-rcvbuf)
-#+linux(define-socket-option-int
- sockopt-priority sockint::sol-socket sockint::so-priority)
+(define-socket-option-int
+ sockopt-priority sockint::sol-socket sockint::so-priority :linux
+ "Available only on Linux.")
;;; boolean options are integers really
(defun bool-to-foreign-int (val)
(if val 1 0))
-(defmacro define-socket-option-bool (name level c-name)
+(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))
+ ,(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:integer bool-to-foreign-int foreign-int-to-bool sb-alien:addr))
+ 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)
sockopt-keep-alive sockint::sol-socket sockint::so-keepalive)
(define-socket-option-bool
sockopt-oob-inline sockint::sol-socket sockint::so-oobinline)
-#+linux(define-socket-option-bool
- sockopt-bsd-compatible sockint::sol-socket sockint::so-bsdcompat)
-#+linux(define-socket-option-bool
- sockopt-pass-credentials sockint::sol-socket sockint::so-passcred)
+(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
(declare (ignore args))
x)
-#+linux(define-socket-option sockopt-bind-to-device nil sockint::sol-socket
- sockint::so-bindtodevice sb-alien:c-string identity identity-1 identity)
+(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