X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Fsockopt.lisp;h=7fa1ff7417b60bd3922671575345781cc8eecc04;hb=78fa16bf55be44cc16845be84d98023e83fb14bc;hp=33ecabdd0b6e78afc8e328f3aeb68da2f25770eb;hpb=8a3c76ab9725a199aa06a0abc018e096271a0f75;p=sbcl.git diff --git a/contrib/sb-bsd-sockets/sockopt.lisp b/contrib/sb-bsd-sockets/sockopt.lisp index 33ecabd..7fa1ff7 100644 --- a/contrib/sb-bsd-sockets/sockopt.lisp +++ b/contrib/sb-bsd-sockets/sockopt.lisp @@ -37,45 +37,56 @@ Code for options that not every system has should be conditionalised: (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)))))) + `(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) @@ -87,8 +98,9 @@ Code for options that not every system has should be conditionalised: 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 @@ -100,11 +112,14 @@ Code for options that not every system has should be conditionalised: (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 "~@" + (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) @@ -112,10 +127,12 @@ Code for options that not every system has should be conditionalised: 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 @@ -129,8 +146,9 @@ Code for options that not every system has should be conditionalised: (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