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 (sb-int:define-deprecated-function :late ("SBCL" "1.2.10")
  26     handle->fd nil (handle flags)
  27   (declare (ignore flags))
  28   handle)
  29 (sb-int:define-deprecated-function :late ("SBCL" "1.2.10")
  30     fd->handle nil (fd)
  31   fd)
  32
  33 (defun socket (af type proto)
  34   (wsa-socket af type proto nil 0 WSA_FLAG_OVERLAPPED))
  35
  36 ;;; For historical reasons, the FFI functions declared in win32-constants
  37 ;;; prepend "win32-" to the symbol names.  Rather than break compatibility
  38 ;;; for users depending on those names, wrap the misnamed functions in
  39 ;;; correctly named ones...
  40 (macrolet
  41     ((define-socket-fd-arg-routines (&rest names)
  42        (flet ((make-definition (name)
  43                 (let ((deprecated-name (sb-int:symbolicate "WIN32-" name)))
  44                   `(sb-int:define-deprecated-function
  45                        :early ("SBCL" "1.2.10") ,deprecated-name (,name)
  46                        (handle &rest options)
  47                      (apply #',name handle options)))))
  48          `(progn
  49             (declaim (inline ,@names))
  50             ,@(mapcar #'make-definition names)))))
  51   (define-socket-fd-arg-routines
  52     bind getsockname listen accept
  53     recv recvfrom send sendto close connect
  54     getpeername ioctl setsockopt getsockopt))
  55
  56 (defun make-wsa-version (major minor)
  57   (dpb minor (byte 8 8) major))
  58
  59 (defvar *wsa-startup-call* nil)
  60
  61 (defun call-wsa-startup ()
  62   (setf *wsa-startup-call* (wsa-startup (make-wsa-version 2 2))))
  63
  64 ;;; Startup!
  65 (call-wsa-startup)
  66
  67 ;;; Ensure startup for saved cores as well.
  68 (push 'call-wsa-startup sb-ext:*init-hooks*)
  69
  70 ;; not implemented on win32
  71 (defconstant af-local 0)
  72 (defconstant msg-dontwait 0)
  73 (defconstant msg-trunc 0)
  74 (defconstant msg-eor 0)
  75 (defconstant msg-nosignal 0)
  76 (defconstant msg-waitall 0)
  77 (defconstant msg-eor 0)
  78 (defconstant size-of-sockaddr-un 0)
  79 (defun (setf sockaddr-un-family) (addr family) ())
  80 (defun (setf sockaddr-un-path) (addr family) ())
  81 (defun sockaddr-un-path (addr) ())
  82 (defun free-sockaddr-un (addr) ())
  83 (defun allocate-sockaddr-un () ())