Changeset 8265


Ignore:
Timestamp:
Jan 25, 2008, 7:49:29 AM (12 years ago)
Author:
gb
Message:

More socket-timeout stuff, still not complete/tested.

File:
1 edited

Legend:

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

    r8240 r8265  
    674674      (fd-close fd))))
    675675
    676 (defun %socket-connect (fd addr addrlen)
    677   (let* ((err (c_connect fd addr addrlen)))
     676(defun %socket-connect (fd addr addrlen &optional timeout)
     677  (let* ((err (c_connect fd addr addrlen timeout)))
    678678    (declare (fixnum err))
    679     (when (eql err (- #$EINPROGRESS))
    680       (process-output-wait fd)
    681       (setq err (- (int-getsockopt fd #$SOL_SOCKET #$SO_ERROR))))
    682679    (unless (eql err 0) (socket-error nil "connect" err))))
    683680   
     
    992989
    993990(defun timeval-setsockopt (socket level optname timeout)
    994     (multiple-value-bind (seconds millis)
    995         (milliseconds timeout)
    996       (rlet ((valptr :timeval :tv_sec seconds :tv_usec millis))
     991    (multiple-value-bind (seconds micros)
     992        (microseconds timeout)
     993      (rlet ((valptr :timeval :tv_sec seconds :tv_usec micros))
    997994        (socket-call socket "setsockopt"
    998995          (c_setsockopt socket level optname valptr (record-length :timeval))))))
     
    10771074    (rlet ((hostent :hostent)
    10781075           (hp (* (struct :hostent)))
    1079            (herr :signed))
     1076           (herr :signed 0))
    10801077       (do* ((buflen 1024 (+ buflen buflen))) ()
    10811078         (declare (fixnum buflen))
     
    10851082             (unless (eql res #$ERANGE)
    10861083               (return
    1087                  (if (eql res 0)
     1084                 (let* ((err (pref herr :signed)))
     1085                 (if (and (eql res 0) (eql err 0))
    10881086                   (%get-unsigned-long
    10891087                    (%get-ptr (pref (%get-ptr hp) :hostent.h_addr_list)))
    1090                    (values nil (- (pref herr :signed))))))))))))
     1088                   (values nil (- err))))))))))))
    10911089
    10921090(defun _getservbyname (name proto)
     
    12031201      (syscall syscalls::socketcall 2 params))))
    12041202
    1205 (defun c_connect (sockfd addr len)
    1206   #+(or darwin-target linuxx8664-target freebsd-target)
    1207   (syscall syscalls::connect sockfd addr len)
    1208   #+linuxppc-target
    1209   (progn
    1210     #+ppc32-target
    1211     (%stack-block ((params 12))
    1212       (setf (%get-long params 0) sockfd
    1213             (%get-ptr params 4) addr
    1214             (%get-long params 8) len)
    1215       (syscall syscalls::socketcall 3 params))
    1216     #+ppc64-target
    1217     (%stack-block ((params 24))
    1218       (setf (%%get-unsigned-longlong params 0) sockfd
    1219             (%get-ptr params 8) addr
    1220             (%%get-unsigned-longlong params 16) len)
    1221       (syscall syscalls::socketcall 3 params))))
     1203
     1204;;; If attempts to connnect are interrupted, we basically have to
     1205;;; wait in #_select (or the equivalent).  There's a good rant
     1206;;; about these issues in:
     1207;;; <http://www.madore.org/~david/computers/connect-intr.html>
     1208(defun c_connect (sockfd addr len &optional timeout)
     1209  (let* ((err
     1210          #+(or darwin-target linuxx8664-target freebsd-target)
     1211          (syscall syscalls::connect sockfd addr len)
     1212          #+linuxppc-target
     1213          (progn
     1214            #+ppc32-target
     1215            (%stack-block ((params 12))
     1216              (setf (%get-long params 0) sockfd
     1217                    (%get-ptr params 4) addr
     1218                    (%get-long params 8) len)
     1219              (syscall syscalls::socketcall 3 params))
     1220            #+ppc64-target
     1221            (%stack-block ((params 24))
     1222              (setf (%%get-unsigned-longlong params 0) sockfd
     1223                    (%get-ptr params 8) addr
     1224                    (%%get-unsigned-longlong params 16) len)
     1225              (syscall syscalls::socketcall 3 params)))))
     1226    (cond ((or (eql err (- #$EINPROGRESS)) (eql err (- #$EINTR)))
     1227           (if (process-output-wait fd timeout)
     1228             (- (int-getsockopt fd #$SOL_SOCKET #$SO_ERROR))
     1229             (- #$ETIMEDOUT)))
     1230          (t err))))
    12221231
    12231232(defun c_listen (sockfd backlog)
     
    12381247
    12391248(defun c_accept (sockfd addrp addrlenp)
    1240   #+(or darwin-target linuxx8664-target freebsd-target)
    1241   (syscall syscalls::accept sockfd addrp addrlenp)
    1242   #+linuxppc-target
    1243   (progn
    1244     #+ppc32-target
    1245     (%stack-block ((params 12))
    1246       (setf (%get-long params 0) sockfd
    1247             (%get-ptr params 4) addrp
    1248             (%get-ptr params 8) addrlenp)
    1249       (syscall syscalls::socketcall 5 params))
    1250     #+ppc64-target
    1251     (%stack-block ((params 24))
    1252       (setf (%%get-unsigned-longlong params 0) sockfd
    1253             (%get-ptr params 8) addrp
    1254             (%get-ptr params 16) addrlenp)
    1255       (syscall syscalls::socketcall 5 params))))
     1249  (ignoring-eintr
     1250   #+(or darwin-target linuxx8664-target freebsd-target)
     1251   (syscall syscalls::accept sockfd addrp addrlenp)
     1252   #+linuxppc-target
     1253   (progn
     1254     #+ppc32-target
     1255     (%stack-block ((params 12))
     1256       (setf (%get-long params 0) sockfd
     1257             (%get-ptr params 4) addrp
     1258             (%get-ptr params 8) addrlenp)
     1259       (syscall syscalls::socketcall 5 params))
     1260     #+ppc64-target
     1261     (%stack-block ((params 24))
     1262       (setf (%%get-unsigned-longlong params 0) sockfd
     1263             (%get-ptr params 8) addrp
     1264             (%get-ptr params 16) addrlenp)
     1265       (syscall syscalls::socketcall 5 params)))))
    12561266
    12571267(defun c_getsockname (sockfd addrp addrlenp)
Note: See TracChangeset for help on using the changeset viewer.