(in-package #:cffi-net)

(defclass inet-stream (ccl::fd-character-io-stream
		       ccl::fd-binary-io-stream)
  ((fd :initarg :fd :type (integer 0))
   (peer-address :initarg :peer-address)
   (peer-port :initarg :peer-port)))

(defmethod ccl::select-stream-class ((stream inet-stream)
				     in-p out-p char-p)
  (declare (ignore stream in-p out-p char-p))
  'inet-stream)

(defun open-net (peer-host peer-port
		 &key (local-host :any) (local-port 0)
		 (protocol :tcp))
  (let ((fd (cffi-unix::socket :af-inet :sock-stream 0)))
    (inet-bind fd local-host local-port)
    (with-foreign-pointer (sockaddr (foreign-type-size 'unixint::sockaddr-in))
      (zero-sockaddr sockaddr)
      (inet-set-sockaddr sockaddr peer-host peer-port)
      (print-sockaddr sockaddr)
      (format t "connecting ~D ~S ~D~%"
	      fd
	      sockaddr
	      (foreign-type-size 'unixint::sockaddr-in))
      (format t "result ~S ~S~%"
      (cffi-unix::%connect fd sockaddr
			  (foreign-type-size 'unixint::sockaddr-in))
      unixint::errno)
      (let ((stream (ccl::make-fd-stream fd
					 :direction :io
					 :interactive nil
					 :class 'inet-stream)))
	(setf (slot-value stream 'peer-address)
	      (sockaddr-get-address sockaddr)
	      (slot-value stream 'peer-port)
	      (sockaddr-get-port sockaddr))
	stream))))

(defun open-server (&key (host :any) (port 0)
		    (max-backlog 10)
		    (reuse-address t)
		    (protocol :tcp))
  (let ((fd (cffi-unix::socket :af-inet :sock-stream 0)))
    (inet-bind fd host port)
    (cffi-unix::listen fd max-backlog)
    fd))

(defun close-server (fd)
  (when (typep fd '(integer 0))
    (cffi-unix::close fd)))

(defmacro with-server ((variable &rest options)
		       &body body)
  (let ((result (gensym "RESULT-")))
    `(let ((,variable nil)
	   ,result)
       (unwind-protect
	    (setq ,result
		  (progn (setq ,variable (open-server ,@options))
			 ,@body))
	 (when ,variable
	   (close-server ,variable))
	 ,result))))

(defun accept-connection (server)
  (with-foreign-pointer (sockaddr (foreign-type-size 'unixint::sockaddr-in))
    (with-foreign-pointer (sockaddr-size (foreign-type-size :size))
      (setf (mem-ref sockaddr-size :size)
	    (foreign-type-size 'unixint::sockaddr-in))
      (inet-set-sockaddr sockaddr)
      (let ((fd (cffi-unix::accept server sockaddr sockaddr-size)))
	(let ((stream (ccl::make-fd-stream fd
					   :direction :io
					   :interactive nil
					   :class 'inet-stream)))
	  (setf (slot-value stream 'peer-address)
		(sockaddr-get-address sockaddr)
		(slot-value stream 'peer-port)
		(sockaddr-get-port sockaddr))
	  stream)))))

(defun sockaddr-get-address (sockaddr)
  (with-foreign-slots ((unixint::address) sockaddr unixint::sockaddr-in)
    (apply #'vector
	   (loop for i below 4
	      collect (cffi:mem-aref unixint::address :uint8 i)))))

(defun sockaddr-get-port (sockaddr)
  (with-foreign-slots ((unixint::port) sockaddr unixint::sockaddr-in)
    (swab-16 unixint::port)))

(defun inet-bind (fd &optional (host :any) (port 0))
  (with-foreign-pointer (sockaddr (foreign-type-size 'unixint::sockaddr-in))
    (inet-set-sockaddr sockaddr host port)
    (cffi-unix::bind fd sockaddr
		     (cffi:foreign-type-size 'unixint::sockaddr-in))))

(defun zero-sockaddr (sockaddr)
  (dotimes (i (cffi:foreign-type-size 'unixint::sockaddr-in))
    (setf (cffi:mem-aref sockaddr :uint8 i) 0)))

(defun inet-set-sockaddr (sockaddr &optional (host :any) (port 0))
  (with-foreign-slots ((unixint::family unixint::port unixint::address)
		       sockaddr unixint::sockaddr-in)
    (setq unixint::family :af-inet
	  unixint::port (swab-16 port))
    (dotimes (i 4)
      (setf (cffi:mem-aref unixint::address :uint8 i)
	    (if (eq host :any)
		0
		(aref host i))))))

(defun print-sockaddr (sockaddr)
  (with-foreign-slots ((unixint::family unixint::port unixint::address)
		       sockaddr unixint::sockaddr-in)
    (format t "family: ~S port: ~S address: ~S~%"
	    unixint::family
	    (sockaddr-get-port sockaddr)
	    (sockaddr-get-address sockaddr))))

(defun swab-16 (in)
  (let ((result 0))
    (setf (ldb (byte 8 0) result) (ldb (byte 8 0) in)
	  (ldb (byte 8 8) result) (ldb (byte 8 8) in))
    result))