sockets/socket-options.lisp

   1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
   2
   3 ;;   Copyright (C) 2006, 2007 Stelian Ionescu
   4 ;;
   5 ;;   This code is free software; you can redistribute it and/or
   6 ;;   modify it under the terms of the version 2.1 of
   7 ;;   the GNU Lesser General Public License as published by
   8 ;;   the Free Software Foundation, as clarified by the
   9 ;;   preamble found here:
  10 ;;       http://opensource.franz.com/preamble.html
  11 ;;
  12 ;;   This program is distributed in the hope that it will be useful,
  13 ;;   but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;   GNU General Public License for more details.
  16 ;;
  17 ;;   You should have received a copy of the GNU Lesser General
  18 ;;   Public License along with this library; if not, write to the
  19 ;;   Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  20 ;;   Boston, MA 02110-1301, USA
  21
  22 (in-package :net.sockets)
  23
  24 ;; TODO: manage socket options errors
  25 (defun sockopt-error (retval level option action &optional val1 val2)
  26   (declare (ignore retval level option action val1 val2))
  27   (error "Sockopt error !"))
  28
  29 ;;
  30 ;; Set option helpers
  31 ;;
  32
  33 (defun set-socket-option-bool (fd level option value)
  34   (with-foreign-object (optval :int)
  35     (setf (mem-ref optval :int) (lisp->c-bool value))
  36     (et:setsockopt fd level option optval et:size-of-int)
  37     (values)))
  38
  39 (defun set-socket-option-int (fd level option value)
  40   (with-foreign-object (optval :int)
  41     (setf (mem-ref optval :int) value)
  42     (et:setsockopt fd level option optval et:size-of-int)
  43     (values)))
  44
  45 (defun set-socket-option-linger (fd level option onoff linger)
  46   (with-foreign-object (optval 'et:linger)
  47     (with-foreign-slots ((et:linger et:onoff) optval et:linger)
  48       (setf et:onoff (lisp->c-bool onoff)
  49             et:linger linger))
  50     (et:setsockopt fd level option optval et:size-of-linger)
  51     (values)))
  52
  53 (defun set-socket-option-timeval (fd level option sec usec)
  54   (with-foreign-object (optval 'et:timeval)
  55     (with-foreign-slots ((et:sec et:usec) optval et:timeval)
  56       (setf et:sec sec
  57             et:usec usec))
  58     (et:setsockopt fd level option optval et:size-of-timeval)
  59     (values)))
  60
  61 ;;
  62 ;; Get option helpers
  63 ;;
  64
  65 (defun get-socket-option-bool (fd level option)
  66   (with-foreign-objects ((optval :int)
  67                          (optlen 'et:socklen))
  68     (setf (mem-ref optlen 'et:socklen) et:size-of-int)
  69     (et:getsockopt fd level option optval optlen)
  70     (values (c->lisp-bool (mem-ref optval :int)))))
  71
  72 (defun get-socket-option-int (fd level option)
  73   (with-foreign-objects ((optval :int)
  74                          (optlen 'et:socklen))
  75     (setf (mem-ref optlen 'et:socklen) et:size-of-int)
  76     (et:getsockopt fd level option optval optlen)
  77     (values (mem-ref optval :int))))
  78
  79 (defun get-socket-option-linger (fd level option)
  80   (with-foreign-objects ((optval 'et:linger)
  81                          (optlen 'et:socklen))
  82     (setf (mem-ref optlen 'et:socklen) et:size-of-linger)
  83     (et:getsockopt fd level option optval optlen)
  84     (with-foreign-slots ((et:linger et:onoff) optval et:linger)
  85       (values (c->lisp-bool et:onoff) et:linger))))
  86
  87 (defun get-socket-option-timeval (fd level option)
  88   (with-foreign-objects ((optval 'et:timeval)
  89                          (optlen 'et:socklen))
  90     (setf (mem-ref optlen 'et:socklen) et:size-of-timeval)
  91     (et:getsockopt fd level option optval optlen)
  92     (with-foreign-slots ((et:sec et:usec) optval et:timeval)
  93       (values et:sec et:usec))))
  94
  95
  96 ;;
  97 ;; Option definitions
  98 ;;
  99
 100 (eval-when (:compile-toplevel :load-toplevel :execute)
 101   (defun make-sockopt-helper-name (action value-type)
 102     (concat-symbol action '-socket-option- value-type))
 103
 104   (defvar +helper-args-map+
 105     '((:bool (value))
 106       (:int (value))
 107       (:linger (onoff linger))
 108       (:timeval (sec usec)))))
 109
 110 (defmacro define-get-sockopt (os eql-name helper-get level optname)
 111   `(defmethod get-socket-option ((socket socket) (option-name (eql ,eql-name)))
 112      ,(if (featurep os)
 113           `(with-socket-error-filter
 114              (,helper-get (socket-fd socket) ,level ,optname))
 115           `(error 'option-not-available option-name))))
 116
 117 (defmacro define-set-sockopt (os eql-name args helper-set level optname)
 118   `(defmethod set-socket-option ((socket socket) (option-name (eql ,eql-name)) &key ,@args)
 119      ,@(if (featurep os)
 120            `((with-socket-error-filter
 121                (,helper-set (socket-fd socket) ,level ,optname ,@args)))
 122            `((declare (ignore ,@args))
 123              (error 'option-not-available option-name)))))
 124
 125 (defmacro define-socket-option (name action optname level argtype os)
 126   (declare (type symbol action)
 127            (type symbol argtype)
 128            (type (or symbol list) os))
 129   (let ((eql-name (ensure-keyword name))
 130         (args (second (assoc argtype +helper-args-map+)))
 131         (helper-get (make-sockopt-helper-name :get argtype))
 132         (helper-set (make-sockopt-helper-name :set argtype)))
 133     `(progn
 134        ,@(remove-if #'null
 135            (list
 136             (when (member action (list :get :get-and-set))
 137               `(define-get-sockopt ,os ,eql-name ,helper-get ,level ,optname))
 138             (when (member action (list :set :get-and-set))
 139               `(define-set-sockopt ,os ,eql-name ,args ,helper-set ,level ,optname)))))))
 140
 141 ;;;;;;;;;;;;;;;;;;;;;
 142 ;; Generic options ;;
 143 ;;;;;;;;;;;;;;;;;;;;;
 144 (define-socket-option accept-connections :get         et:so-acceptconn   et:sol-socket :bool    :unix)
 145 (define-socket-option broadcast          :get-and-set et:so-broadcast    et:sol-socket :bool    :unix)
 146 (define-socket-option debug              :get-and-set et:so-debug        et:sol-socket :bool    :unix)
 147 (define-socket-option dont-route         :get-and-set et:so-dontroute    et:sol-socket :bool    :unix)
 148 (define-socket-option error              :get         et:so-error        et:sol-socket :int     :unix)
 149 (define-socket-option keep-alive         :get-and-set et:so-keepalive    et:sol-socket :bool    :unix)
 150 (define-socket-option linger             :get-and-set et:so-linger       et:sol-socket :linger  :unix)
 151 (define-socket-option oob-inline         :get-and-set et:so-oobinline    et:sol-socket :bool    :unix)
 152 (define-socket-option receive-buffer     :get-and-set et:so-rcvbuf       et:sol-socket :int     :unix)
 153 (define-socket-option send-buffer        :get-and-set et:so-sndbuf       et:sol-socket :int     :unix)
 154 (define-socket-option receive-low-water  :get-and-set et:so-rcvlowat     et:sol-socket :int     :unix)
 155 (define-socket-option send-low-water     :get-and-set et:so-sndlowat     et:sol-socket :int     :unix)
 156 (define-socket-option receive-timeout    :get-and-set et:so-rcvtimeo     et:sol-socket :timeval :unix)
 157 (define-socket-option send-timeout       :get-and-set et:so-sndtimeo     et:sol-socket :timeval :unix)
 158 (define-socket-option reuse-address      :get-and-set et:so-reuseaddr    et:sol-socket :bool    :unix)
 159 (define-socket-option type               :get         et:so-type         et:sol-socket :int     :unix)
 160
 161 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 162 ;; Linux-specific options ;;
 163 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 164 (define-socket-option bsd-compatible     :set         et::so-bsdcompat    et:sol-socket :bool    :linux)
 165 (define-socket-option bind-to-device     :set         et::so-bindtodevice et:sol-socket :int     :linux)
 166 (define-socket-option priority           :get-and-set et::so-priority     et:sol-socket :int     :linux)
 167
 168 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 169 ;; FreeBSD-specific options ;;
 170 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 171 (define-socket-option reuse-port         :get-and-set et::so-reuseport    et:sol-socket :bool    :freebsd)
 172 (define-socket-option use-loopback       :get-and-set et::so-useloopback  et:sol-socket :bool    :freebsd)
 173 (define-socket-option no-sigpipe         :get-and-set et::so-nosigpipe    et:sol-socket :bool    :freebsd)
 174
 175
 176 ;;;;;;;;;;;;;;;;;;;;;;;;
 177 ;;;                  ;;;
 178 ;;; Still to be done ;;;
 179 ;;;                  ;;;
 180 ;;;;;;;;;;;;;;;;;;;;;;;;
 181
 182 ;; TODO: implement "struct ucred" helpers
 183
 184 ;; (define-socket-option pass-credentials   :get-and-set et:so-passcred     et:sol-socket :ucred   (or :linux :freebsd))
 185 ;; (define-socket-option peer-credentials   :get         et:so-peercred     et:sol-socket :ucred   (or :linux :freebsd))
 186
 187
 188 ;; TODO: implement "struct accept_filter_arg" helpers
 189
 190 ;; (define-socket-option accept-filter      :get-and-set et:so-acceptfilter et:sol-socket :accept-filter :freebsd)
 191
 192 ;; TODO: find out the types of these options
 193
 194 ;; (define-socket-option bintime            :get-and-set et:so-bintime      et:sol-socket :bool    :freebsd)
 195 ;; (define-socket-option label              :get-and-set et:so-label        et:sol-socket :bool    :freebsd)
 196 ;; (define-socket-option peerlabel          :get-and-set et:so-peerlabel    et:sol-socket :bool    :freebsd)
 197 ;; (define-socket-option listen-queue-limit :get-and-set et:so-listenqlimit et:sol-socket :int     :freebsd)
 198 ;; (define-socket-option listen-queue-length :get-and-set et:so-listenqlen  et:sol-socket :int     :freebsd)
 199 ;; (define-socket-option listen-incomplete-queue-length :get-and-set et:so-listenincqlen  et:sol-socket :int :freebsd)
 200
 201
 202 ;;;;;;;;;;;;;;;;;
 203 ;; TCP options ;;
 204 ;;;;;;;;;;;;;;;;;
 205
 206 (define-socket-option tcp-nodelay :get-and-set et::tcp-nodelay et:ipproto-tcp :bool :unix)
 207 (define-socket-option tcp-maxseg  :get-and-set et::tcp-maxseg  et:ipproto-tcp :int  (or :linux :freebsd))
 208
 209 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 210 ;; Linux-specific options ;;
 211 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 212 (define-socket-option tcp-cork         :get-and-set et::tcp-cork         et:ipproto-tcp :bool     :linux)
 213 (define-socket-option tcp-defer-accept :get-and-set et::tcp-defer-accept et:ipproto-tcp :int      :linux)
 214 ;; TODO: implement "struct tcp_info" helper
 215 ;; (define-socket-option tcp-info         :get         et::tcp-info         et:ipproto-tcp :tcp-info :linux)
 216 (define-socket-option tcp-keepcnt      :get-and-set et::tcp-keepcnt      et:ipproto-tcp :int      :linux)
 217 (define-socket-option tcp-keepidle     :get-and-set et::tcp-keepidle     et:ipproto-tcp :int      :linux)
 218 (define-socket-option tcp-keepintvl    :get-and-set et::tcp-keepintvl    et:ipproto-tcp :int      :linux)
 219 (define-socket-option tcp-linger2      :get-and-set et::tcp-linger2      et:ipproto-tcp :int      :linux)
 220 (define-socket-option tcp-quickack     :get-and-set et::tcp-quickack     et:ipproto-tcp :bool     :linux)
 221 (define-socket-option tcp-syncnt       :get-and-set et::tcp-syncnt       et:ipproto-tcp :int      :linux)
 222 (define-socket-option tcp-window-clamp :get-and-set et::tcp-window-clamp et:ipproto-tcp :int      :linux)
 223
 224 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 225 ;; FreeBSD-specific options ;;
 226 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 227 (define-socket-option tcp-noopt  :get-and-set et::tcp-noopt  et:ipproto-tcp :bool :freebsd)
 228 (define-socket-option tcp-nopush :get-and-set et::tcp-nopush et:ipproto-tcp :bool :freebsd)