1 ;;; -*- Mode:Lisp; Syntax:Common-lisp; Package: modlisp; Base:10 -*-
6 (defun make-socket-server (listener)
7 (setf (socket listener) (create-inet-listener
9 :format (listener-format listener)))
10 (setf (process listener) (make-process
12 #'(lambda () (start-socket-server listener))))
16 (defmethod initialize-instance :after
17 ((self worker) &key listener connection name &allow-other-keys)
19 (error "connection not provided to modlisp-worker"))
20 (setf (slot-value self 'listener) listener)
21 (setf (slot-value self 'name) name)
22 (setf (slot-value self 'connection) connection)
23 (setf (slot-value self 'thread-fun)
26 (if (catch-errors listener)
28 (apply (listener-function listener)
30 (function-args listener))
32 (cmsg "Error ~A [~A]" e name)))
33 (apply (listener-function listener)
35 (function-args listener)))
37 (errorset (close-active-socket connection) nil)
38 (cmsg-c :threads "~A ended" name)
39 (setf (workers listener)
40 (remove self (workers listener))))))))
42 (defun start-socket-server (listener)
45 (let ((connection (accept-tcp-connection (socket listener))))
48 (apply (listener-function listener)
50 (function-args listener))
51 (errorset (close connection) nil))
52 (let ((worker (make-instance 'worker :listener listener
53 :connection connection
54 :name (next-worker-name))))
55 (setf (process worker)
56 (make-process (name worker) (thread-fun worker)))
57 (push worker (workers listener))))))
58 (errorset (close-passive-socket (socket listener)) nil)))