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

   1 ;;;; win32 socket operations
   2 ;;;; these have all been done by hand since I can't seem
   3 ;;;; to get my head around the sb-grovel stuff
   4
   5 ;;;; Winsock requires us to convert HANDLES to/from
   6 ;;;; file descriptors, so I've added an additional
   7 ;;;; package for the actual winsock alien defs, and then
   8 ;;;; in the sockint package, we implement wrappers that
   9 ;;;; handle the conversion.
  10
  11 ;;; these are all of the basic structure alien defs
  12 (in-package :sockint)
  13
  14 ;;;; we are now going back to the normal sockint
  15 ;;;; package where we will redefine all of the above
  16 ;;;; functions, converting between HANDLES and fds
  17
  18 (defconstant WSA_FLAG_OVERLAPPED 1)
  19 (declaim (inline handle->fd fd->handle))
  20
  21 ;;; For a few more releases, let's preserve old functions (now
  22 ;;; implemented as identity) for user code which might have had to peek
  23 ;;; into our internals in past versions when we hadn't been using
  24 ;;; handles yet. -- DFL, 2012
  25 (defun handle->fd (handle flags) (declare (ignore flags)) handle)
  26 (defun fd->handle (fd) fd)
  27
  28 (defun socket (af type proto)
  29   (wsa-socket af type proto nil 0 WSA_FLAG_OVERLAPPED))
  30
  31 ;;; For historical reasons, the FFI functions declared in win32-constants
  32 ;;; prepend "win32-" to the symbol names.  Rather than break compatibility
  33 ;;; for users depending on those names, wrap the misnamed functions in
  34 ;;; correctly named ones...
  35 (macrolet ((define-socket-fd-arg-routines (&rest names)
  36              `(progn
  37                 (declaim (inline ,@names))
  38                 ,@(loop for routine in names collect
  39                        `(defun ,routine (handle &rest options)
  40                           (apply #',(sb-int:symbolicate "WIN32-" routine)
  41                                  handle options))))))
  42   (define-socket-fd-arg-routines
  43       bind getsockname listen recv recvfrom send sendto close connect
  44       getpeername ioctl setsockopt getsockopt))
  45
  46 (defun accept (handle &rest options)
  47   (let ((handle (apply #'win32-accept handle options)))
  48     (if (= handle -1)
  49         -1
  50         handle)))
  51
  52 (defun make-wsa-version (major minor)
  53   (dpb minor (byte 8 8) major))
  54
  55 (defvar *wsa-startup-call* nil)
  56
  57 (defun call-wsa-startup ()
  58   (setf *wsa-startup-call* (wsa-startup (make-wsa-version 2 2))))
  59
  60 ;;; Startup!
  61 (call-wsa-startup)
  62
  63 ;;; Ensure startup for saved cores as well.
  64 (push 'call-wsa-startup sb-ext:*init-hooks*)
  65
  66 ;; not implemented on win32
  67 (defconstant af-local 0)
  68 (defconstant msg-dontwait 0)
  69 (defconstant msg-trunc 0)
  70 (defconstant msg-eor 0)
  71 (defconstant msg-nosignal 0)
  72 (defconstant msg-waitall 0)
  73 (defconstant msg-eor 0)
  74 (defconstant size-of-sockaddr-un 0)
  75 (defun (setf sockaddr-un-family) (addr family) ())
  76 (defun (setf sockaddr-un-path) (addr family) ())
  77 (defun sockaddr-un-path (addr) ())
  78 (defun free-sockaddr-un (addr) ())
  79 (defun allocate-sockaddr-un () ())
  80
  81