Several important fixes + SOCKET-ADDRESS-IN-USE error

cl-async-repl.asd

@@ -5,4 +5,4 @@
   :description "REPL integration for CL-ASYNC."
   :depends-on (#:cl-async #:bordeaux-threads)
   :components
-  ((:file "repl")))
+  ((:file "src/repl")))

src/package.lisp

@@ -7,7 +7,7 @@
 
            #:*send-errors-to-eventcb*
            #:handle-error
-           
+
            #:bytes
 
            #:+af-inet+
@@ -121,6 +121,7 @@
            #:socket-timeout
            #:socket-refused
            #:socket-aborted
+           #:socket-address-in-use
            #:socket-accept-error
            #:socket-accept-error-listener
            #:socket-accept-error-tcp-server

src/pipe.lisp

@@ -59,7 +59,7 @@
   "Start a pipe listener on the current event loop. Returns a tcp-server class
    which can be closed with close-tcp-server"
   (socket-server 'pipe-server
-                 (namestring name) read-cb nil
+                 (namestring name) read-cb
                  :event-cb event-cb
                  :connect-cb connect-cb
                  :backlog backlog

src/socket.lisp

@@ -9,19 +9,22 @@
   (:documentation "Describes a general socket connection error."))
 
 (define-condition socket-eof (streamish-eof socket-error) ()
-  (:documentation "Passed to an event callback when a peer closes a socket connection."))
+  (:documentation "Peer closes a socket connection."))
 
 (define-condition socket-reset (socket-error) ()
-  (:documentation "Passed to an event callback when a socket connection times out."))
+  (:documentation "Connection reset."))
 
 (define-condition socket-timeout (socket-error) ()
-  (:documentation "Passed to an event callback when a socket connection times out."))
+  (:documentation "Socket connection timed out."))
 
 (define-condition socket-refused (socket-error) ()
-  (:documentation "Passed to an event callback when a socket connection is refused."))
+  (:documentation "Connection refused."))
 
 (define-condition socket-aborted (socket-error) ()
-  (:documentation "Passed to an event callback when a socket connection is aborted."))
+  (:documentation "Connection aborted."))
+
+(define-condition socket-address-in-use (socket-error) ()
+  (:documentation "Address is already in use."))
 
 ;; TBD: socket-accept-error is not actually used currently
 (define-condition socket-accept-error (socket-error)
@@ -60,6 +63,11 @@
 (defmethod errno-event ((socket socket) (errno (eql (uv:errval :econnaborted))))
   (make-instance 'socket-aborted :socket socket :code errno :msg "connection aborted"))
 
+;; applicable both to sockets and socket-servers
+(defmethod errno-event ((socket t) (errno (eql (uv:errval :eaddrinuse))))
+  (make-instance 'socket-address-in-use :socket socket :code errno
+                                        :msg "address already in use"))
+
 (defclass socket-server ()
   ((c :accessor socket-server-c :initarg :c :initform (cffi:null-pointer))
    (closed :accessor socket-server-closed :initarg :closed :initform nil)
@@ -289,8 +297,9 @@
     ;; check that our listener instantiated properly
     (when (or (< r-bind 0)
               (< r-listen 0))
-      (close-socket-server server-instance)
-      (event-handler (or r-listen r-bind) event-cb :throw t)
+      (unwind-protect
+           (event-handler (or r-listen r-bind) event-cb :throw t :streamish server-instance)
+        (close-socket-server server-instance))
       (return-from socket-server))
     ;; make sure the server is closed/freed on exit
     (add-event-loop-exit-callback (lambda ()

src/tcp.lisp

@@ -67,7 +67,7 @@
             (lambda (ip family)
               (declare (ignore family))
               (do-connect ip port))
-            event-cb
+            :event-cb event-cb
             :family +af-inet+))))
   socket/stream)
 

test/async-stream.lisp

@@ -17,8 +17,7 @@
                           (setf server-data (babel:octets-to-string data))
                           ;; for good measure, test writing to a new stream from server
                           (write-sequence (babel:string-to-octets "don't say that")
-                                          (make-instance 'as:async-io-stream :socket sock)))
-                        nil)))
+                                          (make-instance 'as:async-io-stream :socket sock))))))
           ;; launch a client, which will write its data to a stream
           (as:with-delay ()
             (let ((stream (as:tcp-connect "127.0.0.1" 31388
@@ -28,9 +27,7 @@
                                 (setf client-data (babel:octets-to-string (subseq *stream-buffer* 0 num-bytes)))
                                 (as:close-socket sock)
                                 (as:close-tcp-server server)))
-                            nil
                             :stream t)))
               (write-sequence (babel:string-to-octets "can i have your coat?") stream)))))
     (is (string= server-data "can i have your coat?"))
     (is (string= client-data "don't say that"))))
-

test/base.lisp

@@ -28,7 +28,7 @@
   (let ((err nil))
     (as:with-event-loop (:catch-app-errors (lambda (e) (setf err e)))
       (error "oh noo"))
-    (is (subtypep (type-of err) 'error))))
+    (is-true (subtypep (type-of err) 'error))))
 
 (test data-and-fn-pointers
   "Test for the correct number of data/function pointers for a set of operations"
@@ -53,4 +53,3 @@
             (setf yes-ran :omglolwtf)))
         (as:delay (lambda () nil) :time .2))
     (is (eq yes-ran :omglolwtf))))
-

test/dns.lisp

@@ -10,8 +10,8 @@
             (lambda (addr fam)
               (declare (ignore fam))
               (setf lookup addr))
-            (lambda (ev)
-              (error ev))
+            :event-cb (lambda (ev)
+                        (error ev))
             :family as:+af-inet+))
         "127.0.0.1")))
 
@@ -25,12 +25,12 @@
           (lambda (addr fam)
             (declare (ignore fam))
             (setf addr1 addr))
-          (lambda (ev) (error ev)))
+          :event-cb (lambda (ev) (error ev)))
         (as:dns-lookup "localhost"
           (lambda (addr fam)
             (declare (ignore fam))
             (setf addr2 addr))
-          (lambda (ev) (error ev))))
+          :event-cb (lambda (ev) (error ev))))
     (is (stringp dns1))
     (is (stringp dns2))))
 
@@ -43,8 +43,8 @@
           (lambda (addr fam)
             (declare (ignore fam))
             (setf ipv4 addr))
-          (lambda (ev)
-            (error ev))
+          :event-cb (lambda (ev)
+                      (error ev))
           :family as:+af-inet+))
     (is (cl-async-util::ipv4-address-p ipv4))))
 
@@ -58,8 +58,8 @@
             (lambda (addr fam)
               (declare (ignore fam))
               (setf ipv6 addr))
-            (lambda (ev)
-              (error ev))
+            :event-cb (lambda (ev)
+                        (error ev))
             :family as:+af-inet6+))
         (error (e) (format nil "(~a) ~a" (as:event-errcode e) (as:event-errmsg e))))
     (is (cl-async-util::ipv6-address-p ipv6))))
@@ -72,7 +72,7 @@
         (test-timeout 3)
         (as:dns-lookup "all your children are poor unfortunate victims of lies you believe."
           (lambda (addr fam) (list addr fam))
-          (lambda (ev)
-            (incf num-err)
-            (error ev)))))
+          :event-cb (lambda (ev)
+                      (incf num-err)
+                      (error ev)))))
     (is (= num-err 1))))

test/pipe.lisp

@@ -17,7 +17,6 @@
              (incf server-reqs)
              (setf server-data (concat server-data (babel:octets-to-string data)))
              (as:write-socket-data sock "thxlol "))
-           nil
            :connect-cb (lambda (sock)
                          (declare (ignore sock))
                          (incf connect-num)))
@@ -31,8 +30,8 @@
                                   (unless (as:socket-closed-p sock)
                                     (as:close-socket sock))
                                   (setf client-data (concat client-data (babel:octets-to-string data))))
-                                (lambda (ev)
-                                  (error ev))
+                                :event-cb (lambda (ev)
+                                            (error ev))
                                 :data "ha")))
                      (as:write-socket-data sock "i "))))
 
@@ -54,9 +53,9 @@
           (as:pipe-connect
            path
            (lambda (sock data) (declare (ignore sock data)))
-           (lambda (ev)
-             (incf num-err)
-             (error ev))
+           :event-cb (lambda (ev)
+                       (incf num-err)
+                       (error ev))
            :data "hai"
            :read-timeout 1))))
     (is (= num-err 1))))
@@ -70,12 +69,12 @@
           (let* ((server (as:pipe-server
                           path
                           (lambda (sock data) (declare (ignore sock data)))
-                          (lambda (ev) (declare (ignore ev))))))
+                          :event-cb (lambda (ev) (declare (ignore ev))))))
             (assert server () "failed to listen at port 41818")
             (as:pipe-connect
              path
              (lambda (sock data) (declare (ignore sock data)))
-             (lambda (ev) (declare (ignore ev)))
+             :event-cb (lambda (ev) (declare (ignore ev)))
              :connect-cb
              (lambda (sock)
                (as:delay
@@ -105,11 +104,11 @@
                        (setf server-data (concat server-data (babel:octets-to-string (subseq buff 0 n))))))
              (as:close-socket sock)
              (as:exit-event-loop))
-           (lambda (ev) (declare (ignore ev)))
+           :event-cb (lambda (ev) (declare (ignore ev)))
            :stream t)
           (as:pipe-connect
            path
            (lambda (sock data) (declare (ignore sock data)))
-           (lambda (ev) (declare (ignore ev)))
+           :event-cb (lambda (ev) (declare (ignore ev)))
            :data "HELLO!")))
     (is (string= server-data "HELLO!"))))

test/poll.lisp

@@ -28,7 +28,7 @@
                          (lambda (sock data)
                            (as:write-socket-data sock (concat (babel:octets-to-string data) " lol"))
                            (as:close-tcp-server server))
-                         (lambda (ev) (declare (ignore ev)))))
+                         :event-cb (lambda (ev) (declare (ignore ev)))))
           (as:delay
             (lambda ()
               (let* ((sock (usocket:socket-connect "127.0.0.1" 31311 :element-type 'octet))
@@ -49,4 +49,3 @@
                 (force-output stream)))
             :time .1)))
     (is (string= response "omg lol"))))
-

test/tcp.lisp

@@ -18,7 +18,6 @@
             (incf server-reqs)
             (setf server-data (concat server-data (babel:octets-to-string data)))
             (as:write-socket-data sock "thxlol "))
-          nil
           :connect-cb (lambda (sock)
                         (declare (ignore sock))
                         (incf connect-num)))
@@ -31,8 +30,8 @@
                           (unless (as:socket-closed-p sock)
                             (as:close-socket sock))
                           (setf client-data (concat client-data (babel:octets-to-string data))))
-                        (lambda (ev)
-                          (error ev))
+                        :event-cb (lambda (ev)
+                                    (error ev))
                         :data "ha")))
             (as:write-socket-data sock "i ")))
 
@@ -55,9 +54,9 @@
         (test-timeout 2)
         (as:tcp-connect "1.24.3.4" 9090
           (lambda (sock data) (declare (ignore sock data)))
-          (lambda (ev)
-            (incf num-err)
-            (error ev))
+          :event-cb (lambda (ev)
+                      (incf num-err)
+                      (error ev))
           :data "hai"
           :read-timeout 1))
       (as:tcp-timeout ()
@@ -74,11 +73,11 @@
         (test-timeout 3)
         (let* ((server (as:tcp-server nil 41818
                          (lambda (sock data) (declare (ignore sock data)))
-                         (lambda (ev) (declare (ignore ev))))))
+                         :event-cb (lambda (ev) (declare (ignore ev))))))
           (assert server () "failed to listen at port 41818")
           (as:tcp-connect "127.0.0.1" 41818
             (lambda (sock data) (declare (ignore sock data)))
-            (lambda (ev) (declare (ignore ev)))
+            :event-cb (lambda (ev) (declare (ignore ev)))
             :connect-cb
               (lambda (sock)
                 (as:delay
@@ -106,14 +105,29 @@
                 (setf server-data (concat server-data (babel:octets-to-string (subseq buff 0 n))))))
             (as:close-socket sock)
             (as:exit-event-loop))
-          (lambda (ev) (declare (ignore ev)))
+          :event-cb (lambda (ev) (declare (ignore ev)))
           :stream t)
         (as:tcp-connect "127.0.0.1" 41818
           (lambda (sock data) (declare (ignore sock data)))
-          (lambda (ev) (declare (ignore ev)))
+          :event-cb (lambda (ev) (declare (ignore ev)))
           :data "HELLO!"))
     (is (string= server-data "HELLO!"))))
 
+(test test-address-in-use
+  "Test SOCKET-ADDRESS-IN-USE error"
+  (multiple-value-bind (first-successful-p)
+    (async-let ((first-successful-p nil))
+      (flet ((make-server ()
+               (as:tcp-server nil 41818
+                              (lambda (sock stream) (declare (ignore sock stream)))
+                              :event-cb #'error)))
+        (let ((server (make-server)))
+          (setf first-successful-p t)
+          (signals as:socket-address-in-use
+            (make-server))
+          (as:close-tcp-server server))))
+    (is-true first-successful-p)))
+
 (test no-overlap
   "Make sure that requests/responses don't overlap."
   (multiple-value-bind (res)
@@ -130,7 +144,6 @@
                 (let ((res (make-array 500000 :initial-element (getf (as:socket-data sock) :id)
                                               :element-type 'as:octet)))
                   (as:write-socket-data sock res))))
-            nil
             :connect-cb (lambda (sock)
                           (setf (as:socket-data sock) (list :id counter :bytes 0))
                           (incf counter))))
@@ -140,7 +153,6 @@
               (lambda (sock data)
                 (declare (ignorable sock))
                 (push data (gethash x res)))
-              nil
               :data (make-array (+ as:*buffer-size* 20000)
                                 :initial-element x
                                 :element-type '(unsigned-byte 8))))))