contrib/sb-bsd-sockets/win32-sockets.lisp

   1 ;;;; win32 socket operations\r
   2 ;;;; these have all been done by hand since I can't seem\r
   3 ;;;; to get my head around the sb-grovel stuff\r
   4 \r
   5 ;;;; Winsock requires us to convert HANDLES to/from\r
   6 ;;;; file descriptors, so I've added an additional\r
   7 ;;;; package for the actual winsock alien defs, and then\r
   8 ;;;; in the sockint package, we implement wrappers that\r
   9 ;;;; handle the conversion.\r
  10 \r
  11 ;;; these are all of the basic structure alien defs\r
  12 (in-package :sockint)\r
  13 \r
  14 (sb-alien:load-shared-object "ws2_32.dll")\r
  15 (sb-alien:load-shared-object "msvcrt.dll")\r
  16 \r
  17 (sb-alien:define-alien-type nil\r
  18   (struct WSADATA\r
  19           (wVersion (unsigned 16))\r
  20           (wHighVersion (unsigned 16))\r
  21           (szDescription (array char 257))\r
  22           (szSystemStatus (array char 129))\r
  23           (iMaxSockets (unsigned 16))\r
  24           (iMaxUdpDg (unsigned 16))\r
  25           (lpVendorInfo sb-alien:c-string)))\r
  26 \r
  27 (sb-alien:define-alien-type nil\r
  28   (struct s_un_byte\r
  29           (s_b1 (unsigned 8))\r
  30           (s_b2 (unsigned 8))\r
  31           (s_b3 (unsigned 8))\r
  32           (s_b4 (unsigned 8))))\r
  33 \r
  34 (sb-alien:define-alien-type nil\r
  35   (struct s_un_wide\r
  36           (s_w1 (unsigned 16))\r
  37           (s_w2 (unsigned 16))))\r
  38 \r
  39 (sb-alien:define-alien-type nil\r
  40   (union s_union\r
  41          (s_un_b (struct s_un_byte))\r
  42          (s_un_w (struct s_un_wide))\r
  43          (s_addr (unsigned 32))))\r
  44 \r
  45 (sb-alien:define-alien-type nil\r
  46   (struct in_addr\r
  47           (s_union (union s_union))))\r
  48 \r
  49 (sb-alien:define-alien-type nil\r
  50   (struct sockaddr_in\r
  51           (sin_family (signed 16))\r
  52           (sin_port (array (unsigned 8) 2))\r
  53           (sin_addr (array (unsigned 8) 4))\r
  54           (sin_zero (array char 8))))\r
  55 \r
  56 (defconstant size-of-sockaddr-in 16)\r
  57 \r
  58 (defconstant size-of-sockaddr-un 16)\r
  59 \r
  60 (sb-alien:define-alien-type nil\r
  61   (struct sockaddr\r
  62           (sa_family (unsigned 16))\r
  63           (sa_data (array char 14))))\r
  64 \r
  65 (sb-alien:define-alien-type nil\r
  66   (struct hostent\r
  67           (h_name sb-alien:c-string)\r
  68           (h_aliases (* sb-alien:c-string))\r
  69           (h_addrtype sb-alien:short)\r
  70           (h_length sb-alien:short)\r
  71           (h_addr_list (* (* (unsigned 8))))))\r
  72 \r
  73 (sb-alien:define-alien-type nil\r
  74   (struct  protoent\r
  75         (pname sb-alien:c-string)\r
  76         (p_aliases (* sb-alien:c-string))\r
  77         (p_proto (signed 16))))\r
  78 \r
  79 (sb-alien:define-alien-type socklen-t\r
  80                             (unsigned 32))\r
  81 \r
  82 \r
  83 ;;; these are all non-HANDLE using, so are safe to have here\r
  84 (sb-alien:define-alien-routine "gethostbyaddr" (struct hostent)\r
  85                                (addr sb-alien:c-string)\r
  86                                (len int)\r
  87                                (type int))\r
  88 \r
  89 (sb-alien:define-alien-routine "gethostbyname" (struct hostent)\r
  90                                (addr sb-alien:c-string))\r
  91 \r
  92 (sb-alien:define-alien-routine "getservbyport" (struct servent)\r
  93                                (port int)\r
  94                                (proto sb-alien:c-string))\r
  95 \r
  96 (sb-alien:define-alien-routine "getservbyname" (struct servent)\r
  97                                (name sb-alien:c-string)\r
  98                                (proto sb-alien:c-string))\r
  99 \r
 100 (sb-alien:define-alien-routine "getprotobynumber" (struct protoent)\r
 101                                (number int))\r
 102 \r
 103 (sb-alien:define-alien-routine "getprotobyname" (struct protoent)\r
 104                                (name sb-alien:c-string))\r
 105 \r
 106 ;;; these are the alien references to the\r
 107 ;;; winsock calls\r
 108 \r
 109 (in-package :win32sockint)\r
 110 \r
 111 (sb-alien:define-alien-routine "socket" int\r
 112   (af int)\r
 113   (type int)\r
 114   (protocol int))\r
 115 \r
 116 (sb-alien:define-alien-routine ("WSASocketA" wsa-socket) int\r
 117   (af int)\r
 118   (type int)\r
 119   (protocol int)\r
 120   (lpProtocolInfo (* t))\r
 121   (g int)\r
 122   (flags int))\r
 123 \r
 124 (sb-alien:define-alien-routine "bind" int\r
 125   (s int)\r
 126   (name (* (struct sockint::sockaddr_in)))\r
 127   (namelen int))\r
 128 \r
 129 (sb-alien:define-alien-routine "getsockname" int\r
 130   (s int)\r
 131   (name (* (struct sockint::sockaddr_in)))\r
 132   (namelen int :in-out))\r
 133 \r
 134 (sb-alien:define-alien-routine "listen" int\r
 135   (s int)\r
 136   (backlog int))\r
 137 \r
 138 (sb-alien:define-alien-routine "accept" int\r
 139   (s int)\r
 140   (addr (* (struct sockint::sockaddr_in)))\r
 141   (addrlen int :in-out))\r
 142 \r
 143 (sb-alien:define-alien-routine "recv" int\r
 144                                (s int)\r
 145                                (buf (* t))\r
 146                                (len int)\r
 147                                (flags int))\r
 148 \r
 149 (sb-alien:define-alien-routine "recvfrom" int\r
 150                                (s int)\r
 151                                (buf (* t))\r
 152                                (len int)\r
 153                                (flags int)\r
 154                                (from (* (struct sockint::sockaddr_in)))\r
 155                                (fromlen (* sockint::socklen-t)))\r
 156 \r
 157 (sb-alien:define-alien-routine ("closesocket" close) int\r
 158                                (s int))\r
 159 \r
 160 (sb-alien:define-alien-routine "connect" int\r
 161                                (s int)\r
 162                                (name (* (struct sockint::sockaddr_in)))\r
 163                                (namelen int))\r
 164 \r
 165 (sb-alien:define-alien-routine "getpeername" int\r
 166                                (s int)\r
 167                                (name (* (struct sockint::sockaddr_in)))\r
 168                                (namelen int :in-out))\r
 169 \r
 170 (sb-alien:define-alien-routine "getsockopt" int\r
 171                                (s int)\r
 172                                (level int)\r
 173                                (optname int)\r
 174                                (optval sb-alien:c-string)\r
 175                                (optlen int :in-out))\r
 176 \r
 177 (sb-alien:define-alien-routine ("ioctlsocket" ioctl) int\r
 178                                (s int)\r
 179                                (cmd int)\r
 180                                (argp (unsigned 32) :in-out))\r
 181 \r
 182 (sb-alien:define-alien-routine "setsockopt" int\r
 183                                (s int)\r
 184                                (level int)\r
 185                                (optname int)\r
 186                                (optval (* t))\r
 187                                (optlen int))\r
 188 \r
 189 \r
 190 ;;;; we are now going back to the normal sockint\r
 191 ;;;; package where we will redefine all of the above\r
 192 ;;;; functions, converting between HANDLES and fds\r
 193 \r
 194 (in-package :sockint)\r
 195 \r
 196 (sb-alien:define-alien-routine ("_get_osfhandle" fd->handle) sb-alien:long\r
 197                                (fd int))\r
 198 \r
 199 (sb-alien:define-alien-routine ("_open_osfhandle" handle->fd) int\r
 200                                (osfhandle int)\r
 201                                (flags int))\r
 202 \r
 203 (defun socket (af type proto)\r
 204   (let* ((handle (win32sockint::wsa-socket af type proto nil 0 0))\r
 205          (fd (handle->fd handle 0)))\r
 206     fd))\r
 207 \r
 208 (defun bind (fd &rest options)\r
 209   (let ((handle (fd->handle fd)))\r
 210     (apply #'win32sockint::bind handle options)))\r
 211 \r
 212 (defun getsockname (fd &rest options)\r
 213   (apply #'win32sockint::getsockname (fd->handle fd) options))\r
 214 \r
 215 (defun listen (fd &rest options)\r
 216   (apply #'win32sockint::listen (fd->handle fd) options))\r
 217 \r
 218 (defun accept (fd &rest options)\r
 219   (handle->fd \r
 220    (apply #'win32sockint::accept (fd->handle fd) options)\r
 221    0))\r
 222 \r
 223 (defun recv (fd &rest options)\r
 224   (apply #'win32sockint::recv (fd->handle fd) options))\r
 225 \r
 226 (defun recvfrom (fd &rest options)\r
 227   (apply #'win32sockint::recvfrom (fd->handle fd) options))\r
 228 \r
 229 (defun close (fd &rest options)\r
 230   (apply #'win32sockint::close (fd->handle fd) options))\r
 231 \r
 232 (defun connect (fd &rest options)\r
 233   (apply #'win32sockint::connect (fd->handle fd) options))\r
 234 \r
 235 (defun getpeername (fd &rest options)\r
 236   (apply #'win32sockint::getpeername (fd->handle fd) options))\r
 237 \r
 238 (defun getsockopt (fd &rest options)\r
 239   (apply #'win32sockint::getsockopt (fd->handle fd) options))\r
 240 \r
 241 (defun ioctl (fd &rest options)\r
 242   (apply #'win32sockint::ioctl (fd->handle fd) options))\r
 243 \r
 244 (defun setsockopt (fd &rest options)\r
 245   (apply #'win32sockint::setsockopt (fd->handle fd) options))\r
 246 \r
 247 (defmacro with-in-addr (name init &rest body)\r
 248   (declare (ignore init))\r
 249   `(with-alien ((,name (struct in_addr)))\r
 250                ,@body))\r
 251 \r
 252 (defun in-addr-addr (addr)\r
 253   (sb-alien:slot (sb-alien:slot addr 's_union) 's_addr))\r
 254 \r
 255 (defmacro sockaddr-in-addr (addr)\r
 256   `(sb-alien:slot ,addr 'sin_addr))\r
 257 \r
 258 (defmacro sockaddr-in-family (addr)\r
 259   `(sb-alien:slot ,addr 'sin_family))\r
 260 \r
 261 (defmacro sockaddr-in-port (addr)\r
 262   `(sb-alien:slot ,addr 'sin_port))\r
 263 \r
 264 (defun allocate-sockaddr-in ()\r
 265   (sb-alien:make-alien (struct sockaddr_in)))\r
 266 \r
 267 (defun free-sockaddr-in (addr)\r
 268   (sb-alien:free-alien addr))\r
 269 \r
 270 (defmacro protoent-proto (ent)\r
 271   `(sb-alien:slot ,ent 'p_proto))\r
 272 \r
 273 (defmacro hostent-addresses (ent)\r
 274   `(sb-alien:slot ,ent 'h_addr_list))\r
 275 \r
 276 (defmacro hostent-aliases (ent)\r
 277   `(sb-alien:slot ,ent 'h_aliases))\r
 278 \r
 279 (defmacro hostent-length (ent)\r
 280    `(sb-alien:slot ,ent 'h_length))\r
 281 \r
 282 (defmacro hostent-name (ent)\r
 283    `(sb-alien:slot ,ent 'h_name))\r
 284 \r
 285 (defmacro hostent-type (ent)\r
 286    `(sb-alien:slot ,ent 'h_addrtype))\r
 287 \r
 288 (sb-alien:define-alien-routine ("WSAStartup" wsa-startup) int\r
 289   (wVersionRequested (unsigned 16))\r
 290   (lpWSAData (struct WSADATA) :out))\r
 291 \r
 292 (sb-alien:define-alien-routine ("WSAGetLastError" wsa-get-last-error) int)\r
 293 \r
 294 (defun make-wsa-version (major minor)\r
 295   (dpb minor (byte 8 8) major))\r
 296 \r
 297 (defun make-sockaddr (family)\r
 298   (let ((sa (make-alien (struct sockaddr))))\r
 299     (setf (slot sa 'sa_family) family)\r
 300     (dotimes (n 10)\r
 301       (setf (deref (slot sa 'sa_data) n) 0))\r
 302     sa))\r
 303 \r
 304 \r
 305 \r
 306 \r
 307 ;; un-addr not implemented on win32\r
 308 (defun (setf sockaddr-un-family) (addr family) ())\r
 309 (defun (setf sockaddr-un-path) (addr family) ())\r
 310 (defun sockaddr-un-path (addr) ())\r
 311 (defun free-sockaddr-un (addr) ())\r
 312 (defun allocate-sockaddr-un () ())\r
 313 \r