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)
27 (apply (listener-function listener)
29 (function-args listener))
31 (cmsg "Error ~A [~A]" e name)
35 (errorset (close-active-socket connection) nil)
36 (cmsg-c :threads "~A ended" name)
37 (setf (workers listener)
38 (remove self (workers listener))))))))
40 (defun start-socket-server (listener)
43 (let ((connection (accept-tcp-connection (socket listener))))
46 (apply (listener-function listener)
48 (function-args listener))
49 (errorset (close connection) nil))
50 (let ((worker (make-instance 'worker :listener listener
51 :connection connection
52 :name (next-worker-name))))
53 (setf (process worker)
54 (make-process (name worker) (thread-fun worker)))
55 (push worker (workers listener))))))
56 (errorset (close-passive-socket (socket listener)) nil)))