From 5a0fd10d9995460c34c0cfb509b97d1cc931932b Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 30 May 2006 12:03:00 +0000 Subject: [PATCH] 0.9.13.10: better SB-BSD-SOCKETS on Windows * ...now using SB-GROVEL, thanks to Timothy Ritchey. --- NEWS | 2 + contrib/sb-bsd-sockets/sb-bsd-sockets.asd | 25 +- contrib/sb-bsd-sockets/sockets.lisp | 4 - contrib/sb-bsd-sockets/win32-constants.lisp | 379 +++++++++++++++---------- contrib/sb-bsd-sockets/win32-lib.lisp | 3 + contrib/sb-bsd-sockets/win32-sockets.lisp | 402 ++++++--------------------- version.lisp-expr | 2 +- 7 files changed, 345 insertions(+), 472 deletions(-) create mode 100644 contrib/sb-bsd-sockets/win32-lib.lisp diff --git a/NEWS b/NEWS index 950cd1e..1bb190d 100644 --- a/NEWS +++ b/NEWS @@ -11,6 +11,8 @@ changes in sbcl-0.9.14 relative to sbcl-0.9.13: * bug fix: merging pathnames against defaults with :DIRECTORY starting with '(:RELATIVE :BACK) should preserve the :BACK. (reported by James Y Knight) + * improved SB-BSD-SOCKETS support on Windows. (thanks to Timothy + Ritchey) * fixed some bugs revealed by Paul Dietz' test suite: ** MISC.641: LET-conversion were not supposed to work in late compilation stages. diff --git a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd index b818457..7b2aaa1 100644 --- a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd +++ b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd @@ -1,30 +1,36 @@ ;;; -*- Lisp -*- -#-win32 (eval-when (:compile-toplevel :load-toplevel :execute) +(eval-when (:compile-toplevel :load-toplevel :execute) (require :sb-grovel)) -(defpackage #:sb-bsd-sockets-system (:use #:asdf #-win32 #:sb-grovel #:cl)) +(defpackage #:sb-bsd-sockets-system (:use #:asdf #:sb-grovel #:cl)) (in-package #:sb-bsd-sockets-system) (defsystem sb-bsd-sockets :version "0.58" - :depends-on #-win32 (sb-grovel) #+win32 () + :depends-on (sb-grovel) #+sb-building-contrib :pathname #+sb-building-contrib "SYS:CONTRIB;SB-BSD-SOCKETS;" :components ((:file "defpackage") - #+win32 (:file "win32-constants" :depends-on ("defpackage")) - #+win32 (:file "win32-sockets" :depends-on ("win32-constants")) (:file "split" :depends-on ("defpackage")) (:file "malloc" :depends-on ("defpackage")) + #+win32 + (:file "win32-lib") #-win32 (sb-grovel:grovel-constants-file - "constants" - :package :sockint - :depends-on ("defpackage")) + "constants" + :package :sockint + :depends-on ("defpackage")) + #+win32 (sb-grovel:grovel-constants-file + "win32-constants" + :package :sockint + :depends-on ("defpackage" "win32-lib")) + #+win32 (:file "win32-sockets" + :depends-on ("win32-constants")) (:file "sockets" :depends-on #-win32 ("constants") #+win32 ("win32-sockets")) (:file "sockopt" :depends-on ("sockets")) (:file "inet" :depends-on ("sockets" "split")) (:file "local" :depends-on ("sockets" "split")) - (:file "name-service" :depends-on ("sockets" #-win32 "constants")) + (:file "name-service" :depends-on ("sockets")) (:file "misc" :depends-on ("sockets")) (:static-file "NEWS") @@ -51,3 +57,4 @@ (defmethod perform ((o test-op) (c (eql (find-system :sb-bsd-sockets-tests)))) (or (funcall (intern "DO-TESTS" (find-package "SB-RT"))) (error "test-op failed"))) + diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp index 829829a..54ac2ec 100644 --- a/contrib/sb-bsd-sockets/sockets.lisp +++ b/contrib/sb-bsd-sockets/sockets.lisp @@ -5,10 +5,6 @@ (eval-when (:load-toplevel :compile-toplevel :execute) -#+win32 -(defvar *wsa-startup-call* - (sockint::wsa-startup (sockint::make-wsa-version 2 2))) - (defclass socket () ((file-descriptor :initarg :descriptor :reader socket-file-descriptor) diff --git a/contrib/sb-bsd-sockets/win32-constants.lisp b/contrib/sb-bsd-sockets/win32-constants.lisp index e9b2596..4bf52d2 100644 --- a/contrib/sb-bsd-sockets/win32-constants.lisp +++ b/contrib/sb-bsd-sockets/win32-constants.lisp @@ -1,145 +1,234 @@ -(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 +;;; -*- Lisp -*- + +;;; This isn't really lisp, but it's definitely a source file. we +;;; name it thus to avoid having to mess with the clc lpn translations + +;;; first, the headers necessary to find definitions of everything +("winsock2.h") + +;;; then the stuff we're looking for +((:integer af-inet "AF_INET" "IP Protocol family") + (:integer af-unspec "AF_UNSPEC" "Unspecified") + (:integer sock-stream "SOCK_STREAM" + "Sequenced, reliable, connection-based byte streams.") + (:integer sock-dgram "SOCK_DGRAM" + "Connectionless, unreliable datagrams of fixed maximum length.") + (:integer sock-raw "SOCK_RAW" + "Raw protocol interface.") + (:integer sock-rdm "SOCK_RDM" + "Reliably-delivered messages.") + (:integer sock-seqpacket "SOCK_SEQPACKET" + "Sequenced, reliable, connection-based, datagrams of fixed maximum length.") + + (:integer sol-socket "SOL_SOCKET") + + ;; some of these may be linux-specific + (:integer so-debug "SO_DEBUG" + "Enable debugging in underlying protocol modules") + (:integer so-reuseaddr "SO_REUSEADDR" "Enable local address reuse") + (:integer so-type "SO_TYPE") ;get only + (:integer so-error "SO_ERROR") ;get only (also clears) + (:integer so-dontroute "SO_DONTROUTE" + "Bypass routing facilities: instead send direct to appropriate network interface for the network portion of the destination address") + (:integer so-broadcast "SO_BROADCAST" "Request permission to send broadcast datagrams") + (:integer so-sndbuf "SO_SNDBUF") + (:integer so-rcvbuf "SO_RCVBUF") + (:integer so-keepalive "SO_KEEPALIVE" + "Send periodic keepalives: if peer does not respond, we get SIGPIPE") + (:integer so-oobinline "SO_OOBINLINE" + "Put out-of-band data into the normal input queue when received") + (:integer so-linger "SO_LINGER" + "For reliable streams, pause a while on closing when unsent messages are queued") + (:integer so-sndlowat "SO_SNDLOWAT") + (:integer so-rcvlowat "SO_RCVLOWAT") + (:integer so-sndtimeo "SO_SNDTIMEO") + (:integer so-rcvtimeo "SO_RCVTIMEO") + + (:integer tcp-nodelay "TCP_NODELAY") + + (:integer HOST-NOT-FOUND "HOST_NOT_FOUND" "Authoritative Answer Host not found.") + (:integer TRY-AGAIN "TRY_AGAIN" "Non-Authoritative Host not found, or SERVERFAIL.") + (:integer NO-RECOVERY "NO_RECOVERY" "Non recoverable errors, FORMERR, REFUSED, NOTIMP.") + (:integer NO-DATA "NO_DATA" "Valid name, no data record of requested type.") + (:integer NO-ADDRESS "NO_ADDRESS" "No address, look for MX record.") + + (:integer msg-oob "MSG_OOB") + (:integer msg-peek "MSG_PEEK") + (:integer msg-dontroute "MSG_DONTROUTE") + + + (:integer EADDRINUSE "WSAEADDRINUSE") + (:integer EAGAIN "WSAEWOULDBLOCK") + (:integer EBADF "WSAEBADF") + (:integer ECONNREFUSED "WSAECONNREFUSED") + (:integer ETIMEDOUT "WSAETIMEDOUT") + (:integer EINTR "WSAEINTR") + (:integer EINVAL "WSAEINVAL") + (:integer ENOBUFS "WSAENOBUFS") + (:integer ENOMEM "WSAENOBUFS") + (:integer EOPNOTSUPP "WSAEOPNOTSUPP") + (:integer EPERM "WSAENETDOWN") + (:integer EPROTONOSUPPORT "WSAEPROTONOSUPPORT") + (:integer ESOCKTNOSUPPORT "WSAESOCKTNOSUPPORT") + (:integer ENETUNREACH "WSAENETUNREACH") + (:integer ENOTCONN "WSAENOTCONN") + (:integer inaddr-any "INADDR_ANY") + + + ;; for socket-receive + (:type socklen-t "int") + (:type size-t "size_t") + (:type ssize-t "ssize_t") + + (:structure in-addr ("struct in_addr" + ((array (unsigned 8)) addr "u_int32_t" "s_addr"))) + + (:structure sockaddr-in ("struct sockaddr_in" + (integer family "sa_family_t" "sin_family") + ;; These two could be in-port-t and + ;; in-addr-t, but then we'd throw away the + ;; convenience (and byte-order agnosticism) + ;; of the old sb-grovel scheme. + ((array (unsigned 8)) port "u_int16_t" "sin_port") + ((array (unsigned 8)) addr "struct in_addr" "sin_addr"))) + + (:structure hostent ("struct hostent" + (c-string-pointer name "char *" "h_name") + ((* c-string) aliases "char **" "h_aliases") + (integer type "int" "h_addrtype") + (integer length "int" "h_length") + ((* (* (unsigned 8))) addresses "char **" "h_addr_list"))) + + (:structure protoent ("struct protoent" + (c-string-pointer name "char *" "p_name") + ((* (* t)) aliases "char **" "p_aliases") + (integer proto "int" "p_proto"))) + + (:function getprotobyname ("getprotobyname" (* protoent) + (name c-string))) + + (:function getprotobynumber ("getprotobynumber" (* protoent) + (proto int))) + + (:function win32-bind + ("bind" int + (sockfd int) + (my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? + (addrlen socklen-t))) + + (:function win32-listen ("listen" int + (socket int) + (backlog int))) + + (:function win32-accept ("accept" int + (socket int) + (my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? + (addrlen int :in-out))) + + (:function win32-getpeername ("getpeername" int + (socket int) + (her-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? + (addrlen socklen-t :in-out))) + + (:function win32-getsockname ("getsockname" int + (socket int) + (my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? + (addrlen socklen-t :in-out))) + + (:function win32-connect ("connect" int + (socket int) + (his-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? + (addrlen socklen-t))) + + (:function win32-close ("closesocket" int + (fd int))) + + (:function win32-recvfrom ("recvfrom" ssize-t + (socket int) + (buf (* t)) + (len integer) + (flags int) + (sockaddr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? + (socklen (* socklen-t)))) + + (:function win32-recv ("recv" int + (socket int) + (buf (* t)) + (len integer) + (flags integer))) + + (:function win32-send ("send" ssize-t + (socket int) + (buf (* t)) + (len size-t) + (flags int))) + + (:function win32-sendto ("sendto" int + (socket int) + (buf (* t)) + (len size-t) + (flags int) + (sockaddr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? + (socklen socklen-t))) + + (:function gethostbyname ("gethostbyname" (* hostent) (name c-string))) + + (:function gethostbyaddr ("gethostbyaddr" (* hostent) + (addr (* t)) + (len int) + (af int))) + +;;; should be using getaddrinfo instead? + + (:function win32-setsockopt ("setsockopt" int + (socket int) + (level int) + (optname int) + (optval (* t)) + (optlen int))) ;;; should be socklen-t! + + (:function win32-getsockopt ("getsockopt" int + (socket int) + (level int) + (optname int) + (optval (* t)) + (optlen int :in-out))) ;;; should be socklen-t! + + (:function win32-ioctl ("ioctlsocket" int + (socket int) + (cmd int) + (argp (unsigned 32) :in-out))) + + +;;; Win32 specific cruft + (:function wsa-socket ("WSASocketA" int + (af int) + (type int) + (protocol int) + (lpProtocolInfo (* t)) + (g int) + (flags int))) + + (:function fd->handle ("_get_osfhandle" int + (fd int))) + + (:function handle->fd ("_open_osfhandle" int + (osfhandle int) + (flags int))) + + (:structure wsa-data ("struct WSAData" + (integer version "u_int16_t" "wVersion") + (integer high-version "u_int16_t" "wHighVersion") + (c-string description "char" "szDescription") + (c-string system-status "char" "szSystemStatus") + (integer max-sockets "unsigned short" "iMaxSockets") + (integer max-udp-dg "unsigned short" "iMaxUdpDg") + (c-string-pointer vendor-info "char *" "lpVendorInfo"))) + + (:function wsa-startup ("WSAStartup" int + (wVersionRequested (unsigned 16)) + (lpWSAData wsa-data :out))) + + (:function wsa-get-last-error ("WSAGetLastError" int)) + +) \ No newline at end of file diff --git a/contrib/sb-bsd-sockets/win32-lib.lisp b/contrib/sb-bsd-sockets/win32-lib.lisp new file mode 100644 index 0000000..41aedec --- /dev/null +++ b/contrib/sb-bsd-sockets/win32-lib.lisp @@ -0,0 +1,3 @@ +(eval-when (:compile-toplevel :load-toplevel :execute) + (sb-alien:load-shared-object "ws2_32.dll") + (sb-alien:load-shared-object "msvcrt.dll")) diff --git a/contrib/sb-bsd-sockets/win32-sockets.lisp b/contrib/sb-bsd-sockets/win32-sockets.lisp index 42d5c86..5b20df5 100644 --- a/contrib/sb-bsd-sockets/win32-sockets.lisp +++ b/contrib/sb-bsd-sockets/win32-sockets.lisp @@ -1,313 +1,89 @@ -;;;; 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 + +(defun socket (af type proto) + (let* ((handle (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 #'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* + (wsa-startup (make-wsa-version 2 2))) + +;; 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 () ()) + + diff --git a/version.lisp-expr b/version.lisp-expr index 4155dbe..639cf19 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.13.9" +"0.9.13.10" -- 1.7.10.4