;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This file is part of "NOVA":  NOVA = search + COCOMO tools
; Copyright, 2008, Tim Menzies tim@menzies.us
;
; NOVA is free software: you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; NOVA is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
; You should have received a copy of the GNU General Public License
; a long with NOVA.  If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :nova-web.xml)

(defvar *nova-server* nil)

(defmacro nova-server-log (control-string &rest args)
  `(progn 
     (format t "~&SERVER-LOG: ~a"
             (format nil ,control-string ,@args))
     (force-output)))

(defun nova-socket2output-nova-stream (nova-socket)
  (sb-bsd-sockets:socket-make-stream nova-socket :input nil :output t :element-type '(unsigned-byte 8)))

(defun read-nova-header (socket)
  (let ((buffer (make-array 1 :element-type '(unsigned-byte 8)))
        (key-buffer (make-array 1024 :element-type '(unsigned-byte 8) :fill-pointer 0 :adjustable t))
        (value-buffer (make-array 1024 :element-type '(unsigned-byte 8) :fill-pointer 0 :adjustable t)))
    ;;read key
    (do (finished
         (pos 0 (1+ pos))
         (delimiter (flexi-streams:string-to-octets ":")))
        (finished)
      (sb-bsd-sockets:socket-receive socket buffer 1)
      (if (equalp delimiter buffer)
          (setf finished t)
          (vector-push (aref buffer 0) key-buffer)))
    ;;read value
    (do (finished
         found-cr
         (pos 0 (1+ pos))         
         (cr (flexi-streams:string-to-octets (coerce (list #\return) 'string)))
         (nl (flexi-streams:string-to-octets (coerce (list #\newline) 'string))))
        (finished)
      (sb-bsd-sockets:socket-receive socket buffer 1)
      (cond (found-cr (if (equalp nl buffer)
                          (setf finished t)
                          (error "found CR not proceeded with NL")))
            ((equalp cr buffer) (setf found-cr t))
            (t (vector-push (aref buffer 0) value-buffer))))
    (list (flexi-streams:octets-to-string key-buffer)
          (flexi-streams:octets-to-string value-buffer))))

(defun nova-socket2input-nova-stream (nova-socket)
  (labels ((length-header-p (header)
             (equalp "length" (first header)))
           (extract-length (header)
             (parse-integer (second header))))
    (let ((header (read-nova-header nova-socket)))      
      (unless (length-header-p header)
        (error "length-header not found: ~a" header))        
      (let* ((length (extract-length header))
             (buffer (make-array (list length) :element-type '(unsigned-byte 8))))
        (sb-bsd-sockets:socket-receive nova-socket buffer length)
        (flexi-streams:make-in-memory-input-stream buffer)))))

(defun start-nova-server (&key (port 9000))
  (if *nova-server*
      (progn
        (nova-server-log "server already running")
        nil)
      (progn
        (setf *nova-server* (tcp-server :interface "127.0.0.1" :port port))
        (nova-server-log "server started")
        (loop
           (let ((nova-socket (tcp-accept *nova-server*)))
             (if nova-socket
                 (progn
                   (nova-server-log "server has connection")
                   (handler-case
                       (with-open-stream (output-nova-stream (nova-socket2output-nova-stream nova-socket))
                         (with-open-stream (input-nova-stream (nova-socket2input-nova-stream nova-socket))
                           (nova-web.xml:nova-xml-interface input-nova-stream output-nova-stream)
                           ))
                     (error (e)
                       (nova-server-log "ERROR: ~a" e)))
                   (nova-server-log "server has ended connection"))
                 (progn
                   (nova-server-log "timeout...")))
             (force-output))))))

(defun stop-nova-server ()
  (if (null  *nova-server*)
      (progn
        (print "no server running")
        nil)
      (progn
        (sb-bsd-sockets:socket-close *nova-server*)
        (setf *nova-server* nil))))