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