Browse code

Close master socket on interrupt

Jaidyn Levesque authored on 2019-11-14 13:42:59
Showing 1 changed files
... ...
@@ -35,6 +35,7 @@
35 35
   "Macro for #'server, for handling client activity."
36 36
   `(bordeaux-threads:make-thread
37 37
      (lambda ()
38
+       (format t "activity from ~A!~%" ,con)
38 39
        (handler-case
39 40
          (process-con-activity ,con ,all-connections ,on-input)
40 41
          (t (e)
... ...
@@ -53,8 +54,9 @@
53 54
             (make-instance 'connection :socket new-socket)))
54 55
      (logger "New connection from ~A" (get-ip new-con))
55 56
      (push new-con ,all-connections)
56
-     (funcall on-connect new-con ,all-connections)))
57
-
57
+     (funcall on-connect new-con ,all-connections)
58
+     (setf (slot-value (con→socket master-con) 'usocket::state) nil)
59
+     (logger "Connection complete.")))
58 60
 
59 61
 
60 62
 ;; —————————————————————————————————————
... ...
@@ -70,12 +72,17 @@
70 72
   (let* ((master-socket (usocket:socket-listen host port :backlog 256))
71 73
          (master-con    (make-instance 'connection :socket master-socket))
72 74
          (all-connections `(,master-con)))
75
+    (handler-case
73 76
     (loop
74
-      (loop for con in (wait-for-input all-connections)
75
-            do (if (eq con master-con)
77
+      (loop :for con :in (wait-for-input all-connections)
78
+            :do (if (eq con master-con)
76 79
                  (new-connection all-connections master-con on-connect)
77
-                 (old-activity all-connections con on-input on-disconnect)))
78
-      (funcall on-loop all-connections))))
80
+                 (old-activity all-connections con on-input on-disconnect))))
81
+    (t (e)
82
+       (format t "Error: ~A~%" e)
83
+       (format t "Closing master socket…~%")
84
+       (close-it master-socket)))))
85
+;;      (funcall on-loop all-connections))))
79 86
 
80 87
 
81 88
 ;; STRING NUMBER → THREAD
... ...
@@ -103,7 +110,6 @@
103 110
 (defmethod send ((socket usocket::stream-usocket) message &rest args)
104 111
   (let ((sstream (usocket:socket-stream socket)))
105 112
     (apply 'format (append (list sstream message) args))
106
-;;    (format sstream (format nil (format nil "~A" message)))
107 113
     (force-output sstream)))
108 114
 
109 115
 ;; STREAM-SERVER-USOCKET VARYING → NIL
... ...
@@ -154,6 +160,7 @@
154 160
 (defun process-con-activity (con connection-list on-input)
155 161
   "Process client socket that got some activity"
156 162
   (let ((message (recieve con)))
163
+    (setf (slot-value (con→socket con) 'usocket::state) nil)
157 164
     (logger  "~A: ~A" (get-ip con) message)
158 165
     (funcall on-input con message connection-list)))
159 166
 
... ...
@@ -167,8 +174,9 @@
167 174
 (defmethod close-it ((con connection) &optional connection-list on-disconnect)
168 175
   (close-it (con→socket con) connection-list on-disconnect))
169 176
 
170
-;; STREAM-USOCKET LIST-OF-CONNECTIONS FUNCTION
171
-(defmethod close-it ((socket usocket:stream-usocket) &optional connection-list on-disconnect)
177
+;; USOCKET LIST-OF-CONNECTIONS FUNCTION
178
+(defmethod close-it ((socket usocket::usocket)
179
+                     &optional connection-list on-disconnect)
172 180
   (when connection-list (funcall on-disconnect socket connection-list))
173 181
   (handler-case
174 182
       (usocket:socket-close socket)
... ...
@@ -176,6 +184,13 @@
176 184
       (logger "Ignoring the error from closing connection: ~a" e)))
177 185
   (logger "Connection closed: ~A" socket))
178 186
 
187
+;; STREAM-SOCKET LIST-OF-CONNECTIONS FUNCTION → NIL
188
+(defmethod close-it :before ((socket usocket::stream-usocket)
189
+                             &optional connection-list on-disconnect)
190
+  "Executes the on-disconnect function for clients."
191
+  (when on-disconnect
192
+    (funcall on-disconnect (socket→con socket) connection-list)))
193
+
179 194
 ;; —————————————————
180 195
 
181 196
 ;; SOCKET LIST-OF-CONNECTIONS → CONNECTION
... ...
@@ -192,8 +207,9 @@
192 207
   "Basically a wrapper around #'usocket:wait-for-input, but for connections
193 208
   rather than stream-usocket objects."
194 209
   (let ((sockets (mapcar #'con→socket connections)))
195
-    (mapcar (lambda (socket) (socket→con socket connections))
196
-            (usocket:wait-for-input sockets :timeout 10 :ready-only 'T))))
210
+    (mapcar (lambda (sock)
211
+              (socket→con sock connections))
212
+            (usocket:wait-for-input sockets :ready-only t))))
197 213
 
198 214
 
199 215
 
... ...
@@ -272,7 +288,7 @@
272 288
 ;; If you can't tell, it's a simple chat server!
273 289
 
274 290
 ;; STRING NUMBER
275
-(defun ex-server (host port)
291
+(defun ex-server (&key (host "127.0.0.1") (port 1010))
276 292
   "Wrapping up the example-server for convenience."
277 293
   (server host port
278 294
           :on-connect #'ex-connect :on-disconnect #'ex-disconnect
... ...
@@ -284,10 +300,9 @@
284 300
   "Executed whenever a client connects."
285 301
   (bury con "id-number" (random 9999))
286 302
 
287
-  (send con "Welcome to facila example! ♥~%")
303
+  (send con "Welcome to faccila example! ♥~%")
288 304
   (send con "Users online now—~%")
289 305
   (mapcar (lambda (acon) (send con "~A, " (dig acon "id-number"))) con-list)
290
-  (send con "~%~%")
291 306
 
292 307
   (send con-list
293 308
         (format nil "~A just joined as ~A!~%"