sockets/bsd.lisp

   1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; bsd.lisp --- Bindings for BSD sockets (and Winsock).
   4 ;;;
   5 ;;; Copyright (C) 2005-2006, Matthew Backes  <lucca@accela.net>
   6 ;;; Copyright (C) 2005-2006, Dan Knapp  <dankna@accela.net> and
   7 ;;; Copyright (C) 2007, Stelian Ionescu  <sionescu@common-lisp.net>
   8 ;;; Copyright (C) 2007, Luis Oliveira  <loliveira@common-lisp.net>
   9 ;;;
  10 ;;; Permission is hereby granted, free of charge, to any person
  11 ;;; obtaining a copy of this software and associated documentation
  12 ;;; files (the "Software"), to deal in the Software without
  13 ;;; restriction, including without limitation the rights to use, copy,
  14 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
  15 ;;; of the Software, and to permit persons to whom the Software is
  16 ;;; furnished to do so, subject to the following conditions:
  17 ;;;
  18 ;;; The above copyright notice and this permission notice shall be
  19 ;;; included in all copies or substantial portions of the Software.
  20 ;;;
  21 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  22 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  23 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  24 ;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  25 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  26 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  27 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  28 ;;; DEALINGS IN THE SOFTWARE.
  29
  30 (in-package :net.sockets)
  31
  32 ;;; Simple wrapper around DEFCFUN that uses the stdcall calling
  33 ;;; convention on windows.
  34 (defmacro deforeign (name-and-opts return-type &body args)
  35   (multiple-value-bind (lisp-name c-name options)
  36       (cffi::parse-name-and-options name-and-opts)
  37     #+windows
  38     (appendf options '(:calling-convention :stdcall))
  39     `(defcfun (,c-name ,lisp-name ,@options) ,return-type
  40        ,@args)))
  41
  42 (defmacro define-socket-call (name return-type &body args)
  43   `(deforeign ,name (errno-wrapper ,return-type
  44                                    :error-generator signal-socket-error)
  45      ,@args))
  46
  47 #-windows
  48 (defctype fd :int)
  49
  50 #+windows
  51 (progn
  52   (define-foreign-type fd-type ()
  53     ()
  54     (:actual-type :int)
  55     (:simple-parser fd))
  56
  57   (defmethod translate-to-foreign (fd (type fd-type))
  58     (get-osfhandle fd)))
  59
  60 ;;;; sys/socket.h
  61
  62 (define-socket-call "accept" :int
  63   "Accept an incoming connection, returning the file descriptor."
  64   (socket  fd)
  65   (address :pointer) ; sockaddr-foo
  66   (addrlen :pointer))
  67
  68 (define-socket-call "bind" :int
  69   "Bind a socket to a particular local address."
  70   (fd      fd)
  71   (address :pointer)
  72   (addrlen socklen))
  73
  74 (define-socket-call ("connect" %connect) :int
  75   "Create an outgoing connection on a given socket."
  76   (socket  fd)
  77   (address :pointer) ; sockaddr-foo
  78   (addrlen socklen))
  79
  80 (define-socket-call "getpeername" :int
  81   (socket  fd)
  82   (address :pointer)
  83   (addrlen :pointer))
  84
  85 (define-socket-call "getsockname" :int
  86   (socket  fd)
  87   (address :pointer)
  88   (addrlen :pointer))
  89
  90 (define-socket-call "getsockopt" :int
  91   "Retrieve socket configuration."
  92   (fd      fd)
  93   (level   :int)
  94   (optname :int)
  95   (optval  :pointer)
  96   (optlen  :pointer))
  97
  98 (define-socket-call "listen" :int
  99   "Mark a bound socket as listening for incoming connections."
 100   (socket  fd)
 101   (backlog :int))
 102
 103 (define-socket-call "recv" ssize
 104   (socket fd)
 105   (buffer :pointer)
 106   (length size)
 107   (flags  :int))
 108
 109 (define-socket-call "recvfrom" ssize
 110   (socket  fd)
 111   (buffer  :pointer)
 112   (length  size)
 113   (flags   :int)
 114   (address :pointer)
 115   (addrlen :pointer))
 116
 117 #-(and) ; unused
 118 (define-socket-call "recvmsg" ssize
 119   (socket  fd)
 120   (message :pointer)
 121   (flags   :int))
 122
 123 (define-socket-call "send" ssize
 124   (socket fd)
 125   (buffer :pointer)
 126   (length size)
 127   (flags  :int))
 128
 129 #-(and) ; unused
 130 (define-socket-call "sendmsg" ssize
 131   (socket  fd)
 132   (message :pointer)
 133   (flags   :int))
 134
 135 (define-socket-call "sendto" ssize
 136   (socket   fd)
 137   (buffer   :pointer)
 138   (length   size)
 139   (flags    :int)
 140   (destaddr :pointer)
 141   (destlen  socklen))
 142
 143 (define-socket-call "setsockopt" :int
 144   "Configure a socket."
 145   (fd      fd)
 146   (level   :int)
 147   (optname :int)
 148   (optval  :pointer)
 149   (optlen  socklen))
 150
 151 (define-socket-call ("shutdown" %shutdown) :int
 152   (socket fd)
 153   (how    :int))
 154
 155 ;;; SOCKET is emulated in winsock.lisp.
 156 #-windows
 157 (define-socket-call "socket" :int
 158   "Create a BSD socket."
 159   (domain   :int)  ; af-*
 160   (type     :int)  ; sock-*
 161   (protocol :int))
 162
 163 #-(and) ; unused
 164 (define-socket-call "sockatmark" :int
 165   (socket fd))
 166
 167 #-(and) ; unused
 168 (define-socket-call ("socketpair" %socketpair) :int
 169   (domain   :int)  ; af-*
 170   (type     :int)  ; sock-*
 171   (protocol :int)
 172   (filedes  :pointer))
 173
 174 #-(and) ; unused
 175 (defun socketpair (domain type protocol)
 176   (with-foreign-object (filedes :int 2)
 177     (%socketpair domain type protocol filedes)
 178     (values (mem-aref filedes :int 0)
 179             (mem-aref filedes :int 1))))
 180
 181 ;;;; netinet/un.h
 182
 183 #-windows
 184 (defconstant unix-path-max
 185   (- size-of-sockaddr-un (foreign-slot-offset 'sockaddr-un 'path)))
 186
 187 ;;;; netdb.h
 188
 189 ;;; TODO: more socket stuff, deal with this later
 190
 191 (define-socket-call "freeaddrinfo" :void
 192   (ai :pointer))
 193
 194 (defcfun "getaddrinfo"
 195     (errno-wrapper :int
 196                    :error-predicate (lambda (x) (not (zerop x)))
 197                    :error-generator signal-resolver-error)
 198   (node    :string)
 199   (service :string)
 200   (hints   :pointer)
 201   (result  :pointer))
 202
 203 ;;; For systems with missing or broken getaddrinfo().
 204 (defcfun "gethostbyaddr" hostent
 205   (addr :pointer)
 206   (len  socklen)
 207   (type :int))
 208
 209 ;;; ditto
 210 (defcfun "getservbyport" servent
 211   (port  :int)
 212   (proto :string))
 213
 214 ;;; Winsock's getnameinfo() return values are compatible with POSIX
 215 ;;; even though they have WSA_* counterparts.
 216 ;;;
 217 ;;; <http://msdn2.microsoft.com/en-us/library/ms738532.aspx>
 218 (defcfun "getnameinfo"
 219     (errno-wrapper :int
 220                    :error-predicate (lambda (x) (not (zerop x)))
 221                    :error-generator signal-resolver-error)
 222   (sa         :pointer)
 223   (salen      socklen)
 224   (node       :pointer)
 225   (nodelen    socklen)
 226   (service    :pointer)
 227   (servicelen socklen)
 228   (flags      :int))
 229
 230 (define-socket-call "getprotobyname" :pointer
 231   (name :string))
 232
 233 (define-socket-call "getprotobynumber" :pointer
 234   (proto :int))
 235
 236 ;;;; arpa/inet.h
 237
 238 #-(and) ; unused
 239 (define-socket-call "inet_ntop" :string
 240   (family :int)
 241   (src    :pointer)
 242   (dest   :pointer)
 243   (size   socklen))
 244
 245 #-windows
 246 (defcfun "inet_pton"
 247     (errno-wrapper :int :error-predicate (lambda (x) (not (plusp x))))
 248   (family :int)
 249   (src    :string)
 250   (dest   :pointer))
 251
 252 ;;;; net/if.h
 253
 254 ;;; On windows, these functions are only available on Vista or later.
 255 #-windows
 256 (progn
 257   (defcfun "if_nametoindex"
 258       (errno-wrapper :unsigned-int :error-predicate zerop)
 259     (ifname :string))
 260
 261   (define-socket-call "if_indextoname" :string
 262     (ifindex :unsigned-int)
 263     (ifname  :pointer))
 264
 265   (define-socket-call "if_nameindex" :pointer
 266     "Return all network interface names and indexes")
 267
 268   (define-socket-call "if_freenameindex" :void
 269     (ptr :pointer)))