Fixed parse-number-or-nil.
[iolib.git] / sockets / socket-options.lisp
blobe2cc6f03c35653247a201d40aacc0b169268a95c
1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4 ; Copyright (C) 2006 by Stelian Ionescu ;
5 ; ;
6 ; This program is free software; you can redistribute it and/or modify ;
7 ; it under the terms of the GNU General Public License as published by ;
8 ; the Free Software Foundation; either version 2 of the License, or ;
9 ; (at your option) any later version. ;
10 ; ;
11 ; This program is distributed in the hope that it will be useful, ;
12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of ;
13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;
14 ; GNU General Public License for more details. ;
15 ; ;
16 ; You should have received a copy of the GNU General Public License ;
17 ; along with this program; if not, write to the ;
18 ; Free Software Foundation, Inc., ;
19 ; 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ;
20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
22 ;; (declaim (optimize (speed 2) (safety 2) (space 1) (debug 2)))
23 (declaim (optimize (speed 0) (safety 2) (space 0) (debug 2)))
25 (in-package :net.sockets)
27 ;; TODO: manage socket options errors
28 (defun sockopt-error (retval level option action &optional val1 val2)
29 (declare (type symbol action))
30 (error "Sockopt error !"))
33 ;; Set option helpers
36 (defun set-socket-option-bool (fd level option value)
37 (with-foreign-object (optval :int)
38 (setf (mem-ref optval :int) (lisp->c-bool value))
39 (et:setsockopt fd level option optval et:size-of-int)
40 (values)))
42 (defun set-socket-option-int (fd level option value)
43 (with-foreign-object (optval :int)
44 (setf (mem-ref optval :int) value)
45 (et:setsockopt fd level option optval et:size-of-int)
46 (values)))
48 (defun set-socket-option-linger (fd level option onoff linger)
49 (with-foreign-object (optval 'et:linger)
50 (setf (foreign-slot-value optval 'et:linger 'et:onoff) (lisp->c-bool onoff))
51 (setf (foreign-slot-value optval 'et:linger 'et:linger) linger)
52 (et:setsockopt fd level option optval #.(foreign-type-size 'et:linger))
53 (values)))
55 (defun set-socket-option-timeval (fd level option sec usec)
56 (with-foreign-object (optval 'et:timeval)
57 (setf (foreign-slot-value optval 'et:timeval 'et:tv-sec) sec)
58 (setf (foreign-slot-value optval 'et:timeval 'et:tv-usec) usec)
59 (et:setsockopt fd level option optval #.(foreign-type-size 'et:timeval))
60 (values)))
63 ;; Get option helpers
66 (defun get-socket-option-bool (fd level option)
67 (with-foreign-objects ((optval :int)
68 (optlen :socklen))
69 (setf (mem-ref optlen :int) et:size-of-int)
70 (et:getsockopt fd level option optval optlen)
71 (values (c->lisp-bool optval))))
73 (defun get-socket-option-int (fd level option)
74 (with-foreign-objects ((optval :int)
75 (optlen :socklen))
76 (setf (mem-ref optlen :int) et:size-of-int)
77 (et:getsockopt fd level option optval optlen)
78 (values optval)))
80 (defun get-socket-option-linger (fd level option)
81 (with-foreign-objects ((optval 'et:linger)
82 (optlen :socklen))
83 (setf (mem-ref optlen :int) #.(foreign-type-size 'et:linger))
84 (et:getsockopt fd level option optval optlen)
85 (values (c->lisp-bool (foreign-slot-value optval 'et:linger 'et:onoff))
86 (foreign-slot-value optval 'et:linger 'et:linger))))
88 (defun get-socket-option-timeval (fd level option)
89 (with-foreign-objects ((optval 'et:timeval)
90 (optlen :socklen))
91 (setf (mem-ref optlen :int) #.(foreign-type-size 'et:timeval))
92 (et:getsockopt fd level option optval optlen)
93 (values (foreign-slot-value optval 'et:timeval 'et:tv-sec)
94 (foreign-slot-value optval 'et:timeval 'et:tv-usec))))
98 ;; Option definitions
101 (eval-when (:compile-toplevel :load-toplevel :execute)
102 (defun make-keyword (sym)
103 (read-from-string
104 (concatenate 'string ":" (symbol-name sym))))
106 (defun make-sockopt-helper-name (action value-type)
107 (read-from-string (concatenate 'string
108 (symbol-name action)
109 "-socket-option-"
110 (symbol-name value-type))))
112 (defparameter +helper-args-map+
113 '((:bool (value))
114 (:int (value))
115 (:linger (onoff linger))
116 (:timeval (sec usec)))))
118 (defmacro define-get-sockopt (os eql-name helper-get level optname)
119 `(defmethod get-socket-option ((socket socket) (option-name (eql ,eql-name)))
120 ,(if (member os *features*)
121 `(with-socket-error-filter
122 (,helper-get (socket-fd socket) ,level ,optname))
123 `(error 'option-not-available option-name))))
125 (defmacro define-set-sockopt (os eql-name args helper-set level optname)
126 `(defmethod set-socket-option ((socket socket) (option-name (eql ,eql-name)) &key ,@args)
127 ,@(if (member os *features*)
128 `((with-socket-error-filter
129 (,helper-set (socket-fd socket) ,level ,optname ,@args)))
130 `((declare (ignore ,@args))
131 (error 'option-not-available option-name)))))
133 (defmacro define-socket-option (name action optname level argtype os)
134 (declare (type symbol action)
135 (type symbol argtype)
136 (type symbol os))
137 (let ((eql-name (make-keyword name))
138 (args (second (assoc argtype +helper-args-map+)))
139 (helper-get (make-sockopt-helper-name :get argtype))
140 (helper-set (make-sockopt-helper-name :set argtype)))
141 `(progn
142 ,@(remove-if #'null
143 (list
144 (when (member action (list :get :get-and-set))
145 `(define-get-sockopt ,os ,eql-name ,helper-get ,level ,optname))
146 (when (member action (list :set :get-and-set))
147 `(define-set-sockopt ,os ,eql-name ,args ,helper-set ,level ,optname)))))))
149 ;;;;;;;;;;;;;;;;;;;;;
150 ;; Generic options ;;
151 ;;;;;;;;;;;;;;;;;;;;;
152 (define-socket-option accept-connections :get et::so-acceptconn et::sol-socket :bool :unix)
153 (define-socket-option broadcast :get-and-set et::so-broadcast et::sol-socket :bool :unix)
154 (define-socket-option debug :get-and-set et::so-debug et::sol-socket :bool :unix)
155 (define-socket-option dont-route :get-and-set et::so-dontroute et::sol-socket :bool :unix)
156 (define-socket-option error :get et::so-error et::sol-socket :int :unix)
157 (define-socket-option keep-alive :get-and-set et::so-keepalive et::sol-socket :bool :unix)
158 (define-socket-option linger :get-and-set et::so-linger et::sol-socket :linger :unix)
159 (define-socket-option oob-inline :get-and-set et::so-oobinline et::sol-socket :bool :unix)
160 (define-socket-option receive-buffer :get-and-set et::so-rcvbuf et::sol-socket :int :unix)
161 (define-socket-option send-buffer :get-and-set et::so-sndbuf et::sol-socket :int :unix)
162 (define-socket-option receive-low-water :get-and-set et::so-rcvlowat et::sol-socket :int :unix)
163 (define-socket-option send-low-water :get-and-set et::so-sndlowat et::sol-socket :int :unix)
164 (define-socket-option receive-timeout :get-and-set et::so-rcvtimeo et::sol-socket :timeval :unix)
165 (define-socket-option send-timeout :get-and-set et::so-sndtimeo et::sol-socket :timeval :unix)
166 (define-socket-option reuse-address :get-and-set et::so-reuseaddr et::sol-socket :bool :unix)
167 (define-socket-option type :get et::so-type et::sol-socket :int :unix)
169 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
170 ;; Linux-specific options ;;
171 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
172 (define-socket-option bsd-compatible :set et::so-bsdcompat et::sol-socket :bool :linux)
173 (define-socket-option bind-to-device :set et::so-bindtodevice et::sol-socket :int :linux)
174 (define-socket-option priority :get-and-set et::so-priority et::sol-socket :int :linux)
176 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
177 ;; FreeBSD-specific options ;;
178 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
179 (define-socket-option reuse-port :get-and-set et::so-reuseport et::sol-socket :bool :freebsd)
180 (define-socket-option use-loopback :get-and-set et::so-useloopback et::sol-socket :bool :freebsd)
181 (define-socket-option no-sigpipe :get-and-set et::so-nosigpipe et::sol-socket :bool :freebsd)
184 ;;;;;;;;;;;;;;;;;;;;;;;;
185 ;;; ;;;
186 ;;; Still to be done ;;;
187 ;;; ;;;
188 ;;;;;;;;;;;;;;;;;;;;;;;;
190 ;; TODO: implement "struct ucred" helpers
192 ;; (define-socket-option pass-credentials :get-and-set et::so-passcred et::sol-socket :ucred :freebsd)
193 ;; (define-socket-option peer-credentials :get et::so-peercred et::sol-socket :ucred :freebsd)
196 ;; TODO: implement "struct accept_filter_arg" helpers
198 ;; (define-socket-option accept-filter :get-and-set et::so-acceptfilter et::sol-socket :accept-filter :freebsd)
200 ;; TODO: find out the types of these options
202 ;; (define-socket-option bintime :get-and-set et::so-bintime et::sol-socket :bool :freebsd)
203 ;; (define-socket-option label :get-and-set et::so-label et::sol-socket :bool :freebsd)
204 ;; (define-socket-option peerlabel :get-and-set et::so-peerlabel et::sol-socket :bool :freebsd)
205 ;; (define-socket-option listen-queue-limit :get-and-set et::so-listenqlimit et::sol-socket :int :freebsd)
206 ;; (define-socket-option listen-queue-length :get-and-set et::so-listenqlen et::sol-socket :int :freebsd)
207 ;; (define-socket-option listen-incomplete-queue-length :get-and-set et::so-listenincqlen et::sol-socket :int :freebsd)