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
  20 (defun socket (af type proto)
  21   (let* ((handle (wsa-socket af type proto nil 0 WSA_FLAG_OVERLAPPED))
  22          (fd (handle->fd handle 0)))
  23     fd))
  24
  25 (defun bind (fd &rest options)
  26   (let ((handle (fd->handle fd)))
  27     (apply #'win32-bind handle options)))
  28
  29 (defun getsockname (fd &rest options)
  30   (apply #'win32-getsockname (fd->handle fd) options))
  31
  32 (defun listen (fd &rest options)
  33   (apply #'win32-listen (fd->handle fd) options))
  34
  35 (defun accept (fd &rest options)
  36   (handle->fd
  37    (apply #'win32-accept (fd->handle fd) options)
  38    0))
  39
  40 (defun recv (fd &rest options)
  41   (apply #'win32-recv (fd->handle fd) options))
  42
  43 (defun recvfrom (fd &rest options)
  44   (apply #'win32-recvfrom (fd->handle fd) options))
  45
  46 (defun send (fd &rest options)
  47   (apply #'win32-send (fd->handle fd) options))
  48
  49 (defun sendto (fd &rest options)
  50   (apply #'win32-sendto (fd->handle fd) options))
  51
  52 (defun close (fd &rest options)
  53   (apply #'win32-close (fd->handle fd) options))
  54
  55 (defun connect (fd &rest options)
  56   (apply #'win32-connect (fd->handle fd) options))
  57
  58 (defun getpeername (fd &rest options)
  59   (apply #'win32-getpeername (fd->handle fd) options))
  60
  61 (defun ioctl (fd &rest options)
  62   (apply #'win32-ioctl (fd->handle fd) options))
  63
  64 (defun setsockopt (fd &rest options)
  65   (apply #'win32-setsockopt (fd->handle fd) options))
  66
  67 (defun getsockopt (fd &rest options)
  68   (apply #'win32-getsockopt (fd->handle fd) options))
  69
  70 (defun make-wsa-version (major minor)
  71   (dpb minor (byte 8 8) major))
  72
  73 (defvar *wsa-startup-call* nil)
  74
  75 (defun call-wsa-startup ()
  76   (setf *wsa-startup-call* (wsa-startup (make-wsa-version 2 2))))
  77
  78 ;;; Startup!
  79 (call-wsa-startup)
  80
  81 ;;; Ensure startup for saved cores as well.
  82 (push 'call-wsa-startup sb-ext:*init-hooks*)
  83
  84 ;; not implemented on win32
  85 (defconstant af-local 0)
  86 (defconstant msg-dontwait 0)
  87 (defconstant msg-trunc 0)
  88 (defconstant msg-eor 0)
  89 (defconstant msg-nosignal 0)
  90 (defconstant msg-waitall 0)
  91 (defconstant msg-eor 0)
  92 (defconstant size-of-sockaddr-un 0)
  93 (defun (setf sockaddr-un-family) (addr family) ())
  94 (defun (setf sockaddr-un-path) (addr family) ())
  95 (defun sockaddr-un-path (addr) ())
  96 (defun free-sockaddr-un (addr) ())
  97 (defun allocate-sockaddr-un () ())
  98
  99