Changeset 10685


Ignore:
Timestamp:
Sep 10, 2008, 4:13:04 AM (11 years ago)
Author:
gb
Message:

Lots of conditionalization for windows.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-sockets.lisp

    r10574 r10685  
    181181
    182182(defvar *socket-error-identifiers*
     183  #-windows-target
    183184  (list #$EADDRINUSE :address-in-use
    184185        #$ECONNABORTED :connection-aborted
     
    197198        #$ESHUTDOWN :shutdown
    198199        #$EACCES :access-denied
    199         #$EPERM :access-denied))
     200        #$EPERM :access-denied)
     201  #+windows-target
     202  (list #$WSAEADDRINUSE :address-in-use
     203        #$WSAECONNABORTED :connection-aborted
     204        #$WSAENOBUFS :no-buffer-space
     205        #$ENOMEM :no-buffer-space
     206        #$ENFILE :no-buffer-space
     207        #$WSAETIMEDOUT :connection-timed-out
     208        #$WSAECONNREFUSED :connection-refused
     209        #$WSAENETUNREACH :host-unreachable
     210        #$WSAEHOSTUNREACH :host-unreachable
     211        #$WSAEHOSTDOWN :host-down
     212        #$WSAENETDOWN :network-down
     213        #$WSAEADDRNOTAVAIL :address-not-available
     214        #$WSAENETRESET :network-reset
     215        #$WSAECONNRESET :connection-reset
     216        #$WSAESHUTDOWN :shutdown
     217        #$EACCES :access-denied
     218        #$EPERM :access-denied)
     219  )
    200220
    201221
     
    206226    res))
    207227
     228#-windows-target
    208229(defun %hstrerror (h_errno)
    209230  (with-macptrs ((p (#_hstrerror (abs h_errno))))
     
    446467               (ecase type
    447468                 (:host (ntohl (pref sockaddr
    448                                      #-solaris-target :sockaddr_in.sin_addr.s_addr
    449                                      #+solaris-target #>sockaddr_in.sin_addr.S_un.S_addr)))
     469                                     #-(or solaris-target windows-target) :sockaddr_in.sin_addr.s_addr
     470                                     #+(or solaris-target windows-target) #>sockaddr_in.sin_addr.S_un.S_addr)))
    450471                 (:port (ntohs (pref sockaddr :sockaddr_in.sin_port))))))))
    451472
     473#-windows-target
    452474(defun path-from-unix-address (addr)
    453475  (when (= #$AF_UNIX (pref addr :sockaddr_un.sun_family))
     
    458480    (%get-cstring (pref addr :sockaddr_un.sun_path))))
    459481
     482#-windows-target
    460483(defun local-socket-filename (fd socket)
    461484  (and fd
     
    478501          (setf (pref namelen :signed) (record-length :sockaddr_in))
    479502          (let ((err (c_getpeername fd sockaddr namelen)))
    480             (cond ((eql err (- #$ENOTCONN)) nil)
     503            (cond ((eql err (- #+windows-target #$WSAENOTCONN #-windows-target #$ENOTCONN)) nil)
    481504                  ((< err 0) (socket-error socket "getpeername" err))
    482505                  (t
     
    484507                     (ecase type
    485508                       (:host (ntohl (pref sockaddr
    486                                            #-solaris-target :sockaddr_in.sin_addr.s_addr
    487                                            #+solaris-target #>sockaddr_in.sin_addr.S_un.S_addr)))
     509                                           #-(or solaris-target windows-target) :sockaddr_in.sin_addr.s_addr
     510                                           #+(or solaris-target windows-target) #>sockaddr_in.sin_addr.S_un.S_addr)))
    488511                       (:port (ntohs  (pref sockaddr :sockaddr_in.sin_port)))))))))))
    489512
     513#-windows-target
    490514(defun remote-socket-filename (socket)
    491515  (with-if (fd (socket-device socket))
     
    533557  (remote-socket-filename socket))
    534558 
     559(defun set-socket-fd-blocking (fd block-flag)
     560  #+windows-target
     561  (let* ((handle (socket-handle fd)))
     562    (rlet ((argp :u_long (if block-flag 0 1)))
     563      (#_ioctlsocket handle #$FIONBIO argp)))
     564  #-windows-target
     565  (if block-flag
     566    (fd-clear-flag fd #$O_NONBLOCK)
     567    (fd-set-flag fd #$O_NONBLOCK)))
     568
     569(defun get-socket-fd-blocking (fd)
     570  "returns T iff socket is in blocking mode"
     571  #+windows-target (declare (ignore fd))
     572  #+windows-target t
     573  #-windows-target
     574  (not (logtest #$O_NONBLOCK (fd-get-flags fd))))
     575
    535576(defun set-socket-options (fd-or-socket &key
    536577                           keepalive
     
    586627                       (pref sockaddr :sockaddr_in.sin_port) port-n
    587628                       (pref sockaddr
    588                              #-solaris-target :sockaddr_in.sin_addr.s_addr
    589                              #+solaris-target #>sockaddr_in.sin_addr.S_un.S_addr
     629                             #-(or solaris-target windows-target) :sockaddr_in.sin_addr.s_addr
     630                             #+(or solaris-target windows-target) #>sockaddr_in.sin_addr.S_un.S_addr
    590631                             ) host-n)
    591632                 (socket-call socket "bind" (c_bind fd sockaddr (record-length :sockaddr_in)))))))
     
    593634               (eq connect :passive)
    594635               local-filename)
    595       (bind-unix-socket fd local-filename))   
    596     (when (and nil *multiprocessing-socket-io*)
    597       (socket-call socket "fcntl" (fd-set-flag fd #$O_NONBLOCK)))))
     636      (bind-unix-socket fd local-filename))))
    598637
    599638;; I hope the inline declaration makes the &rest/apply's go away...
     
    688727          (pref sockaddr :sockaddr_in.sin_port) port-n
    689728          (pref sockaddr
    690                 #-solaris-target :sockaddr_in.sin_addr.s_addr
    691                 #+solaris-target #>sockaddr_in.sin_addr.S_un.S_addr
     729                #-(or solaris-target windows-target) :sockaddr_in.sin_addr.s_addr
     730                #+(or solaris-target windows-target) #>sockaddr_in.sin_addr.S_un.S_addr
    692731                ) host-n)
    693732    (%socket-connect fd sockaddr (record-length :sockaddr_in) timeout-in-milliseconds)))
    694                
     733
     734#-windows-target
    695735(defun file-socket-connect (fd remote-filename)
    696736  (rletz ((sockaddr :sockaddr_un))
     
    800840                 :keys keys))
    801841
    802 (defun socket-accept (fd wait socket)
     842(defun socket-accept (fd wait)
    803843  (flet ((_accept (fd async)
    804844           (let ((res (c_accept fd (%null-ptr) (%null-ptr))))
     
    807847             ;; man accept(2). This is my best guess at what they mean...
    808848             (if (and async (< res 0)
     849                      #+windows-target
     850                      (= res #$WSAEWOULDBLOCK)
     851                      #-windows-target
    809852                      (or (eql res (- #$ENETDOWN))
    810853                          (eql res (- #+linux-target #$EPROTO
     
    825868            (_accept fd t))
    826869          (t
    827             (let ((old (socket-call socket "fcntl" (fd-get-flags fd))))
     870            (let ((was-blocking (get-socket-fd-blocking fd)))
    828871              (unwind-protect
    829872                  (progn
    830                     (socket-call socket "fcntl" (fd-set-flags fd (logior old #$O_NONBLOCK)))
     873                    (set-socket-fd-blocking fd nil)
    831874                    (_accept fd t))
    832                 (socket-call socket "fcntl" (fd-set-flags fd old))))))))
     875                (set-socket-fd-blocking fd was-blocking)))))))
    833876
    834877(defun accept-socket-connection (socket wait stream-create-function)
     
    837880    (unwind-protect
    838881      (progn
    839         (setq fd (socket-accept listen-fd wait socket))
     882        (setq fd (socket-accept listen-fd wait))
    840883        (cond ((>= fd 0)
    841884               (prog1 (apply stream-create-function fd (socket-keys socket))
     
    897940      (setf (pref sockaddr :sockaddr_in.sin_family) #$AF_INET)
    898941      (setf (pref sockaddr
    899                   #-solaris-target :sockaddr_in.sin_addr.s_addr
    900                   #+solaris-target #>sockaddr_in.sin_addr.S_un.S_addr)
     942                  #-(or solaris-target windows-target) :sockaddr_in.sin_addr.s_addr
     943                  #+(or solaris-target windows-target) #>sockaddr_in.sin_addr.S_un.S_addr)
    901944            (if remote-host (host-as-inet-host remote-host) #$INADDR_ANY))
    902945      (setf (pref sockaddr :sockaddr_in.sin_port)
     
    926969      (setf (pref sockaddr :sockaddr_in.sin_family) #$AF_INET)
    927970      (setf (pref sockaddr
    928                   #-solaris-target :sockaddr_in.sin_addr.s_addr
    929                   #+solaris-target #>sockaddr_in.sin_addr.S_un.S_addr)
     971                  #-(or solaris-target windows-target) :sockaddr_in.sin_addr.s_addr
     972                  #+(or solaris-target windows-target) #>sockaddr_in.sin_addr.S_un.S_addr)
    930973            #$INADDR_ANY)
    931974      (setf (pref sockaddr :sockaddr_in.sin_port) 0)
     
    953996              ret-size
    954997              (ntohl (pref sockaddr
    955                            #-solaris-target :sockaddr_in.sin_addr.s_addr
    956                            #+solaris-target #>sockaddr_in.sin_addr.S_un.S_addr))
     998                           #-(or solaris-target windows-target) :sockaddr_in.sin_addr.s_addr
     999                           #+(or solaris-target windows-target) #>sockaddr_in.sin_addr.S_un.S_addr))
    9571000              (ntohs (pref sockaddr :sockaddr_in.sin_port))))))
    9581001
     
    12061249(defun _inet_aton (string)
    12071250  (with-cstrs ((name string))
     1251    #-windows-target
    12081252    (rlet ((addr :in_addr))
    12091253      (let* ((result #+freebsd-target (#___inet_aton name addr)
     
    12131257                #-solaris-target :in_addr.s_addr
    12141258                #+solaris-target #>in_addr.S_un.S_addr
    1215                 ))))))
     1259                ))))
     1260    #+windows-target
     1261    (rlet ((addr :sockaddr_in)
     1262           (addrlenp :int (record-length :sockaddr_in)))
     1263      (setf (pref addr :sockaddr_in.sin_family) #$AF_INET)
     1264      (when (zerop (#_WSAStringToAddressA name #$AF_INET (%null-ptr)  addr addrlenp))
     1265        (pref addr #>sockaddr_in.sin_addr.S_un.S_addr)))))
    12161266
    12171267(defun c_socket_1 (domain type protocol)
     
    12391289     
    12401290
     1291#-windows-target
    12411292(defun init-unix-sockaddr (addr path)
    12421293  (macrolet ((sockaddr_un-path-len ()
     
    12591310                    code))))))))
    12601311
     1312#-windows-target
    12611313(defun bind-unix-socket (socketfd path)
    12621314  (rletz ((addr :sockaddr_un))
     
    12811333;;; <http://www.madore.org/~david/computers/connect-intr.html>
    12821334(defun c_connect (sockfd addr len &optional timeout-in-milliseconds)
    1283   (let* ((flags (fd-get-flags sockfd)))
     1335  (let* ((was-blocking (get-socket-fd-blocking sockfd)))
    12841336    (unwind-protect
    12851337         (progn
    1286            (fd-set-flags sockfd (logior flags #$O_NONBLOCK))
     1338           (set-socket-fd-blocking sockfd nil)
    12871339           (let* ((err (check-socket-error (#_connect (socket-handle sockfd) addr len))))
    1288              (cond ((or (eql err (- #$EINPROGRESS)) (eql err (- #$EINTR)))
     1340             (cond ((or (eql err (- #+windows-target #$WSAEINPROGRESS
     1341                                    #-windows-target #$EINPROGRESS)) (eql err (- #$EINTR)))
    12891342                    (if (process-output-wait sockfd timeout-in-milliseconds)
    12901343                      (- (int-getsockopt sockfd #$SOL_SOCKET #$SO_ERROR))
    1291                       (- #$ETIMEDOUT)))
     1344                      (- #+windows-target #$WSAETIMEDOUT #-windows-target #$ETIMEDOUT)))
    12921345                   (t err))))
    1293       (fd-set-flags sockfd flags))))
     1346      (set-socket-fd-blocking sockfd was-blocking))))
    12941347
    12951348(defun c_listen (sockfd backlog)
     
    13061359  (check-socket-error (#_getpeername (socket-handle sockfd) addrp addrlenp)))
    13071360
     1361#-windows-target
    13081362(defun c_socketpair (domain type protocol socketsptr)
    13091363  (check-socket-error (#_socketpair domain type protocol socketsptr)))
     
    13251379  (check-socket-error (#_getsockopt (socket-handle sockfd) level optname optvalp optlenp)))
    13261380
     1381#-windows-target
    13271382(defun c_sendmsg (sockfd msghdrp flags)
    13281383  (check-socket-error (#_sendmsg (socket-handle sockfd) msghdrp flags)))
    13291384
     1385#-windows-target
    13301386(defun c_recvmsg (sockfd msghdrp flags)
    13311387  (check-socket-error   (#_recvmsg (socket-handle sockfd) msghdrp flags)))
     
    13461402    (format t " ~2,'0x" (%get-byte p i))))
    13471403
    1348 #-solaris-target
     1404#-(or windows-target solaris-target)
    13491405(defun %get-ip-interfaces ()
    13501406  (rlet ((p :address (%null-ptr)))
Note: See TracChangeset for help on using the changeset viewer.