;;; Test to demonstrate EPIPE signaled as a condition of type SIMPLE-ERROR

(declaim (optimize (speed 3) (safety 1) (debug 3)))

(eval-when (:compile-toplevel :load-toplevel)
  (require :sb-bsd-sockets))

(defpackage :epipe-test
  (:use :cl :sb-bsd-sockets)
  (:export #:do-test))

(in-package :epipe-test)


(defun bind-socket ()
  (ext:catch-signal ext:+sigpipe+ :ignore)
  (let ((server-socket (make-instance 'inet-socket
				      :type :stream
				      :protocol :tcp)))
    (socket-bind server-socket (make-inet-address "127.0.0.1") 8888)
    (socket-listen server-socket 1)
    server-socket))

(defvar *server-socket* (bind-socket))


(defmacro with-socket ((socket) &body body)
  (let ((s-socket (gensym)))
    `(let ((,s-socket ,socket))
       (unwind-protect
	    (progn
	      (setf (sockopt-keep-alive ,s-socket) t
		    (sockopt-linger ,s-socket) 0
		    (sockopt-tcp-nodelay ,s-socket) t)
	      ,@body)
	 (ignore-errors
	   (socket-close ,s-socket))))))

(defmacro with-create-stream ((socket stream) &body body)
  (let ((s-socket (gensym))
	(s-stream (gensym)))
    `(let* ((,s-socket ,socket)
	    (,s-stream (socket-make-stream ,s-socket
					   :input t
					   :output t
					   :buffering :full
					   :external-format :latin-1))
	    (,stream ,s-stream))
       (unwind-protect
	    (progn
	      ,@body)
	 (ignore-errors
	   (close ,s-stream))))))

(defun accept (socket)
  (loop
     do
       (handler-case
	   (multiple-value-bind (s a p)
	       (socket-accept socket)
	     (return (values s a p)))
	 (sb-bsd-sockets:interrupted-error ()
	   nil))))

(defvar *crlf* (concatenate 'string '(#\Return #\LineFeed)))

(defun accept-loop-thread ()
  (loop
     do
       (multiple-value-bind (socket address port)
	   (accept *server-socket*)
	 (declare (ignore address port))
	 (with-socket (socket)
	   (with-create-stream (socket stream)
	     (loop
		repeat 5
		do
		  (format stream "Writing some data~A" *crlf*)
		  (finish-output stream)
		  (sleep 1)))))))

(defvar *accept-thread* (mp:process-run-function 'accept-thread
						 #'accept-loop-thread))


(defun do-test ()
  "Connect to our server socket and disconnect before it has the opportunity
to write all its data."
  (let ((socket (make-instance 'inet-socket
			       :type :stream
			       :protocol :tcp)))
    (socket-connect socket (make-inet-address "127.0.0.1") 8888)
    (with-socket (socket)
      (format t "Connected, disconnect immediately~%"))))

(do-test)
