tpd2 fix

;;; teepeedee2-20140713-git/src/io/posix-socket.lisp
(defmethod socket-accept ((fd integer))
  (cffi:with-foreign-object (sa 'sockaddr_in)
    (cffi:with-foreign-object (len :int)
      (setf (cffi:mem-aref len :int) (cffi:foreign-type-size '(:pointer (:struct sockaddr_in))))
      (let ((s
             (socket-io-syscall
              #. (progn
                   (if (accept4-supported)
                    `(syscall-accept4 fd sa len
                                      (logior
                                       0
                                       #-tpd2-untransformed-io +SOCK_NONBLOCK+
                                       )
                                      )
                    `(syscall-accept fd sa len)
                    )))))
        (case-= s
                (-1 nil)
                (t
;                (socket-set-tcp-nodelay s)
;                (socket-cork s)

                 #.(unless (accept4-supported)
                     #-tpd2-untransformed-io
                     `(set-fd-nonblock s))

                 (make-con
                  :socket s
                  :peer-info (sockaddr-address-bv sa))))))))



(defmethod socket-recvfrom ( (fd integer) buf)
  (cffi:with-foreign-object (sa 'sockaddr_in)
    (cffi:with-foreign-object (len :int)
      (setf (cffi:mem-aref len :int) (cffi:foreign-type-size '(:pointer (:struct sockaddr_in))))
      (with-pointer-to-vector-data (ptr buf)
        (let ((s (socket-io-syscall (syscall-recvfrom fd ptr (length buf) 0 sa len))))
          (case-= s
                  (-1 (values nil nil))
                  (0 (error 'socket-closed))
                  (t

                   (let ((sa-out (make-byte-vector (cffi:mem-aref len :int))))
                     (loop for i from 0 below (length sa-out) do
                           (setf (aref sa-out i) (cffi:mem-ref sa :unsigned-char i)))
                     (values s sa-out)))))))))


(defmethod socket-peer ((fd integer))
  (cffi:with-foreign-object (sa 'sockaddr_in)
    (cffi:with-foreign-object (len :int)
      (setf (cffi:mem-aref len :int) (cffi:foreign-type-size '(:pointer (:struct sockaddr_in))))
      (when (zerop (getpeername fd sa len))
        (sockaddr-address-string sa)))))


;;; teepeedee2-20140713-git/src/io/syscalls.lisp
(defun new-socket-helper (&key
                          port
                          address
                          socket-family
                          socket-type
                          action)
  (let ((fd (syscall-socket socket-family socket-type 0)))
    (signal-protect
     (let ((network-port (htons port)))
       (setsockopt-int fd +SOL_SOCKET+ +SO_REUSEADDR+ 1)
       (set-fd-nonblock fd)
       (with-foreign-object-and-slots ((addr port family) sa (:struct sockaddr_in))
         (setf family socket-family)
         (cffi:with-foreign-string (src address)
           (when (<= (inet_pton socket-family src
                                (cffi:foreign-slot-pointer sa '(:struct sockaddr_in) 'addr)) 0)
             (error "Internet address is not valid: ~A" address)))
         (setf port network-port)
         (funcall action fd sa (cffi:foreign-type-size '(:struct sockaddr_in))))
       fd)
     (syscall-close fd))))