-;;;; win32 socket operations\r
-;;;; these have all been done by hand since I can't seem\r
-;;;; to get my head around the sb-grovel stuff\r
-\r
-;;;; Winsock requires us to convert HANDLES to/from\r
-;;;; file descriptors, so I've added an additional\r
-;;;; package for the actual winsock alien defs, and then\r
-;;;; in the sockint package, we implement wrappers that\r
-;;;; handle the conversion.\r
-\r
-;;; these are all of the basic structure alien defs\r
-(in-package :sockint)\r
-\r
-(sb-alien:load-shared-object "ws2_32.dll")\r
-(sb-alien:load-shared-object "msvcrt.dll")\r
-\r
-(sb-alien:define-alien-type nil\r
- (struct WSADATA\r
- (wVersion (unsigned 16))\r
- (wHighVersion (unsigned 16))\r
- (szDescription (array char 257))\r
- (szSystemStatus (array char 129))\r
- (iMaxSockets (unsigned 16))\r
- (iMaxUdpDg (unsigned 16))\r
- (lpVendorInfo sb-alien:c-string)))\r
-\r
-(sb-alien:define-alien-type nil\r
- (struct s_un_byte\r
- (s_b1 (unsigned 8))\r
- (s_b2 (unsigned 8))\r
- (s_b3 (unsigned 8))\r
- (s_b4 (unsigned 8))))\r
-\r
-(sb-alien:define-alien-type nil\r
- (struct s_un_wide\r
- (s_w1 (unsigned 16))\r
- (s_w2 (unsigned 16))))\r
-\r
-(sb-alien:define-alien-type nil\r
- (union s_union\r
- (s_un_b (struct s_un_byte))\r
- (s_un_w (struct s_un_wide))\r
- (s_addr (unsigned 32))))\r
-\r
-(sb-alien:define-alien-type nil\r
- (struct in_addr\r
- (s_union (union s_union))))\r
-\r
-(sb-alien:define-alien-type nil\r
- (struct sockaddr_in\r
- (sin_family (signed 16))\r
- (sin_port (array (unsigned 8) 2))\r
- (sin_addr (array (unsigned 8) 4))\r
- (sin_zero (array char 8))))\r
-\r
-(defconstant size-of-sockaddr-in 16)\r
-\r
-(defconstant size-of-sockaddr-un 16)\r
-\r
-(sb-alien:define-alien-type nil\r
- (struct sockaddr\r
- (sa_family (unsigned 16))\r
- (sa_data (array char 14))))\r
-\r
-(sb-alien:define-alien-type nil\r
- (struct hostent\r
- (h_name sb-alien:c-string)\r
- (h_aliases (* sb-alien:c-string))\r
- (h_addrtype sb-alien:short)\r
- (h_length sb-alien:short)\r
- (h_addr_list (* (* (unsigned 8))))))\r
-\r
-(sb-alien:define-alien-type nil\r
- (struct protoent\r
- (pname sb-alien:c-string)\r
- (p_aliases (* sb-alien:c-string))\r
- (p_proto (signed 16))))\r
-\r
-(sb-alien:define-alien-type socklen-t\r
- (unsigned 32))\r
-\r
-\r
-;;; these are all non-HANDLE using, so are safe to have here\r
-(sb-alien:define-alien-routine "gethostbyaddr" (struct hostent)\r
- (addr sb-alien:c-string)\r
- (len int)\r
- (type int))\r
-\r
-(sb-alien:define-alien-routine "gethostbyname" (struct hostent)\r
- (addr sb-alien:c-string))\r
-\r
-(sb-alien:define-alien-routine "getservbyport" (struct servent)\r
- (port int)\r
- (proto sb-alien:c-string))\r
-\r
-(sb-alien:define-alien-routine "getservbyname" (struct servent)\r
- (name sb-alien:c-string)\r
- (proto sb-alien:c-string))\r
-\r
-(sb-alien:define-alien-routine "getprotobynumber" (struct protoent)\r
- (number int))\r
-\r
-(sb-alien:define-alien-routine "getprotobyname" (struct protoent)\r
- (name sb-alien:c-string))\r
-\r
-;;; these are the alien references to the\r
-;;; winsock calls\r
-\r
-(in-package :win32sockint)\r
-\r
-(sb-alien:define-alien-routine "socket" int\r
- (af int)\r
- (type int)\r
- (protocol int))\r
-\r
-(sb-alien:define-alien-routine ("WSASocketA" wsa-socket) int\r
- (af int)\r
- (type int)\r
- (protocol int)\r
- (lpProtocolInfo (* t))\r
- (g int)\r
- (flags int))\r
-\r
-(sb-alien:define-alien-routine "bind" int\r
- (s int)\r
- (name (* (struct sockint::sockaddr_in)))\r
- (namelen int))\r
-\r
-(sb-alien:define-alien-routine "getsockname" int\r
- (s int)\r
- (name (* (struct sockint::sockaddr_in)))\r
- (namelen int :in-out))\r
-\r
-(sb-alien:define-alien-routine "listen" int\r
- (s int)\r
- (backlog int))\r
-\r
-(sb-alien:define-alien-routine "accept" int\r
- (s int)\r
- (addr (* (struct sockint::sockaddr_in)))\r
- (addrlen int :in-out))\r
-\r
-(sb-alien:define-alien-routine "recv" int\r
- (s int)\r
- (buf (* t))\r
- (len int)\r
- (flags int))\r
-\r
-(sb-alien:define-alien-routine "recvfrom" int\r
- (s int)\r
- (buf (* t))\r
- (len int)\r
- (flags int)\r
- (from (* (struct sockint::sockaddr_in)))\r
- (fromlen (* sockint::socklen-t)))\r
-\r
-(sb-alien:define-alien-routine ("closesocket" close) int\r
- (s int))\r
-\r
-(sb-alien:define-alien-routine "connect" int\r
- (s int)\r
- (name (* (struct sockint::sockaddr_in)))\r
- (namelen int))\r
-\r
-(sb-alien:define-alien-routine "getpeername" int\r
- (s int)\r
- (name (* (struct sockint::sockaddr_in)))\r
- (namelen int :in-out))\r
-\r
-(sb-alien:define-alien-routine "getsockopt" int\r
- (s int)\r
- (level int)\r
- (optname int)\r
- (optval sb-alien:c-string)\r
- (optlen int :in-out))\r
-\r
-(sb-alien:define-alien-routine ("ioctlsocket" ioctl) int\r
- (s int)\r
- (cmd int)\r
- (argp (unsigned 32) :in-out))\r
-\r
-(sb-alien:define-alien-routine "setsockopt" int\r
- (s int)\r
- (level int)\r
- (optname int)\r
- (optval (* t))\r
- (optlen int))\r
-\r
-\r
-;;;; we are now going back to the normal sockint\r
-;;;; package where we will redefine all of the above\r
-;;;; functions, converting between HANDLES and fds\r
-\r
-(in-package :sockint)\r
-\r
-(sb-alien:define-alien-routine ("_get_osfhandle" fd->handle) sb-alien:long\r
- (fd int))\r
-\r
-(sb-alien:define-alien-routine ("_open_osfhandle" handle->fd) int\r
- (osfhandle int)\r
- (flags int))\r
-\r
-(defun socket (af type proto)\r
- (let* ((handle (win32sockint::wsa-socket af type proto nil 0 0))\r
- (fd (handle->fd handle 0)))\r
- fd))\r
-\r
-(defun bind (fd &rest options)\r
- (let ((handle (fd->handle fd)))\r
- (apply #'win32sockint::bind handle options)))\r
-\r
-(defun getsockname (fd &rest options)\r
- (apply #'win32sockint::getsockname (fd->handle fd) options))\r
-\r
-(defun listen (fd &rest options)\r
- (apply #'win32sockint::listen (fd->handle fd) options))\r
-\r
-(defun accept (fd &rest options)\r
- (handle->fd \r
- (apply #'win32sockint::accept (fd->handle fd) options)\r
- 0))\r
-\r
-(defun recv (fd &rest options)\r
- (apply #'win32sockint::recv (fd->handle fd) options))\r
-\r
-(defun recvfrom (fd &rest options)\r
- (apply #'win32sockint::recvfrom (fd->handle fd) options))\r
-\r
-(defun close (fd &rest options)\r
- (apply #'win32sockint::close (fd->handle fd) options))\r
-\r
-(defun connect (fd &rest options)\r
- (apply #'win32sockint::connect (fd->handle fd) options))\r
-\r
-(defun getpeername (fd &rest options)\r
- (apply #'win32sockint::getpeername (fd->handle fd) options))\r
-\r
-(defun getsockopt (fd &rest options)\r
- (apply #'win32sockint::getsockopt (fd->handle fd) options))\r
-\r
-(defun ioctl (fd &rest options)\r
- (apply #'win32sockint::ioctl (fd->handle fd) options))\r
-\r
-(defun setsockopt (fd &rest options)\r
- (apply #'win32sockint::setsockopt (fd->handle fd) options))\r
-\r
-(defmacro with-in-addr (name init &rest body)\r
- (declare (ignore init))\r
- `(with-alien ((,name (struct in_addr)))\r
- ,@body))\r
-\r
-(defun in-addr-addr (addr)\r
- (sb-alien:slot (sb-alien:slot addr 's_union) 's_addr))\r
-\r
-(defmacro sockaddr-in-addr (addr)\r
- `(sb-alien:slot ,addr 'sin_addr))\r
-\r
-(defmacro sockaddr-in-family (addr)\r
- `(sb-alien:slot ,addr 'sin_family))\r
-\r
-(defmacro sockaddr-in-port (addr)\r
- `(sb-alien:slot ,addr 'sin_port))\r
-\r
-(defun allocate-sockaddr-in ()\r
- (sb-alien:make-alien (struct sockaddr_in)))\r
-\r
-(defun free-sockaddr-in (addr)\r
- (sb-alien:free-alien addr))\r
-\r
-(defmacro protoent-proto (ent)\r
- `(sb-alien:slot ,ent 'p_proto))\r
-\r
-(defmacro hostent-addresses (ent)\r
- `(sb-alien:slot ,ent 'h_addr_list))\r
-\r
-(defmacro hostent-aliases (ent)\r
- `(sb-alien:slot ,ent 'h_aliases))\r
-\r
-(defmacro hostent-length (ent)\r
- `(sb-alien:slot ,ent 'h_length))\r
-\r
-(defmacro hostent-name (ent)\r
- `(sb-alien:slot ,ent 'h_name))\r
-\r
-(defmacro hostent-type (ent)\r
- `(sb-alien:slot ,ent 'h_addrtype))\r
-\r
-(sb-alien:define-alien-routine ("WSAStartup" wsa-startup) int\r
- (wVersionRequested (unsigned 16))\r
- (lpWSAData (struct WSADATA) :out))\r
-\r
-(sb-alien:define-alien-routine ("WSAGetLastError" wsa-get-last-error) int)\r
-\r
-(defun make-wsa-version (major minor)\r
- (dpb minor (byte 8 8) major))\r
-\r
-(defun make-sockaddr (family)\r
- (let ((sa (make-alien (struct sockaddr))))\r
- (setf (slot sa 'sa_family) family)\r
- (dotimes (n 10)\r
- (setf (deref (slot sa 'sa_data) n) 0))\r
- sa))\r
-\r
-\r
-\r
-\r
-;; un-addr not implemented on win32\r
-(defun (setf sockaddr-un-family) (addr family) ())\r
-(defun (setf sockaddr-un-path) (addr family) ())\r
-(defun sockaddr-un-path (addr) ())\r
-(defun free-sockaddr-un (addr) ())\r
-(defun allocate-sockaddr-un () ())\r
-\r
+;;;; win32 socket operations
+;;;; these have all been done by hand since I can't seem
+;;;; to get my head around the sb-grovel stuff
+
+;;;; Winsock requires us to convert HANDLES to/from
+;;;; file descriptors, so I've added an additional
+;;;; package for the actual winsock alien defs, and then
+;;;; in the sockint package, we implement wrappers that
+;;;; handle the conversion.
+
+;;; these are all of the basic structure alien defs
+(in-package :sockint)
+
+;;;; we are now going back to the normal sockint
+;;;; package where we will redefine all of the above
+;;;; functions, converting between HANDLES and fds
+
+(defconstant WSA_FLAG_OVERLAPPED 1)
+(declaim (inline handle->fd fd->handle))
+
+;;; For a few more releases, let's preserve old functions (now
+;;; implemented as identity) for user code which might have had to peek
+;;; into our internals in past versions when we hadn't been using
+;;; handles yet. -- DFL, 2012
+(defun handle->fd (handle flags) (declare (ignore flags)) handle)
+(defun fd->handle (fd) fd)
+
+(defun socket (af type proto)
+ (wsa-socket af type proto nil 0 WSA_FLAG_OVERLAPPED))
+
+;;; For historical reasons, the FFI functions declared in win32-constants
+;;; prepend "win32-" to the symbol names. Rather than break compatibility
+;;; for users depending on those names, wrap the misnamed functions in
+;;; correctly named ones...
+(macrolet ((define-socket-fd-arg-routines (&rest names)
+ `(progn
+ (declaim (inline ,@names))
+ ,@(loop for routine in names collect
+ `(defun ,routine (handle &rest options)
+ (apply #',(sb-int:symbolicate "WIN32-" routine)
+ handle options))))))
+ (define-socket-fd-arg-routines
+ bind getsockname listen recv recvfrom send sendto close connect
+ getpeername ioctl setsockopt getsockopt))
+
+(defun accept (handle &rest options)
+ (let ((handle (apply #'win32-accept handle options)))
+ (if (= handle -1)
+ -1
+ handle)))
+
+(defun make-wsa-version (major minor)
+ (dpb minor (byte 8 8) major))
+
+(defvar *wsa-startup-call* nil)
+
+(defun call-wsa-startup ()
+ (setf *wsa-startup-call* (wsa-startup (make-wsa-version 2 2))))
+
+;;; Startup!
+(call-wsa-startup)
+
+;;; Ensure startup for saved cores as well.
+(push 'call-wsa-startup sb-ext:*init-hooks*)
+
+;; not implemented on win32
+(defconstant af-local 0)
+(defconstant msg-dontwait 0)
+(defconstant msg-trunc 0)
+(defconstant msg-eor 0)
+(defconstant msg-nosignal 0)
+(defconstant msg-waitall 0)
+(defconstant msg-eor 0)
+(defconstant size-of-sockaddr-un 0)
+(defun (setf sockaddr-un-family) (addr family) ())
+(defun (setf sockaddr-un-path) (addr family) ())
+(defun sockaddr-un-path (addr) ())
+(defun free-sockaddr-un (addr) ())
+(defun allocate-sockaddr-un () ())
+
+
projects / sbcl.git / blobdiff