contrib/sb-bsd-sockets/sockopt.lisp

   1 (in-package :sb-bsd-sockets)
   2
   3 #||
   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>.
  12 ||#
  13
  14 #|
  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
  18
  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
  22
  23 (define-socket-option lisp-name level number mangle-arg size mangle-return)
  24
  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
  27 data resp.
  28
  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.
  34
  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
  37 to write into.
  38
  39 mangle-return is called with an alien buffer and should turn it into
  40 something that the caller will want.
  41
  42 Code for options that not every system has should be conditionalised:
  43
  44 (if (boundp 'sockint::IP_RECVIF)
  45     (define-socket-option so-receive-interface (getprotobyname "ip")
  46       sockint::IP_RECVIF  ...  ))
  47
  48
  49 |#
  50
  51 (defmacro define-socket-option
  52   (lisp-name level number mangle-arg size mangle-return)
  53   (let ((find-level
  54          (if (numberp (eval level))
  55              level
  56              `(get-protocol-by-name ,(string-downcase (symbol-name level))))))
  57     `(progn
  58       (export ',lisp-name)
  59       (defun ,lisp-name (socket &aux (fd (socket-file-descriptor socket)))
  60         (let ((buf (make-array sockint::size-of-int
  61                                :element-type '(unsigned-byte 8)
  62                                :initial-element 0)))
  63           (sb-sys:with-pinned-objects (buf)
  64             (if (= -1 (sockint::getsockopt
  65                        fd ,find-level ,number (sb-grovel::array-data-address buf) ,size))
  66                 (socket-error "getsockopt")
  67                 (,mangle-return buf ,size)))))
  68       (defun (setf ,lisp-name) (new-val socket
  69                                 &aux (fd (socket-file-descriptor socket)))
  70         (if (= -1
  71                (sb-sys:without-gcing
  72                 (sockint::setsockopt
  73                  fd ,find-level ,number (funcall (function ,mangle-arg) new-val ,size)
  74                  ,size)))
  75             (socket-error "setsockopt"))))))
  76
  77 ;;; sockopts that have integer arguments
  78
  79 (defun int-to-foreign (x size)
  80   ;; can't use with-alien, as the variables it creates only have
  81   ;; dynamic scope.  can't use the passed-in size because sap-alien
  82   ;; is a macro and evaluates its second arg at read time
  83   (let* ((v (make-array size :element-type '(unsigned-byte 8)
  84                         :initial-element 0))
  85          (d (sb-grovel::array-data-address v))
  86          (alien (sb-alien:sap-alien
  87                  d; (sb-sys:int-sap d)
  88                  (* (sb-alien:signed #.(* 8 sockint::size-of-int))))))
  89     (setf (sb-alien:deref alien 0) x)
  90     alien))
  91
  92 (defun buffer-to-int (x size)
  93   (declare (ignore size))
  94   (let ((alien (sb-alien:sap-alien
  95                 (sb-grovel::array-data-address x)
  96                 (* (sb-alien:signed #.(* 8 sockint::size-of-int))))))
  97     (sb-alien:deref alien)))
  98
  99 (defmacro define-socket-option-int (name level number)
 100   `(define-socket-option ,name ,level ,number
 101      int-to-foreign sockint::size-of-int buffer-to-int))
 102
 103 (define-socket-option-int
 104   sockopt-receive-low-water sockint::sol-socket sockint::so-rcvlowat)
 105 (define-socket-option-int
 106   sockopt-send-low-water sockint::sol-socket sockint::so-sndlowat)
 107 (define-socket-option-int
 108   sockopt-type sockint::sol-socket sockint::so-type)
 109 (define-socket-option-int
 110   sockopt-send-buffer sockint::sol-socket sockint::so-sndbuf)
 111 (define-socket-option-int
 112   sockopt-receive-buffer sockint::sol-socket sockint::so-rcvbuf)
 113 (define-socket-option-int
 114   sockopt-priority sockint::sol-socket sockint::so-priority)
 115
 116 ;;; boolean options are integers really
 117
 118 (defun bool-to-foreign (x size)
 119   (int-to-foreign (if x 1 0) size))
 120
 121 (defun buffer-to-bool (x size)
 122   (not (= (buffer-to-int x size) 0)))
 123
 124 (defmacro define-socket-option-bool (name level number)
 125   `(define-socket-option ,name ,level ,number
 126      bool-to-foreign sockint::size-of-int buffer-to-bool))
 127
 128 (define-socket-option-bool
 129   sockopt-reuse-address sockint::sol-socket sockint::so-reuseaddr)
 130 (define-socket-option-bool
 131   sockopt-keep-alive sockint::sol-socket sockint::so-keepalive)
 132 (define-socket-option-bool
 133   sockopt-oob-inline sockint::sol-socket sockint::so-oobinline)
 134 (define-socket-option-bool
 135   sockopt-bsd-compatible sockint::sol-socket sockint::so-bsdcompat)
 136 (define-socket-option-bool
 137   sockopt-pass-credentials sockint::sol-socket sockint::so-passcred)
 138 (define-socket-option-bool
 139   sockopt-debug sockint::sol-socket sockint::so-debug)
 140 (define-socket-option-bool
 141   sockopt-dont-route sockint::sol-socket sockint::so-dontroute)
 142 (define-socket-option-bool
 143   sockopt-broadcast sockint::sol-socket sockint::so-broadcast)
 144
 145 (define-socket-option-bool sockopt-tcp-nodelay :tcp sockint::tcp-nodelay)
 146
 147 (defun string-to-foreign (string size)
 148   (declare (ignore size))
 149   (let ((data (sb-grovel::array-data-address string)))
 150     (sb-alien:sap-alien data (* t))))
 151
 152 (defun buffer-to-string (x size)
 153   (declare (ignore size))
 154   (sb-c-call::%naturalize-c-string
 155    (sb-grovel::array-data-address x)))
 156
 157 (define-socket-option sockopt-bind-to-device sockint::sol-socket
 158   sockint::so-bindtodevice string-to-foreign sockint::ifnamsiz
 159   buffer-to-string)
 160
 161 ;;; other kinds of socket option
 162
 163 ;;; so_peercred takes a ucre structure
 164 ;;; so_linger struct linger {
 165 ;                  int   l_onoff;    /* linger active */
 166 ;                  int   l_linger;   /* how many seconds to linger for */
 167 ;              };
 168
 169 #|
 170
 171 (sockopt-reuse-address 2)
 172
 173 (defun echo-server ()
 174   (let ((s (make-inet-socket :stream (get-protocol-by-name "tcp"))))
 175     (setf (sockopt-reuse-address s) t)
 176     (setf (sockopt-bind-to-device s) "lo")
 177     (socket-bind s (make-inet-address "127.0.0.1") 3459)
 178     (socket-listen s 5)
 179     (dotimes (i 10)
 180       (let* ((s1 (socket-accept s))
 181              (stream (socket-make-stream s1 :input t :output t :buffering :none)))
 182         (let ((line (read-line stream)))
 183           (format t "got one ~A ~%" line)
 184           (format stream "~A~%" line))
 185         (close stream)))))
 186
 187 NIL
 188 |#
 189