(in-package "PORT")

;;; ----------------------------------------------------------------------
;;; A KPML Mini-Server in Lisp that shows how a simple Lisp server
;;; using the CLOCC portable port package can support a generation
;;; server. An exmaple client server is in kpml-mini-client.lisp
;;;
;;; To use this, the port facilities must have been loaded first!
;;; (note that if you run this with Lispworks then you need the
;;;  slightly hacked version that comes with the KPML distribution)
;;; And KPML must be present for the generation!!!
;;;
;;; Code adapted from http://cl-cookbook.sourceforce.net/sockets.html
;;;
;;; To use: get KPML ready to generate and then issue
;;;         (KPML-GENERATION-SERVER <port-number>)
;;;
;;; ----------------------------------------------------------------------

   ;;; Utility...

(defun send-text-line (stream line)
  "Send a line of text to the HTTP stream, terminating it with CR+LF."
  (princ line stream)
  (princ #\Return stream)
  (princ #\Newline stream))

;;; ----------------------------------------------------------------------
;;; Generation Server
;;;
(defun KPML-GENERATION-SERVER (port)
  "Run a KPML generation server on `port'."
  (print "kpml-generation-server")
  (let ((server (open-socket-server port))
	(*closing* nil))
    (declare (special *closing*))
    (format t "> Started generation server on port ~d~%" port)
    (unwind-protect
	(loop until *closing*
	      do
	      (let ((socket (socket-accept server)))
		(unwind-protect
		    (process-generation-request 
		     socket
		     (read-generation-request socket)
		     )
		  ;; Close connection when done
		  (close socket))))
      
      ;; Close server before exiting
      (format t "~%> Serving closing down.")
      (socket-server-close server))))

(defvar *wait-nulls-limit* 10)

(defun READ-GENERATION-REQUEST (socket)
  "Read a KPML generation request from `socket'. Returns SPL
   to generate or NIL if the request is incorrect."
  (let* ((*package* (find-package "KPML"))
	 (request
	  (loop for i from 0 to *wait-nulls-limit*
		as request = (read socket nil nil)
		until (and request (consp request))
		finally (return request))))
    (if request
	;; here is the minimal protocol possibility...
	;; waiting for a change to XML...
	(case (first request)
	      (:gen
	       (rest request))
	      (:stop
	       :stop))
      (progn
	(format t "> too many nulls...~%")
	nil))))

(defun PROCESS-GENERATION-REQUEST (socket request)
  (declare (special *closing*))
  ;; Can debug by force if problems in communication ...
  ;; (print "process-generation-request")
  ;; (break)
  (format t "> Received request ~s from host ~a~%"
	  request (socket-host/port socket))
  (if (consp request)
      ;; Correct request, can generate...
      (serve-generated-result socket request)
    (if (equal request :stop)
	(setf *closing* T)
      ;; Incorrect request, return error
      (send-text-line socket "<failure/>")))
     
  ;; Make sure the client sees the output - not really
  ;; necessary since we close the socket right after this.
  (force-output socket))


(defun SERVE-GENERATED-RESULT (socket spl)
  "Write the generated results to `socket'."
  (let ((generated-result (kpml::iron-plated-xml-say spl)))

    (if generated-result
	;; Yes, write it out to the socket
	(progn
	  (format t "> Serving generated result ~a...~%" generated-result)
	  (send-text-line socket generated-result))
       
       ;; No, return error
       (format socket "<failure/>.~%"))))

;;; backward compatibility...

(defun cl-user::start-kpml-server (port-number)
  (KPML-GENERATION-SERVER port-number))
