--- /dev/null
+;;;; 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
projects / sbcl.git / blobdiff