* ...now using SB-GROVEL, thanks to Timothy Ritchey.
* 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.
;;; -*- 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")
(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")))
+
(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)
-(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
+;;; -*- 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
--- /dev/null
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (sb-alien:load-shared-object "ws2_32.dll")
+ (sb-alien:load-shared-object "msvcrt.dll"))
-;;;; 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
+;;;; 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 () ())
+
+
;;; 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"
projects / sbcl.git / commitdiff