--- a
+++ b/contrib/sb-bsd-sockets/sockopt.lisp
@@ -0,0 +1,189 @@
+(in-package :sb-bsd-sockets)
+
+#||
+<H2> Socket Options </h2>
+<a name="sockopt"> </a>
+<p> A subset of socket options are supported, using a fairly
+general framework which should make it simple to add more as required 
+- see sockopt.lisp for details.  The name mapping from C is fairly
+straightforward: <tt>SO_RCVLOWAT</tt> becomes
+<tt>sockopt-receive-low-water</tt> and <tt>(setf
+sockopt-receive-low-water)</tt>.
+||#
+
+#|
+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 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 (getprotobyname "ip")
+      sockint::IP_RECVIF  ...  ))
+
+
+|#
+
+(defmacro define-socket-option
+  (lisp-name level number mangle-arg size mangle-return)
+  (let ((find-level
+	 (if (numberp (eval level))
+	     level
+	     `(get-protocol-by-name ,(string-downcase (symbol-name level))))))
+    `(progn
+      (export ',lisp-name)
+      (defun ,lisp-name (socket &aux (fd (socket-file-descriptor socket)))
+	(sb-sys:without-gcing
+	 (let ((buf (make-array sockint::size-of-int
+				:element-type '(unsigned-byte 8)
+				:initial-element 0)))
+	   (if (= -1 (sockint::getsockopt
+		      fd ,find-level ,number (sockint::array-data-address buf) ,size))
+	       (socket-error "getsockopt")
+	       (,mangle-return buf ,size)))))
+      (defun (setf ,lisp-name) (new-val socket
+				&aux (fd (socket-file-descriptor socket)))
+	(if (= -1
+	       (sb-sys:without-gcing
+		(sockint::setsockopt
+		 fd ,find-level ,number (funcall (function ,mangle-arg) new-val ,size)
+		 ,size)))
+	    (socket-error "setsockopt"))))))
+
+;;; sockopts that have integer arguments
+
+(defun int-to-foreign (x size)
+  ;; can't use with-alien, as the variables it creates only have
+  ;; dynamic scope.  can't use the passed-in size because sap-alien
+  ;; is a macro and evaluates its second arg at read time
+  (let* ((v (make-array size :element-type '(unsigned-byte 8)
+			:initial-element 0))
+	 (d (sockint::array-data-address v))
+	 (alien (sb-alien:sap-alien
+		 d; (sb-sys:int-sap d)
+		 (* (sb-alien:signed #.(* 8 sockint::size-of-int))))))
+    (setf (sb-alien:deref alien 0) x)
+    alien))
+
+(defun buffer-to-int (x size)
+  (declare (ignore size))
+  (let ((alien (sb-alien:sap-alien
+		(sockint::array-data-address x)
+		(* (sb-alien:signed #.(* 8 sockint::size-of-int))))))
+    (sb-alien:deref alien)))
+
+(defmacro define-socket-option-int (name level number)
+  `(define-socket-option ,name ,level ,number
+     int-to-foreign sockint::size-of-int buffer-to-int))
+
+(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)
+
+;;; boolean options are integers really
+
+(defun bool-to-foreign (x size)
+  (int-to-foreign (if x 1 0) size))
+
+(defun buffer-to-bool (x size)
+  (not (= (buffer-to-int x size) 0)))
+
+(defmacro define-socket-option-bool (name level number)
+  `(define-socket-option ,name ,level ,number
+     bool-to-foreign sockint::size-of-int buffer-to-bool))
+
+(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)
+(define-socket-option-bool
+  sockopt-pass-credentials sockint::sol-socket sockint::so-passcred)
+(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 string-to-foreign (string size)
+  (declare (ignore size))
+  (let ((data (sockint::array-data-address string)))
+    (sb-alien:sap-alien data (* t))))
+                                                         
+(defun buffer-to-string (x size)
+  (declare (ignore size))
+  (sb-c-call::%naturalize-c-string
+   (sockint::array-data-address x)))
+
+(define-socket-option sockopt-bind-to-device sockint::sol-socket
+  sockint::so-bindtodevice string-to-foreign sockint::ifnamsiz
+  buffer-to-string)
+
+;;; 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
+|#
+