Ignore:
Timestamp:
Sep 11, 2008, 9:30:10 AM (11 years ago)
Author:
gb
Message:

Closer to working on Windows.

File:
1 edited

Legend:

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

    r10685 r10698  
    239239  "Creates and signals (via error) one of two socket error
    240240conditions, based on the state of the arguments."
     241  #+windows-target (declare (ignore nameserver-p))
    241242  (when (< errno 0)
    242243    (setq errno (- errno)))
     
    251252                           :format-control "~a (error #~d) during ~a"
    252253                           :format-arguments (list
     254                                              #+windows-target
     255                                              (%windows-error-string errno)
     256                                              #-windows-target
    253257                                              (if nameserver-p
    254258                                                (%hstrerror errno)
     
    263267                           :format-control "~a (error #~d) during socket creation in ~a"
    264268                           :format-arguments (list
     269                                              #+windows-target
     270                                              (%windows-error-string errno)
     271                                              #-windows-target
    265272                                              (if nameserver-p
    266273                                                (%hstrerror errno)
     
    11681175            (return (%get-cstring (pref res :hostent.h_name)))))))))
    11691176
    1170 #+(or darwin-target freebsd-target)
     1177#+(or darwin-target freebsd-target windows-target)
    11711178(defun c_gethostbyname (name)
    11721179  (with-cstrs ((name (string name)))
     
    13281335
    13291336
     1337#+windows-target
     1338(defun windows-connect-wait (sockfd timeout-in-milliseconds)
     1339  (if (and timeout-in-milliseconds
     1340           (< timeout-in-milliseconds 0))
     1341    (setq timeout-in-milliseconds nil))
     1342  (rlet ((writefds :fd_set)
     1343         (exceptfds :fd_set)
     1344         (tv :timeval :tv_sec 0 :tv_usec 0))
     1345    (let* ((handle (socket-handle sockfd)))
     1346      (fd-zero writefds)
     1347      (fd-zero exceptfds)
     1348      (fd-set handle writefds)
     1349      (fd-set handle exceptfds)
     1350      (when timeout-in-milliseconds
     1351        (multiple-value-bind (seconds milliseconds)
     1352            (floor timeout-in-milliseconds 1000)
     1353          (setf (pref tv :timeval.tv_sec) seconds
     1354                (pref tv :timeval.tv_usec) (* 1000 milliseconds))))
     1355      (> (#_select 1 (%null-ptr) writefds exceptfds (if timeout-in-milliseconds tv (%null-ptr))) 0))))
     1356     
     1357     
    13301358;;; If attempts to connnect are interrupted, we basically have to
    13311359;;; wait in #_select (or the equivalent).  There's a good rant
     
    13391367           (let* ((err (check-socket-error (#_connect (socket-handle sockfd) addr len))))
    13401368             (cond ((or (eql err (- #+windows-target #$WSAEINPROGRESS
    1341                                     #-windows-target #$EINPROGRESS)) (eql err (- #$EINTR)))
    1342                     (if (process-output-wait sockfd timeout-in-milliseconds)
     1369                                   
     1370                                    #-windows-target #$EINPROGRESS))
     1371                        #+windows-target (eql err (- #$WSAEWOULDBLOCK))
     1372                        (eql err (- #$EINTR)))
     1373                    (if
     1374                      #+windows-target (windows-connect-wait sockfd timeout-in-milliseconds)
     1375                      #-windows-target (process-output-wait sockfd timeout-in-milliseconds)
    13431376                      (- (int-getsockopt sockfd #$SOL_SOCKET #$SO_ERROR))
    13441377                      (- #+windows-target #$WSAETIMEDOUT #-windows-target #$ETIMEDOUT)))
     
    14151448                 (push (make-ip-interface
    14161449                        :name (%get-cstring (pref q :ifaddrs.ifa_name))
    1417                         :addr (pref addr :sockaddr_in.sin_addr.s_addr)
     1450                        :addr (ntohl (pref addr :sockaddr_in.sin_addr.s_addr))
    14181451                        :netmask (pref (pref q :ifaddrs.ifa_netmask)
    14191452                                       :sockaddr_in.sin_addr.s_addr)
     
    14811514                           (push (make-ip-interface
    14821515                                  :name name
    1483                                   :addr address
     1516                                  :addr (ntohl address)
    14841517                                  :netmask netmask
    14851518                                  :flags if-flags
Note: See TracChangeset for help on using the changeset viewer.