0.9.11.14

    Add forgotten files for win32 socket support (sigh)

diff --git a/contrib/sb-bsd-sockets/win32-constants.lisp b/contrib/sb-bsd-sockets/win32-constants.lisp
new file mode 100644 (file)
index 0000000..9fa1f17
--- /dev/null
+++ b/contrib/sb-bsd-sockets/win32-constants.lisp
@@ -0,0 +1,145 @@
+(in-package :sockint)\r
+\r
+(defconstant af-unix 1)\r
+(defconstant af-inet 2)\r
+(defconstant af-local af-unix)\r
+(defconstant msg-oob 1)\r
+(defconstant msg-peek 2)\r
+(defconstant msg-trunc #x8000)\r
+(defconstant msg-waitall 0)\r
+\r
+(defconstant ip-options 1)\r
+(defconstant so-debug 1)\r
+(defconstant so-acceptconn 2)\r
+(defconstant so-reuseaddr 4)\r
+(defconstant so-keepalive 8)\r
+(defconstant so-dontroute 16)\r
+(defconstant so-broadcast 32)\r
+(defconstant so-useloopback 64)\r
+(defconstant so-linger 128)\r
+(defconstant so-oobinline 256)\r
+(defconstant so-dontlinger (lognot so-linger))\r
+(defconstant so-excludiveaddruse (lognot so-reuseaddr))\r
+(defconstant so-sndbuf #x1001)\r
+(defconstant so-rcvbuf #x1002)\r
+(defconstant so-sndlowat #x1003)\r
+(defconstant so-rcvlowat #x1004)\r
+(defconstant so-sndtimeo #x1005)\r
+(defconstant so-rcvtimeo #x1006)\r
+(defconstant so-error #x1007)\r
+(defconstant so-type #x1008)\r
+\r
+(defconstant socket-error -1)\r
+(defconstant sock-stream 1)\r
+(defconstant sock-dgram 2)\r
+(defconstant sock-raw 3)\r
+(defconstant sock-rdm 4)\r
+(defconstant sock-seqpacket 5)\r
+(defconstant tcp-nodelay #x0001)\r
+(defconstant o-append #x0008)\r
+\r
+;; some other windows error code\r
+(defconstant ERROR_NOT_ENOUGH_MEMORY 8)\r
+\r
+;; misc unixy error codes\r
+(defconstant ENOMEM ERROR_NOT_ENOUGH_MEMORY)\r
+(defconstant EPERM 1)\r
+\r
+;; basic socket errors\r
+(defconstant WSABASEERR        10000)\r
+(defconstant EINTR (+ WSABASEERR 4))\r
+(defconstant EBADF (+ WSABASEERR 9))\r
+(defconstant EACCES (+ WSABASEERR 13))\r
+(defconstant EFAULT (+ WSABASEERR 14))\r
+(defconstant EINVAL (+ WSABASEERR 22))\r
+(defconstant EMFILE (+ WSABASEERR 24))\r
+(defconstant EWOULDBLOCK (+ WSABASEERR 35))\r
+(defconstant EAGAIN EWOULDBLOCK)\r
+(defconstant EINPROGRESS (+ WSABASEERR 36))\r
+(defconstant EALREADY (+ WSABASEERR 37))\r
+(defconstant ENOTSOCK (+ WSABASEERR 38))\r
+(defconstant EDESTADDRREQ (+ WSABASEERR 39))\r
+(defconstant EMSGSIZE (+ WSABASEERR 40))\r
+(defconstant EPROTOTYPE (+ WSABASEERR 41))\r
+(defconstant ENOPROTOOPT (+ WSABASEERR 42))\r
+(defconstant EPROTONOSUPPORT (+ WSABASEERR 43))\r
+(defconstant ESOCKTNOSUPPORT (+ WSABASEERR 44))\r
+(defconstant EOPNOTSUPP (+ WSABASEERR 45))\r
+(defconstant EPFNOSUPPORT (+ WSABASEERR 46))\r
+(defconstant EAFNOSUPPORT (+ WSABASEERR 47))\r
+(defconstant EADDRINUSE (+ WSABASEERR 48))\r
+(defconstant EADDRNOTAVAIL (+ WSABASEERR 49))\r
+(defconstant ENETDOWN (+ WSABASEERR 50))\r
+(defconstant ENETUNREACH (+ WSABASEERR 51))\r
+(defconstant ENETRESET (+ WSABASEERR 52))\r
+(defconstant ECONNABORTED (+ WSABASEERR 53))\r
+(defconstant ECONNRESET (+ WSABASEERR 54))\r
+(defconstant ENOBUFS (+ WSABASEERR 55))\r
+(defconstant EISCONN (+ WSABASEERR 56))\r
+(defconstant ENOTCONN (+ WSABASEERR 57))\r
+(defconstant ESHUTDOWN (+ WSABASEERR 58))\r
+(defconstant ETOOMANYREFS (+ WSABASEERR 59))\r
+(defconstant ETIMEDOUT (+ WSABASEERR 60))\r
+(defconstant ECONNREFUSED (+ WSABASEERR 61))\r
+(defconstant ELOOP (+ WSABASEERR 62))\r
+(defconstant ENAMETOOLONG (+ WSABASEERR 63))\r
+(defconstant EHOSTDOWN (+ WSABASEERR 64))\r
+(defconstant EHOSTUNREACH (+ WSABASEERR 65))\r
+(defconstant ENOTEMPTY (+ WSABASEERR 66))\r
+(defconstant EPROCLIM (+ WSABASEERR 67))\r
+(defconstant EUSERS (+ WSABASEERR 68))\r
+(defconstant EDQUOT (+ WSABASEERR 69))\r
+(defconstant ESTALE (+ WSABASEERR 70))\r
+(defconstant EREMOTE (+ WSABASEERR 71))\r
+(defconstant EDISCON (+ WSABASEERR 101))\r
+(defconstant SYSNOTREADY (+ WSABASEERR 91))\r
+(defconstant VERNOTSUPPORTED (+ WSABASEERR 92))\r
+(defconstant NOTINITIALISED (+ WSABASEERR 93))\r
+(defconstant HOST_NOT_FOUND (+ WSABASEERR 1001))\r
+(defconstant TRY_AGAIN (+ WSABASEERR 1002))\r
+(defconstant NO_RECOVERY (+ WSABASEERR 1003))\r
+(defconstant NO_DATA (+ WSABASEERR 1004))\r
+(defconstant WSAENOMORE (+ WSABASEERR 102))\r
+(defconstant WSAECANCELLED (+ WSABASEERR 103))\r
+(defconstant WSAEINVALIDPROCTABLE (+ WSABASEERR 104))\r
+(defconstant WSAEINVALIDPROVIDER (+ WSABASEERR 105))\r
+(defconstant WSAEPROVIDERFAILEDINIT (+ WSABASEERR 106))\r
+(defconstant WSASYSCALLFAILURE (+ WSABASEERR 107))\r
+(defconstant WSASERVICE_NOT_FOUND (+ WSABASEERR 108))\r
+(defconstant WSATYPE_NOT_FOUND (+ WSABASEERR 109))\r
+(defconstant WSA_E_NO_MORE (+ WSABASEERR 110))\r
+(defconstant WSA_E_CANCELLED (+ WSABASEERR 111))\r
+(defconstant WSAEREFUSED (+ WSABASEERR 112))\r
+(defconstant WSA_QOS_RECEIVERS (+ WSABASEERR 1005))\r
+(defconstant WSA_QOS_SENDERS (+ WSABASEERR 1006))\r
+(defconstant WSA_QOS_NO_SENDERS (+ WSABASEERR 1007))\r
+(defconstant WSA_QOS_NO_RECEIVERS (+ WSABASEERR 1008))\r
+(defconstant WSA_QOS_REQUEST_CONFIRMED (+ WSABASEERR 1009))\r
+(defconstant WSA_QOS_ADMISSION_FAILURE (+ WSABASEERR 1010))\r
+(defconstant WSA_QOS_POLICY_FAILURE (+ WSABASEERR 1011))\r
+(defconstant WSA_QOS_BAD_STYLE (+ WSABASEERR 1012))\r
+(defconstant WSA_QOS_BAD_OBJECT (+ WSABASEERR 1013))\r
+(defconstant WSA_QOS_TRAFFIC_CTRL_ERROR (+ WSABASEERR 1014))\r
+(defconstant WSA_QOS_GENERIC_ERROR (+ WSABASEERR 1015))\r
+(defconstant WSA_QOS_ESERVICETYPE (+ WSABASEERR 1016))\r
+(defconstant WSA_QOS_EFLOWSPEC (+ WSABASEERR 1017))\r
+(defconstant WSA_QOS_EPROVSPECBUF (+ WSABASEERR 1018))\r
+(defconstant WSA_QOS_EFILTERSTYLE (+ WSABASEERR 1019))\r
+(defconstant WSA_QOS_EFILTERTYPE (+ WSABASEERR 1020))\r
+(defconstant WSA_QOS_EFILTERCOUNT (+ WSABASEERR 1021))\r
+(defconstant WSA_QOS_EOBJLENGTH (+ WSABASEERR 1022))\r
+(defconstant WSA_QOS_EFLOWCOUNT (+ WSABASEERR 1023))\r
+(defconstant WSA_QOS_EUNKOWNPSOBJ (+ WSABASEERR 1024))\r
+(defconstant WSA_QOS_EPOLICYOBJ (+ WSABASEERR 1025))\r
+(defconstant WSA_QOS_EFLOWDESC (+ WSABASEERR 1026))\r
+(defconstant WSA_QOS_EPSFLOWSPEC (+ WSABASEERR 1027))\r
+(defconstant WSA_QOS_EPSFILTERSPEC (+ WSABASEERR 1028))\r
+(defconstant WSA_QOS_ESDMODEOBJ (+ WSABASEERR 1029))\r
+(defconstant WSA_QOS_ESHAPERATEOBJ (+ WSABASEERR 1030))\r
+(defconstant WSA_QOS_RESERVED_PETYPE (+ WSABASEERR 1031))\r
+\r
+(defconstant HOST-NOT-FOUND (+ WSABASEERR 1001))\r
+(defconstant TRY-AGAIN (+ WSABASEERR 1002))\r
+(defconstant NO-RECOVERY (+ WSABASEERR 1003))\r
+(defconstant NO-ADDRESS NO_DATA)\r
+(defconstant SOL-SOCKET #xffff)
\ No newline at end of file

diff --git a/contrib/sb-bsd-sockets/win32-sockets.lisp b/contrib/sb-bsd-sockets/win32-sockets.lisp
new file mode 100644 (file)
index 0000000..9dff001
--- /dev/null
+++ b/contrib/sb-bsd-sockets/win32-sockets.lisp
@@ -0,0 +1,313 @@
+;;;; 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

diff --git a/version.lisp-expr b/version.lisp-expr
index bba5a72..fd76ee0 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.11.13"
+"0.9.11.14"