X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Fwin32-sockets.lisp;h=2e732955a4591b8fbaf0b2164b043c70474a741e;hb=d3514a7ffc6fb1078e9709dd20fc4da31151a457;hp=42d5c864d0abdd3c7123128e381ed870d6b86168;hpb=568daf6b160280428701670b921f419aabd9eba0;p=sbcl.git

diff --git a/contrib/sb-bsd-sockets/win32-sockets.lisp b/contrib/sb-bsd-sockets/win32-sockets.lisp
index 42d5c86..2e73295 100644
--- a/contrib/sb-bsd-sockets/win32-sockets.lisp
+++ b/contrib/sb-bsd-sockets/win32-sockets.lisp
@@ -1,313 +1,99 @@
-;;;; 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)
-
-(sb-alien:load-shared-object "ws2_32.dll")
-(sb-alien:load-shared-object "msvcrt.dll")
-
-(sb-alien:define-alien-type nil
-  (struct WSADATA
-          (wVersion (unsigned 16))
-          (wHighVersion (unsigned 16))
-          (szDescription (array char 257))
-          (szSystemStatus (array char 129))
-          (iMaxSockets (unsigned 16))
-          (iMaxUdpDg (unsigned 16))
-          (lpVendorInfo sb-alien:c-string)))
-
-(sb-alien:define-alien-type nil
-  (struct s_un_byte
-          (s_b1 (unsigned 8))
-          (s_b2 (unsigned 8))
-          (s_b3 (unsigned 8))
-          (s_b4 (unsigned 8))))
-
-(sb-alien:define-alien-type nil
-  (struct s_un_wide
-          (s_w1 (unsigned 16))
-          (s_w2 (unsigned 16))))
-
-(sb-alien:define-alien-type nil
-  (union s_union
-         (s_un_b (struct s_un_byte))
-         (s_un_w (struct s_un_wide))
-         (s_addr (unsigned 32))))
-
-(sb-alien:define-alien-type nil
-  (struct in_addr
-          (s_union (union s_union))))
-
-(sb-alien:define-alien-type nil
-  (struct sockaddr_in
-          (sin_family (signed 16))
-          (sin_port (array (unsigned 8) 2))
-          (sin_addr (array (unsigned 8) 4))
-          (sin_zero (array char 8))))
-
-(defconstant size-of-sockaddr-in 16)
-
-(defconstant size-of-sockaddr-un 16)
-
-(sb-alien:define-alien-type nil
-  (struct sockaddr
-          (sa_family (unsigned 16))
-          (sa_data (array char 14))))
-
-(sb-alien:define-alien-type nil
-  (struct hostent
-          (h_name sb-alien:c-string)
-          (h_aliases (* sb-alien:c-string))
-          (h_addrtype sb-alien:short)
-          (h_length sb-alien:short)
-          (h_addr_list (* (* (unsigned 8))))))
-
-(sb-alien:define-alien-type nil
-  (struct  protoent
-        (pname sb-alien:c-string)
-        (p_aliases (* sb-alien:c-string))
-        (p_proto (signed 16))))
-
-(sb-alien:define-alien-type socklen-t
-                            (unsigned 32))
-
-
-;;; these are all non-HANDLE using, so are safe to have here
-(sb-alien:define-alien-routine "gethostbyaddr" (struct hostent)
-                               (addr sb-alien:c-string)
-                               (len int)
-                               (type int))
-
-(sb-alien:define-alien-routine "gethostbyname" (struct hostent)
-                               (addr sb-alien:c-string))
-
-(sb-alien:define-alien-routine "getservbyport" (struct servent)
-                               (port int)
-                               (proto sb-alien:c-string))
-
-(sb-alien:define-alien-routine "getservbyname" (struct servent)
-                               (name sb-alien:c-string)
-                               (proto sb-alien:c-string))
-
-(sb-alien:define-alien-routine "getprotobynumber" (struct protoent)
-                               (number int))
-
-(sb-alien:define-alien-routine "getprotobyname" (struct protoent)
-                               (name sb-alien:c-string))
-
-;;; these are the alien references to the
-;;; winsock calls
-
-(in-package :win32sockint)
-
-(sb-alien:define-alien-routine "socket" int
-  (af int)
-  (type int)
-  (protocol int))
-
-(sb-alien:define-alien-routine ("WSASocketA" wsa-socket) int
-  (af int)
-  (type int)
-  (protocol int)
-  (lpProtocolInfo (* t))
-  (g int)
-  (flags int))
-
-(sb-alien:define-alien-routine "bind" int
-  (s int)
-  (name (* (struct sockint::sockaddr_in)))
-  (namelen int))
-
-(sb-alien:define-alien-routine "getsockname" int
-  (s int)
-  (name (* (struct sockint::sockaddr_in)))
-  (namelen int :in-out))
-
-(sb-alien:define-alien-routine "listen" int
-  (s int)
-  (backlog int))
-
-(sb-alien:define-alien-routine "accept" int
-  (s int)
-  (addr (* (struct sockint::sockaddr_in)))
-  (addrlen int :in-out))
-
-(sb-alien:define-alien-routine "recv" int
-                               (s int)
-                               (buf (* t))
-                               (len int)
-                               (flags int))
-
-(sb-alien:define-alien-routine "recvfrom" int
-                               (s int)
-                               (buf (* t))
-                               (len int)
-                               (flags int)
-                               (from (* (struct sockint::sockaddr_in)))
-                               (fromlen (* sockint::socklen-t)))
-
-(sb-alien:define-alien-routine ("closesocket" close) int
-                               (s int))
-
-(sb-alien:define-alien-routine "connect" int
-                               (s int)
-                               (name (* (struct sockint::sockaddr_in)))
-                               (namelen int))
-
-(sb-alien:define-alien-routine "getpeername" int
-                               (s int)
-                               (name (* (struct sockint::sockaddr_in)))
-                               (namelen int :in-out))
-
-(sb-alien:define-alien-routine "getsockopt" int
-                               (s int)
-                               (level int)
-                               (optname int)
-                               (optval sb-alien:c-string)
-                               (optlen int :in-out))
-
-(sb-alien:define-alien-routine ("ioctlsocket" ioctl) int
-                               (s int)
-                               (cmd int)
-                               (argp (unsigned 32) :in-out))
-
-(sb-alien:define-alien-routine "setsockopt" int
-                               (s int)
-                               (level int)
-                               (optname int)
-                               (optval (* t))
-                               (optlen int))
-
-
-;;;; we are now going back to the normal sockint
-;;;; package where we will redefine all of the above
-;;;; functions, converting between HANDLES and fds
-
-(in-package :sockint)
-
-(sb-alien:define-alien-routine ("_get_osfhandle" fd->handle) sb-alien:long
-                               (fd int))
-
-(sb-alien:define-alien-routine ("_open_osfhandle" handle->fd) int
-                               (osfhandle int)
-                               (flags int))
-
-(defun socket (af type proto)
-  (let* ((handle (win32sockint::wsa-socket af type proto nil 0 0))
-         (fd (handle->fd handle 0)))
-    fd))
-
-(defun bind (fd &rest options)
-  (let ((handle (fd->handle fd)))
-    (apply #'win32sockint::bind handle options)))
-
-(defun getsockname (fd &rest options)
-  (apply #'win32sockint::getsockname (fd->handle fd) options))
-
-(defun listen (fd &rest options)
-  (apply #'win32sockint::listen (fd->handle fd) options))
-
-(defun accept (fd &rest options)
-  (handle->fd 
-   (apply #'win32sockint::accept (fd->handle fd) options)
-   0))
-
-(defun recv (fd &rest options)
-  (apply #'win32sockint::recv (fd->handle fd) options))
-
-(defun recvfrom (fd &rest options)
-  (apply #'win32sockint::recvfrom (fd->handle fd) options))
-
-(defun close (fd &rest options)
-  (apply #'win32sockint::close (fd->handle fd) options))
-
-(defun connect (fd &rest options)
-  (apply #'win32sockint::connect (fd->handle fd) options))
-
-(defun getpeername (fd &rest options)
-  (apply #'win32sockint::getpeername (fd->handle fd) options))
-
-(defun getsockopt (fd &rest options)
-  (apply #'win32sockint::getsockopt (fd->handle fd) options))
-
-(defun ioctl (fd &rest options)
-  (apply #'win32sockint::ioctl (fd->handle fd) options))
-
-(defun setsockopt (fd &rest options)
-  (apply #'win32sockint::setsockopt (fd->handle fd) options))
-
-(defmacro with-in-addr (name init &rest body)
-  (declare (ignore init))
-  `(with-alien ((,name (struct in_addr)))
-               ,@body))
-
-(defun in-addr-addr (addr)
-  (sb-alien:slot (sb-alien:slot addr 's_union) 's_addr))
-
-(defmacro sockaddr-in-addr (addr)
-  `(sb-alien:slot ,addr 'sin_addr))
-
-(defmacro sockaddr-in-family (addr)
-  `(sb-alien:slot ,addr 'sin_family))
-
-(defmacro sockaddr-in-port (addr)
-  `(sb-alien:slot ,addr 'sin_port))
-
-(defun allocate-sockaddr-in ()
-  (sb-alien:make-alien (struct sockaddr_in)))
-
-(defun free-sockaddr-in (addr)
-  (sb-alien:free-alien addr))
-
-(defmacro protoent-proto (ent)
-  `(sb-alien:slot ,ent 'p_proto))
-
-(defmacro hostent-addresses (ent)
-  `(sb-alien:slot ,ent 'h_addr_list))
-
-(defmacro hostent-aliases (ent)
-  `(sb-alien:slot ,ent 'h_aliases))
-
-(defmacro hostent-length (ent)
-   `(sb-alien:slot ,ent 'h_length))
-
-(defmacro hostent-name (ent)
-   `(sb-alien:slot ,ent 'h_name))
-
-(defmacro hostent-type (ent)
-   `(sb-alien:slot ,ent 'h_addrtype))
-
-(sb-alien:define-alien-routine ("WSAStartup" wsa-startup) int
-  (wVersionRequested (unsigned 16))
-  (lpWSAData (struct WSADATA) :out))
-
-(sb-alien:define-alien-routine ("WSAGetLastError" wsa-get-last-error) int)
-
-(defun make-wsa-version (major minor)
-  (dpb minor (byte 8 8) major))
-
-(defun make-sockaddr (family)
-  (let ((sa (make-alien (struct sockaddr))))
-    (setf (slot sa 'sa_family) family)
-    (dotimes (n 10)
-      (setf (deref (slot sa 'sa_data) n) 0))
-    sa))
-
-
-
-
-;; un-addr not implemented on win32
-(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 () ())
-
+;;;; 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)
+
+(defun socket (af type proto)
+  (let* ((handle (wsa-socket af type proto nil 0 WSA_FLAG_OVERLAPPED))
+         (fd (handle->fd handle 0)))
+    fd))
+
+(defun bind (fd &rest options)
+  (let ((handle (fd->handle fd)))
+    (apply #'win32-bind handle options)))
+
+(defun getsockname (fd &rest options)
+  (apply #'win32-getsockname (fd->handle fd) options))
+
+(defun listen (fd &rest options)
+  (apply #'win32-listen (fd->handle fd) options))
+
+(defun accept (fd &rest options)
+  (handle->fd
+   (apply #'win32-accept (fd->handle fd) options)
+   0))
+
+(defun recv (fd &rest options)
+  (apply #'win32-recv (fd->handle fd) options))
+
+(defun recvfrom (fd &rest options)
+  (apply #'win32-recvfrom (fd->handle fd) options))
+
+(defun send (fd &rest options)
+  (apply #'win32-send (fd->handle fd) options))
+
+(defun sendto (fd &rest options)
+  (apply #'win32-sendto (fd->handle fd) options))
+
+(defun close (fd &rest options)
+  (apply #'win32-close (fd->handle fd) options))
+
+(defun connect (fd &rest options)
+  (apply #'win32-connect (fd->handle fd) options))
+
+(defun getpeername (fd &rest options)
+  (apply #'win32-getpeername (fd->handle fd) options))
+
+(defun ioctl (fd &rest options)
+  (apply #'win32-ioctl (fd->handle fd) options))
+
+(defun setsockopt (fd &rest options)
+  (apply #'win32-setsockopt (fd->handle fd) options))
+
+(defun getsockopt (fd &rest options)
+  (apply #'win32-getsockopt (fd->handle fd) options))
+
+(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 () ())
+
+