(in-package "IPC")

;;; File: server.lisp
;;; John:IPSI:Feb 9, 1996

;;; ----------------------------------------------------------------------
;;; BASIC (VERY) SERVER FUNCTIONALITY FOR USE WITH KPML.
;;; (Adapted from Allegro ACL4.2 release: code/ipc.cl)
;;; ----------------------------------------------------------------------
;;;
;;; Starting a KPML server is done by issuing a:
;;;  (ipc::start-kpml-server)
;;; this establishes a connection to a port, the 
;;; host and the port number are left in the file
;;; *com-file* (default: *default-com-file*, which
;;; by default is the file: 
;;;   <user-home-directory>/KpmlCom.tmp
;;; 
;;; Starting a KPML client from Lisp can then be done with
;;; the call
;;;  (common-lisp-user::start-kpml-client)
;;; this returns a stream to the port identified
;;; in the *com-file*. Information can then be sent using
;;; ipc::send-to-socket; this function returns the value
;;; returned from the server. More usefully, SPLs can be
;;; sent to KPML with the function call:
;;;   (common-lisp-user::kpml-server-say <SPL> stream).
;;;
;;; ----------------------------------------------------------------------
;;; The following set of function calls provide the foundation
;;; for the socket communication with the KPML Lisp process
;;; described above. 
;;; 
;;;   (ipc::set-socket "<socket-name>")
;;;   (ipc::start-lisp-listener-daemon :startup-stream-process
;;;           #'ipc::kpml-server-startup)
;;;
;;; The communication will close when a :stop comes over. 
;;;
;;; A client side from Lisp can secure access to the socket
;;; by issuing an (ipc::open-network-stream :socket-file "<socket-name">).
;;; It can then use the function ipc::send-to-socket
;;; defined below. Once stopped, the daemon needs to be killed
;;; before re-use, (ipc::kill-lisp-listener-daemon).
;;; Both named sockets and host and port numbers can be used:
;;; for host/ports simply omit the set-socket call above to make
;;; sure that ipc::*unix-domain* is nil. Then issue a
;;; (ipc::open-network-stream :host "..." :port nnn) to get 
;;; a stream to the port.
;;;
;;; ----------------------------------------------------------------------
;;; For the Dictionary of Art scenario, the set up for the server
;;; is as follows:
;;;  (ipc::dart)
;;;  (ipc::set-com-file)
;;;    ... SFK can then communicate using the protocol defined.
;;;  (ipc::close-dart)
;;; then closes the logging files and kills the listener daemon.
;;; ----------------------------------------------------------------------

(unless (find-package "KPML")(make-package "KPML"))

(defvar *kpml-log-file* "/tmp/kpml-server-log")
(defvar *kpml-log-stream* nil)
(defvar *sfk-input-log* nil)
(defvar *kpml-server-protocol* T)
(defvar *server-debugging* nil)

;;; 1.1 added until we get the interprocess stuff sorted out for PC
;;; version...
(defun CLEAR-OUTPUT-1 (s)
  #+allegro (excl::clear-output-1 s)
  #-allegro nil)

;;; The processing that the server should carry out on its input
;;; should be defined from the following function:

(defun PROCESS-INPUT-FROM-CLIENT (input)
  (when *server-debugging* (print input))
  (when (and (consp input)
	     (consp (first input)))
	(setf input
	      (loop for x in input 
		    when (consp x)
		    collect (loop for y in x
				  when (consp y)
				  collect (loop for z in y
						collect 
						(intern (string z) "PENMAN"))
				  else 
				  when (stringp y)
				  collect y
				  else
				  unless (keywordp y)
				  collect (intern (string y) "PENMAN")
				  else collect y)
		    else collect x end))
	(format t "~%;;; KPML Server found something to generate...")
	(push (cons (kpml::time-stamp) input) *sfk-input-log*)
	(print (first *sfk-input-log*) *kpml-log-stream*)
	(unwind-protect
	    (multiple-value-bind
		(value error)
		(ignore-errors
		 (kpml::dart-planner input))
	      (declare (ignore value))
	      (when error
		(setf kpml::*gen-strings* " ... ")
		(print "Failed to generate!" *kpml-log-stream*))))
	(format *kpml-log-stream*
		"\"~{~%       ~A~}\" "
		(kpml::justify-string 60 kpml::*gen-strings*))
	(return-from process-input-from-client T))
  nil)
	

;;; ----------------------------------------------------------------------
;;; Following function implements the very simple first Komet-SFK
;;; exchange protocol. 


(defun KPML-SERVER-PROCESSOR (s)
  (loop
   (let ((input nil))
     (when *kpml-server-protocol* (print "Waiting for input..."))
     (setf input (read-char s nil #\e))
     (case input
	   (#\s
	    (write-char #\o s)
	    (when *kpml-server-protocol* 
	      (print "Acknowledged. (O)")
	      (print "Waiting to receive SPL"))
	    (setf input (let ((*package* (find-package "PENMAN")))
			  (read s nil)))
	    (cond ((not input)
		   (print "Eof hit; exiting.")
		   (clear-output-1 s)
		   (close s)
		   (return-from kpml-server-processor nil))
		  (t
		   (write-char #\* s)
		   (format s "~A" (kpml::say-come-what-may input))
		   (write-char #\* s)
		   (when *kpml-server-protocol* 
		     (print "Generated result sent to stream."))
		   )))
	   (#\e 
	    (print "Eof hit; exiting.")
	    (clear-output-1 s)
	    (close s)
	    (close-dart)
	    (return-from kpml-server-processor nil))
	   (#\n
	    (when *kpml-server-protocol* (print "Noop received."))
	    (write-char #\o s)
	    (when *kpml-server-protocol* (print "Noop acknowledged. (O)")))
	   (#\i
	    (when *kpml-server-protocol* 
		  (print "Generation input waiting to be received..."))
	    (setf input (let ((*package* (find-package "PENMAN")))
			  (read s nil)))
	    (cond ((not input)
		   (print "Eof hit; exiting.")
		   (clear-output-1 s)
		   (close s)
		   (close-dart)
		   (return-from kpml-server-processor nil))
		  ((eq input :stop)
		   (print "Server received stop: closing")
		   (clear-output-1 s)
		   (close s)
		   (close-dart)
		   (return-from kpml-server-processor nil))
		  (t
		   (write-char #\g s)
		   (when *kpml-server-protocol* (print "G sent to stream."))
		   (write-char #\space s)
		   (when *kpml-server-protocol* (print "Space sent to stream"))
		   (ipc::process-input-from-client input)
		   (write-char #\a s)
		   (when *kpml-server-protocol* (print "A sent to stream"))
		   (format s "~A" kpml::*gen-strings*)
		   (when *kpml-server-protocol* 
		     (print "Generated result sent to stream."))
		   (setf kpml::*gen-strings* "")
		   (terpri s))))
	   (otherwise
	    (print "noise heard.")
	    (write-char #\o s))))))



;;; ----------------------------------------------------------------------
;;; Adapted from Allegro ACL4.2 release: code/ipc.cl
;;; But the password stuff has been taken out as it was
;;; blocking things somehow.

(defun KPML-SERVER-STARTUP 
  (stream 
   &key (function 'kpml-server-processor)
   listen-sockaddr fd
   &allow-other-keys)
  (print "KPML server started and connection established...")
  (process-run-function "KPML-SERVER" function stream))


(defun SET-SOCKET (socket-name)
  (setf *socket-pathname* socket-name)
  (setf *unix-domain* T)
  )

;;; The following function can be used from a client
;;; to send information to the server started above.
;;; The read-char seems to be necessary in order to
;;; jog the socket into action: until this is given
;;; the server's read does not return an item.
(defun SEND-TO-SOCKET (item s)
  (print item s)
  (Read-char s nil))


(defvar *default-com-file* (pathname 
			    (merge-pathnames
			     "KpmlCom.tmp"
			     (user-homedir-pathname))))
(defvar *com-file* *default-com-file*)

(defun SET-COM-FILE (&optional (hostname (short-site-name)))
  (format t "~%;;; Setting IPC details for port: ~A" *inet-port-used*)
  (with-open-file (s *com-file*
		   :direction :output
		   :if-not-exists :create
		   :if-exists :supersede)
    (format s "~A#~A" *inet-port-used* hostname )))


;;; ----------------------------------------------------------------------
;;; Variation on the above for using host and port numbers...


(defun GET-COM-INFO-FROM-FILE (file)
  (with-open-file 
   (s (pathname (string file)))
   (let* ((input (read-line s nil))
	  (pos (position #\# input)))
     (values
      (read-from-string (subseq input 0 pos))
      (subseq input (1+ pos) (length input))))))


;;; ----------------------------------------------------------------------
;;; The following function bundles the necessary calls together
;;; to start up the server for the dictionary of art/EW. It
;;; also starts logging the input and output produced by
;;; the server over its life.

(defun DART ()
  (kill-lisp-listener-daemon)
  (cond ((and *kpml-log-stream*
	      (open-stream-p *kpml-log-stream*))
	 (close *kpml-log-stream*)
	 (setf *kpml-log-stream* nil))
	(*kpml-log-stream* 
	 (setf *kpml-log-stream* nil)))
  (unless *kpml-log-stream*
    (setf *kpml-log-stream* 
      (open (make-kpml-log-filename) :direction :output
	    :if-exists :supersede))
    (format t "~%... starting logging to ~A" *kpml-log-stream*))
  (ipc::start-lisp-server-process :startup-stream-process
				  #'ipc::kpml-server-startup)
  )

(defun START-DART ()
  (let ((port *inet-port-used*))
    (dart)
    (loop while (eq *inet-port-used* port))
    (set-com-file)
    (format t "~% KPML server started (port: ~A)" *inet-port-used*)
    (values)))


(defun CLOSE-DART ()
  (kill-lisp-listener-daemon)
  (cond ((and *kpml-log-stream*
	      (open-stream-p *kpml-log-stream*))
	 (close *kpml-log-stream*)
	 (setf *kpml-log-stream* nil))
	(*kpml-log-stream* 
	 (setf *kpml-log-stream* nil)))
  (format t "~%... KPML server closed down."))


(defun MAKE-KPML-LOG-FILENAME ()
  (multiple-value-bind 
   (second minute hour date month year) 
   (get-decoded-time)
   (format nil "/tmp/kpml-log-~a~2,'0D~2,'0D-~2,'0D~2,'0D~2,'0D" 
	   year month date hour minute second)))


#+allegro(defun KPML-SERVER-RESTART-FUNCTION ()
  ;; see the ACL manual, p8-8, for the following...
  (let ((f-arg (member "-f" 
		       (system:command-line-arguments
			:application nil)
		       :test #'string=)))
    (if f-arg
	(setf *com-file* 
	  (pathname
	    (cadr f-arg)))
      (setf *com-file* *default-com-file*))
    (start-dart)))

#+acl3.0(defun KPML-SERVER-RESTART-FUNCTION ()
	  (warning "Not supported under PC Lisp as yet..."))

(defun KPML::SAY-COME-WHAT-MAY (input)
  (multiple-value-bind (value error)
      (ignore-errors (kpml::say input))
    (if error
	" ... "
      value)))


;;; ----------------------------------------------------------------------

(defun START-KPML-SERVER ()
  (start-dart))

;;; ----------------------------------------------------------------------

(defun COMMON-LISP-USER::START-KPML-CLIENT ()
  (multiple-value-bind (port host)
      (get-com-info-from-file (namestring *com-file*))
    (open-network-stream :host host :port port)))

(defun COMMON-LISP-USER::KPML-SERVER-SAY (input stream) 
  (ipc::send-to-socket #\s stream)
  (ipc::send-to-socket input stream)
  ;; ignore noise...
  (loop for i = (read-char stream nil)
      until (or (not i)(char= i #\*)))
  ;; get the result...
  (coerce (loop for i = (read-char stream nil)
	      until (or (not i)(char= i #\*))
	      collect i) 'string))

	  

