+;;; -*- 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)))