;;; -*- Mode:Lisp; Syntax:Common-lisp; Package: modlisp; Base:10 -*-

(in-package #:modlisp)


(defun make-socket-server (listener)
  (setf (socket listener) (create-inet-listener
			   (port listener)
			   :format (listener-format listener)))
  (setf (process listener) (make-process
			    (name listener)
			    #'(lambda () (start-socket-server listener))))
  listener)


(defmethod initialize-instance :after
    ((self worker) &key listener connection name &allow-other-keys)
  (unless connection
    (error "connection 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 'thread-fun)
	#'(lambda ()
	    (unwind-protect
		 (handler-case
		     (apply (listener-function listener)
			    connection
			    (function-args listener))
		   (error (e)
		     (cmsg "Error ~A [~A]" e name)
		     (error e)
		     ))
	  (progn
	    (errorset (close-active-socket connection) nil)
	    (cmsg-c :threads "~A ended" name)
	    (setf (workers listener)
		  (remove self (workers listener))))))))

(defun start-socket-server (listener)
  (unwind-protect
      (loop 
       (let ((connection (accept-tcp-connection (socket listener))))
	 (if (wait listener)
	     (unwind-protect
		  (apply (listener-function listener)
			 connection
			 (function-args listener))
	       (errorset (close connection) nil))
	     (let ((worker (make-instance 'worker :listener listener
					  :connection connection
					  :name (next-worker-name))))
	      (setf (process worker)
		(make-process (name worker) (thread-fun worker)))
	      (push worker (workers listener))))))
    (errorset (close-passive-socket (socket listener)) nil)))