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

(in-package #:modlisp)


(defun make-socket-server (name function port listener 
			   &key wait (format :text) function-args)
  (let* ((passive-socket (create-inet-listener port :format format))
	 (proc (make-process name
			     #'(lambda ()
				 (start-socket-server
				  passive-socket function listener
				  :wait wait 
				  :function-args function-args)))))
    (values proc passive-socket)))


(defmethod initialize-instance :after
	   ((self worker) &key listener socket func name function-args
	    &allow-other-keys)
  (unless socket
    (error "socket not provided to modlisp-worker"))
  (setf (slot-value self 'listener) listener)
  (setf (slot-value self 'func) func)
  (setf (slot-value self 'function-args) function-args)
  (setf (slot-value self 'thread-fun)
    #'(lambda ()
	(unwind-protect
	    (handler-case
		(apply #'apache-command-issuer socket func function-args)
	      (error (e)
		(cmsg "Error ~A [~A]" e name)
		;;(error e)
		))
	  (progn
	    (errorset (close-active-socket socket) nil)
	    (cmsg-c :threads "~A ended" name)
	    (setf (workers listener)
	      (remove self (workers listener))))))))

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