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

(in-package #:modlisp)

(eval-when (compile load eval)
  (require :socket))

(defun make-socket-server (name function port &key wait (format :text))
  (let* ((listener (socket:make-socket
		    :connect :passive
		    :local-port port
		    :address-family 
		    (if (stringp port)
			:file
			(if (or (null port) (integerp port))
			    :internet
			    (error "illegal value for port: ~s" port)))
		    :format format))
	 (proc (mp::process-run-function name 
		 #'(lambda ()
		     (start-socket-server listener function
					  :wait wait)))))
    (values proc listener)))

(defun worker-process (stream function conn count)
  (unwind-protect
    #+ignore
    (funcall function conn)

    (excl:errorset (close conn) nil)))

(defun start-socket-server (passive-socket function &key wait)
  ;; internal function run in the server lightweight process 
  ;; that continually processes the connection.
  ;; This code is careful to ensure that the sockets are 
  ;; properly closed something abnormal happens.
  (unwind-protect
      (loop (let ((connection (socket:accept-connection passive-socket)))
	      (if wait
		  (unwind-protect
		      (funcall connection function)
		    (excl:errorset (close connection) nil))
		(let ((f function)
		      (c connection)
		      (name (next-worker-name))
		  (mp:process-run-function
		   name
		    #'(lambda ()
			(unwind-protect
			     (apache-command-issuer connection function)
			  #+ignore
			  (handler-case
			      (apache-command-issuer function connection)
			    (error (e)
			      #+ignore
			      (format t "~&Error ~A [~A]~%" e name))
			    (:no-error ()
			      #+ignore
			      (format t "~&~A ended" name)))
			    (excl:errorset (close connection) nil)))
		      )))))
    (ignore-errors (close passive-socket))))