1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
3 ;;; common.lisp --- Various helpers for bsd-sockets.
5 ;;; Copyright (C) 2006-2007, Stelian Ionescu <sionescu@common-lisp.net>
7 ;;; This code is free software; you can redistribute it and/or
8 ;;; modify it under the terms of the version 2.1 of
9 ;;; the GNU Lesser General Public License as published by
10 ;;; the Free Software Foundation, as clarified by the
11 ;;; preamble found here:
12 ;;; http://opensource.franz.com/preamble.html
14 ;;; This program is distributed in the hope that it will be useful,
15 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;;; GNU General Public License for more details.
19 ;;; You should have received a copy of the GNU Lesser General
20 ;;; Public License along with this library; if not, write to the
21 ;;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
22 ;;; Boston, MA 02110-1301, USA
24 (in-package :net.sockets
)
28 (deftype ipv4-array
() '(ub8-sarray 4))
29 (deftype ipv6-array
() '(ub16-sarray 8))
31 ;;;; Byte-swap functions
34 (check-type short ub16
"a 16-bit unsigned number")
36 (logior (ash (logand (the ub16 short
) #x00FF
) 8)
37 (ash (logand (the ub16 short
) #xFF00
) -
8))
44 (check-type long ub32
"a 32-bit unsigned number")
46 (logior (ash (logand (the ub32 long
) #x000000FF
) 24)
47 (ash (logand (the ub32 long
) #x0000FF00
) 8)
48 (ash (logand (the ub32 long
) #x00FF0000
) -
8)
49 (ash (logand (the ub32 long
) #xFF000000
) -
24))
55 ;;;; Conversion between address formats
57 (defun copy-simple-array-ub16-to-alien-vector (lisp-vec alien-vec
)
58 (declare (type ipv6-array lisp-vec
))
60 (setf (mem-aref alien-vec
:uint16 i
)
61 (htons (aref lisp-vec i
)))))
63 (defun map-ipv4-vector-to-ipv6 (addr)
64 (declare (type ipv4-array addr
))
65 (let ((ipv6addr (make-array 8 :element-type
'ub16
67 ;; setting the IPv4 marker
68 (setf (aref ipv6addr
5) #xFFFF
)
69 ;; setting the first two bytes
70 (setf (aref ipv6addr
6) (+ (ash (aref addr
0) 8)
72 ;; setting the last two bytes
73 (setf (aref ipv6addr
7) (+ (ash (aref addr
2) 8)
77 (defun map-ipv6-vector-to-ipv4 (addr)
78 (declare (type ipv6-array addr
))
79 (let ((ipv4addr (make-array 4 :element-type
'ub8
81 (setf (aref ipv4addr
0) (ldb (byte 8 8) (aref addr
6)))
82 (setf (aref ipv4addr
1) (ldb (byte 8 0) (aref addr
6)))
83 (setf (aref ipv4addr
2) (ldb (byte 8 8) (aref addr
7)))
84 (setf (aref ipv4addr
3) (ldb (byte 8 0) (aref addr
7)))
87 ;;; From CLOCC's PORT library.
88 (defun vector-to-integer (vector)
89 "Convert a vector to a 32-bit unsigned integer."
90 (coercef vector
'ipv4-array
)
91 (+ (ash (aref vector
0) 24)
92 (ash (aref vector
1) 16)
93 (ash (aref vector
2) 8)
96 (defun integer-to-vector (ipaddr)
97 "Convert a 32-bit unsigned integer to a vector."
98 (check-type ipaddr ub32
)
99 (let ((vector (make-array 4 :element-type
'ub8
)))
100 (setf (aref vector
0) (ldb (byte 8 24) ipaddr
)
101 (aref vector
1) (ldb (byte 8 16) ipaddr
)
102 (aref vector
2) (ldb (byte 8 8) ipaddr
)
103 (aref vector
3) (ldb (byte 8 0) ipaddr
))
106 (defun in6-addr-to-ipv6-array (in6-addr)
107 (let ((vector (make-array 8 :element-type
'ub16
)))
109 (setf (aref vector i
)
110 (ntohs (mem-aref in6-addr
:uint16 i
))))
113 ;;;; Constructors for SOCKADDR_* structs
115 (defun make-sockaddr-in (sin ub8-vector
&optional
(portno 0))
116 (declare (type ipv4-array ub8-vector
) (type ub16 portno
))
117 (bzero sin size-of-sockaddr-in
)
118 (with-foreign-slots ((family addr port
) sin sockaddr-in
)
119 (setf family af-inet
)
120 (setf addr
(htonl (vector-to-integer ub8-vector
)))
121 (setf port
(htons portno
)))
124 (defmacro with-sockaddr-in
((var address
&optional
(port 0)) &body body
)
125 `(with-foreign-object (,var
'sockaddr-in
)
126 (make-sockaddr-in ,var
,address
,port
)
129 (defun make-sockaddr-in6 (sin6 ub16-vector
&optional
(portno 0))
130 (declare (type ipv6-array ub16-vector
) (type ub16 portno
))
131 (bzero sin6 size-of-sockaddr-in6
)
132 (with-foreign-slots ((family addr port
) sin6 sockaddr-in6
)
133 (setf family af-inet6
)
134 (copy-simple-array-ub16-to-alien-vector ub16-vector addr
)
135 (setf port
(htons portno
)))
138 (defmacro with-sockaddr-in6
((var address
&optional port
) &body body
)
139 `(with-foreign-object (,var
'sockaddr-in6
)
140 (make-sockaddr-in6 ,var
,address
,port
)
143 (defun make-sockaddr-un (sun string
)
144 (declare (type string string
))
145 (bzero sun size-of-sockaddr-un
)
146 (with-foreign-slots ((family path
) sun sockaddr-un
)
147 (setf family af-local
)
148 (with-foreign-string (c-string string
)
149 (loop :for off
:below
(1- unix-path-max
)
150 :do
(setf (mem-aref path
:uint8 off
)
151 (mem-aref c-string
:uint8 off
)))))
154 (defmacro with-sockaddr-un
((var address
) &body body
)
155 `(with-foreign-object (,var
'sockaddr-un
)
156 (make-sockaddr-un ,var
,address
)
159 ;;;; Conversion functions for SOCKADDR_* structs
161 (defun sockaddr-in->sockaddr
(sin)
162 (with-foreign-slots ((addr port
) sin sockaddr-in
)
163 (values (make-instance 'ipv4-address
164 :name
(integer-to-vector (ntohl addr
)))
167 (defun sockaddr-in6->sockaddr
(sin6)
168 (with-foreign-slots ((addr port
) sin6 sockaddr-in6
)
169 (values (make-instance 'ipv6-address
170 :name
(in6-addr-to-ipv6-array addr
))
173 (defun sockaddr-un->sockaddr
(sun)
174 (with-foreign-slots ((path) sun sockaddr-un
)
175 (let ((name (make-string (1- unix-path-max
)))
177 (if (zerop (mem-aref path
:uint8
0))
181 (loop :for sindex
:from
0 :below
(1- unix-path-max
)
182 :for pindex
:from
1 :below unix-path-max
183 :do
(setf (schar name sindex
)
184 (code-char (mem-aref path
:uint8 pindex
)))))
185 ;; address is in the filesystem
186 (setf name
(foreign-string-to-lisp path
)))
187 (make-instance 'local-address
189 :abstract abstract
))))
191 (defun sockaddr-storage->sockaddr
(ss)
192 (with-foreign-slots ((family) ss sockaddr-storage
)
194 (#.af-inet
(sockaddr-in->sockaddr ss
))
195 (#.af-inet6
(sockaddr-in6->sockaddr ss
))
196 (#.af-local
(sockaddr-un->sockaddr ss
)))))
198 (defun sockaddr->sockaddr-storage
(ss sockaddr
&optional
(port 0))
200 (ipv4-address (make-sockaddr-in ss
(address-name sockaddr
) port
))
201 (ipv6-address (make-sockaddr-in6 ss
(address-name sockaddr
) port
))
202 (local-address (make-sockaddr-un ss
(address-name sockaddr
)))))
206 (defmacro check-bounds
(sequence start end
)
207 (with-unique-names (length)
208 `(let ((,length
(length ,sequence
)))
211 (unless (<= ,start
,end
,length
)
212 (error "Wrong sequence bounds. start: ~S end: ~S" ,start
,end
)))))
214 (defun %to-octets
(buff ef start end
)
215 (babel:string-to-octets buff
:start start
:end end
216 :encoding
(babel:external-format-encoding ef
)))
218 (defun parse-number-or-nil (value &optional
(type :any
) (radix 10))
219 (check-type value
(or string unsigned-byte
))
222 (ignore-errors (parse-integer value
:radix radix
226 ;; if it's a number and its type is ok return it
227 (typep parsed
(ecase type
229 (:ub16
'ub16
) (:ub32
'ub32
)))
232 (defun lisp->c-bool
(val)
235 (defmacro with-socklen
((var value
) &body body
)
236 `(with-foreign-object (,var
'socklen
)
237 (setf (mem-ref ,var
'socklen
) ,value
)