(defclass worker (fixed-worker)
((connection :initarg :connection :accessor connection :initform nil)
+ (socket :initarg :socket :accessor socket :initform nil)
(thread-fun :initarg :thread-fun :accessor thread-fun :initform nil)))
(defun listener-shutdown (listener)
(dolist (worker (workers listener))
(when (and (typep worker 'worker)
- (connection worker))
+ (socket worker))
(errorset (close-active-socket
- (connection worker)) nil)
- (setf (connection worker) nil))
+ (socket worker)) nil)
+ (setf (connection worker) nil)
+ (setf (socket worker) nil))
(when (process worker)
(errorset (destroy-process (process worker)) nil)
(setf (process worker) nil)))
(defmethod initialize-instance :after
- ((self worker) &key listener connection name &allow-other-keys)
+ ((self worker) &key listener connection socket name &allow-other-keys)
(flet ((do-work ()
(apply (listener-function listener)
connection
(function-args listener))))
(unless connection
(error "connection not provided to modlisp-worker"))
+ (unless socket
+ (error "socket not provided to modlisp-worker"))
(setf (slot-value self 'listener) listener)
(setf (slot-value self 'name) name)
(setf (slot-value self 'connection) connection)
+ (setf (slot-value self 'socket) socket)
(setf (slot-value self 'thread-fun)
#'(lambda ()
(unwind-protect
(do-work)))
(progn
(errorset (finish-output connection) nil)
- (errorset (close-active-socket connection) nil)
+ (errorset (close-active-socket socket) t)
(cmsg-c :threads "~A ended" name)
(setf (workers listener)
(remove self (workers listener)))))))))
(not (funcall (remote-host-checker listener)
(remote-host socket))))
(cmsg-c :thread "Deny connection from ~A" (remote-host conn))
- (errorset (close-active-socket conn) nil)
- (setq conn nil))
- conn))
+ (errorset (close-active-socket socket) nil)
+ (setq conn nil socket nil))
+ (values conn socket)))
(defun start-socket-server (listener)
(unwind-protect
(loop
- (let ((connection (accept-and-check-tcp-connection listener)))
+ (multiple-value-bind (connection socket)
+ (accept-and-check-tcp-connection listener)
(when connection
(if (wait listener)
(unwind-protect
(errorset (close-active-socket connection) nil)))
(let ((worker (make-instance 'worker :listener listener
:connection connection
+ :socket socket
:name (next-worker-name
(base-name listener)))))
(setf (process worker)