On Mon, 24 Sep 2012 22:26:27 +0200
Juan Jose Garcia-Ripoll <[email protected]> wrote:

> On Fri, Sep 21, 2012 at 12:11 AM, Matthew Mondor
> <[email protected]>wrote:
> 
> > I noticed that functions such as WRITE-SEQUENCE will signal a condition
> > of type SIMPLE-ERROR if EPIPE is returned when writing.
> 
> 
> I just checked: it cannot be WRITE-SEQUENCE that signals the error, but the
> file operations. This definitely could be fixed. Do you have a simple
> reproducible example so that I can trace the chain of functions that
> provokes that?

Test attached
-- 
Matt
;;; 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)
------------------------------------------------------------------------------
Live Security Virtual Conference
Exclusive live event will cover all the ways today's security and 
threat landscape has changed and how IT managers can respond. Discussions 
will include endpoint security, mobile security and the latest in malware 
threats. http://www.accelacomm.com/jaw/sfrnl04242012/114/50122263/
_______________________________________________
Ecls-list mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/ecls-list

Reply via email to