Add logging package. Handle flush prompts.

diff --git a/empire.lisp b/empire.lisp
index 2a0c137a79684a8419573dff9a0e48cd3a6edafd..358d0010f5d8c5c1d1d715a60ebf89afd2c46ecb 100644 (file)
--- a/empire.lisp
+++ b/empire.lisp
@@ -33,12 +33,6 @@
     :initarg :stream
     :accessor network-stream
     :documentation "Stream used to talk to the empire server.")
     :initarg :stream
     :accessor network-stream
     :documentation "Stream used to talk to the empire server.")

-   (logging-stream
-    :initarg :logging-stream
-    :accessor logging-stream
-    :initform t
-    :documentation "Messages coming back from the server are sent to
-this stream.")

    (connection-handler
     :accessor connection-handler
     :initform nil
    (connection-handler
     :accessor connection-handler
     :initform nil


@@ -58,7 +52,6 @@ this stream.")
                        (server-port *default-empire-server-port*)
                        (socket nil)
                        (network-stream nil)
                        (server-port *default-empire-server-port*)
                        (socket nil)
                        (network-stream nil)

-                       (logging-stream nil)

                        session)
   (make-instance 'connection
                 :user user
                        session)
   (make-instance 'connection
                 :user user


@@ -67,7 +60,6 @@ this stream.")
                 :server-port server-port
                 :socket socket
                 :stream network-stream
                 :server-port server-port
                 :socket socket
                 :stream network-stream

-                :logging-stream logging-stream

                 :session session))
 
 ;;; interface
                 :session session))
 
 ;;; interface


@@ -75,7 +67,6 @@ this stream.")
                 (password nil)
                 (server-name *default-empire-server*)
                 (server-port *default-empire-server-port*)
                 (password nil)
                 (server-name *default-empire-server*)
                 (server-port *default-empire-server-port*)

-                (logging-stream *standard-output*)

                 session)
   "Connect to server and return a connection object."
   (let* ((socket (usocket:socket-connect server-name server-port))
                 session)
   "Connect to server and return a connection object."
   (let* ((socket (usocket:socket-connect server-name server-port))


@@ -84,13 +75,13 @@ this stream.")
                                      :password password
                                      :socket socket
                                       :network-stream stream
                                      :password password
                                      :socket socket
                                       :network-stream stream

-                                      :logging-stream logging-stream

                                       :server-name server-name
                                      :server-port server-port
                                      :session session))
         (handler (spawn-with-name (format nil "empire-handler-~a" user)
                                   #'handle-connection connection)))
     (setf (connection-handler connection) handler)
                                       :server-name server-name
                                      :server-port server-port
                                      :session session))
         (handler (spawn-with-name (format nil "empire-handler-~a" user)
                                   #'handle-connection connection)))
     (setf (connection-handler connection) handler)

+    (empire-log:info "empire:connect: ~a" connection)

     connection))
 
 (defgeneric quit (connection))
     connection))
 
 (defgeneric quit (connection))


@@ -107,7 +98,8 @@ this stream.")
                                       #'handle-connection c)))
        (setf socket sock
              stream s
                                       #'handle-connection c)))
        (setf socket sock
              stream s

-             connection-handler handler))))
+             connection-handler handler)))
+  (empire-log:info "empire:reconnect: ~a" c))

 
 (defparameter +C_CMDOK+ "0")
 (defparameter +C_DATA+ "1")
 
 (defparameter +C_CMDOK+ "0")
 (defparameter +C_DATA+ "1")


@@ -145,6 +137,7 @@ this stream.")
 (defgeneric handle-init (base-mode message))
 (defgeneric handle-exit (base-mode message))
 (defgeneric handle-prompt (base-mode message))
 (defgeneric handle-init (base-mode message))
 (defgeneric handle-exit (base-mode message))
 (defgeneric handle-prompt (base-mode message))

+(defgeneric handle-flush (base-mode message))

 (defgeneric handle-simple-message (base-mode message))
 
 (defmethod handle-init ((m init-mode) message)
 (defgeneric handle-simple-message (base-mode message))
 
 (defmethod handle-init ((m init-mode) message)


@@ -165,31 +158,30 @@ this stream.")
   (quit (connection m)))
 
 (defmethod handle-data ((m play-mode) message)
   (quit (connection m)))
 
 (defmethod handle-data ((m play-mode) message)

-  (let* ((c (connection m))
-        (log (logging-stream c)))
-    (format log "handle-data ~a~%" message)
+  (let* ((c (connection m)))

     (empire-web:data (session c) message)))
 
 (defmethod handle-simple-message ((m play-mode) message)
     (empire-web:data (session c) message)))
 
 (defmethod handle-simple-message ((m play-mode) message)

-  (let* ((c (connection m))
-        (log (logging-stream c)))
-    (format log "handle-simple-message ~a~%" message)
+  (let* ((c (connection m)))

     (empire-web:data (session c) message)))
 
     (empire-web:data (session c) message)))
 

+(defmethod handle-flush ((m play-mode) message)
+  (let* ((c (connection m)))
+    (empire-web:prompt (session c) message)))
+

 (defmethod handle-prompt ((m play-mode) message)
 (defmethod handle-prompt ((m play-mode) message)

-  (let* ((c (connection m))
-        (log (logging-stream c)))
+  (let* ((c (connection m)))

     (with-input-from-string (s message)
       (let* ((minutes (read s)) ;;FIXME DANGEROUS
             (btus (read s)))
     (with-input-from-string (s message)
       (let* ((minutes (read s)) ;;FIXME DANGEROUS
             (btus (read s)))

-       (format log "[~a:~a]: ~%" minutes btus)
-       (empire-web:prompt (session c) minutes btus)))))
+       (empire-web:prompt (session c)
+                          (format nil "[~a,~a]: " minutes btus))))))

 
 (defparameter *line-type-dispatch*
   (list `(,+C_DATA+ . handle-data)
        `(,+C_INIT+ . handle-init)
        `(,+C_EXIT+ . handle-exit)
 
 (defparameter *line-type-dispatch*
   (list `(,+C_DATA+ . handle-data)
        `(,+C_INIT+ . handle-init)
        `(,+C_EXIT+ . handle-exit)

-       `(,+C_FLUSH+ . handle-simple-message)
+       `(,+C_FLUSH+ . handle-flush)

        `(,+C_BADCMD+ . handle-simple-message)
        `(,+C_FLASH+ . handle-simple-message)
        `(,+C_PROMPT+ . handle-prompt)))
        `(,+C_BADCMD+ . handle-simple-message)
        `(,+C_FLASH+ . handle-simple-message)
        `(,+C_PROMPT+ . handle-prompt)))


@@ -222,9 +214,8 @@ this stream.")
 (defmethod read-message ((c connection))
   (handler-case
       (let* ((s (network-stream c))
 (defmethod read-message ((c connection))
   (handler-case
       (let* ((s (network-stream c))

-            (log (logging-stream c))

             (line (read-line s)))
             (line (read-line s)))

-       (format log "< ~a~%" line)
+       (empire-log:info "< ~a~%" line)

        (multiple-value-bind (message type) (parse-server-line line)
          (let ((handler (lookup-handler type))
                (mode (connection-mode c)))
        (multiple-value-bind (message type) (parse-server-line line)
          (let ((handler (lookup-handler type))
                (mode (connection-mode c)))


@@ -241,9 +232,8 @@ this stream.")
     (force-output s))
   
 (defmethod send-message ((c connection) message)
     (force-output s))
   
 (defmethod send-message ((c connection) message)

-  (let ((s (network-stream c))
-       (log (logging-stream c)))
-    (format log "< ~a~%" message)
+  (let ((s (network-stream c)))
+    (empire-log:info "> ~a~%" message)

     (let ((sent-p nil)
          (tries 3))
       (loop
     (let ((sent-p nil)
          (tries 3))
       (loop


@@ -256,6 +246,7 @@ this stream.")
              (sb-int:closed-stream-error ()
                (progn
                  (decf tries)
              (sb-int:closed-stream-error ()
                (progn
                  (decf tries)

+                 (empire-log:info "Connection close - retrying (~a tries left)" tries)

                  (reconnect c))))))
     message))
 
                  (reconnect c))))))
     message))
 

diff --git a/eow.asd b/eow.asd
index f54b67648cf68ef141965a4a05b55ad947e63bee..5c7971efae2ee76c920567cc3b259d8572c4b482 100644 (file)
--- a/eow.asd
+++ b/eow.asd
@@ -24,6 +24,7 @@
                  (:file "locked-queue"
                         :depends-on ("package"))
                 (:file "web"
                  (:file "locked-queue"
                         :depends-on ("package"))
                 (:file "web"

-                       :depends-on ("package" "locked-queue"))
+                       :depends-on ("package" "locked-queue" "log"))

                  (:file "empire"
                  (:file "empire"

-                        :depends-on ("util"))))
+                        :depends-on ("util" "log"))
+                (:file "log")))

diff --git a/log.lisp b/log.lisp
new file mode 100644 (file)
index 0000000..478e372
--- /dev/null
+++ b/log.lisp
@@ -0,0 +1,6 @@
+(in-package :empire-log)
+
+(defun info (&rest args)
+  (apply #'format *standard-output* args)
+  (terpri *standard-output*))
+

diff --git a/package.lisp b/package.lisp
index a8e00266d080bdcb1c3400390fd3e878182b5691..fa5f80d1dc71a830f4143d9ca106c99682a5fd04 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -17,4 +17,7 @@
     (:export :create :enqueue :dequeue))
   (defpackage :empire-web
     (:use :cl :hunchentoot)
     (:export :create :enqueue :dequeue))
   (defpackage :empire-web
     (:use :cl :hunchentoot)

-    (:export :start :send :prompt :data)))
+    (:export :start :send :prompt :data))
+  (defpackage :empire-log
+    (:use :cl)
+    (:export :info)))

diff --git a/static/eow.js b/static/eow.js
index 95366290973af9ae6c03cb9a2f5c3bed6d7cbad0..19807e408f2a920c9390ee310b130455c26d9be2 100644 (file)
--- a/static/eow.js
+++ b/static/eow.js
@@ -72,8 +72,8 @@ function submit_cmdline(cmdline_form) {
   });
 }
 
   });
 }
 

-function prompt(minutes, btus) {
-  byId("prompt").textContent = "[" + minutes + "," + btus + "]: ";
+function prompt(p) {
+  byId("prompt").textContent = p;

   get_next_update();
 }
 
   get_next_update();
 }
 

diff --git a/web.lisp b/web.lisp
index b3a8a75790918ac6ec92fd15a636532f77ddd629..135cdb4c424b27aaf366e4ced1a51d9caecebdb1 100644 (file)
--- a/web.lisp
+++ b/web.lisp
@@ -50,7 +50,7 @@
     session))
 
 (defgeneric send (session string))
     session))
 
 (defgeneric send (session string))

-(defgeneric prompt (session minutes btus))
+(defgeneric prompt (session string))

 (defgeneric data (session message))
 
 (defvar *empire-session*)
 (defgeneric data (session message))
 
 (defvar *empire-session*)


@@ -70,8 +70,8 @@
   "Push a javascript update fragment to the client."
   (locked-queue:enqueue (update-queue s) string))
 
   "Push a javascript update fragment to the client."
   (locked-queue:enqueue (update-queue s) string))
 

-(defmethod prompt ((s session) minutes btus)
-  (send s (format nil "prompt(~a,~a);~%" minutes btus)))
+(defmethod prompt ((s session) p)
+  (send s (parenscript:ps* `(prompt ,p))))

 
 (defmethod data ((s session) message)
   (send s (parenscript:ps* `(msg ,message))))
 
 (defmethod data ((s session) message)
   (send s (parenscript:ps* `(msg ,message))))


@@ -79,9 +79,11 @@
 ;; destination of login-form
 (defun login-action ()
   (handler-case
 ;; destination of login-form
 (defun login-action ()
   (handler-case

-      (let ((session (make-session (post-parameter "username")
-                                  (post-parameter "password"))))
+      (let* ((user (post-parameter "username"))
+            (pass (post-parameter "password"))
+            (session (make-session user pass)))

        (setf (session-value 'session) session)
        (setf (session-value 'session) session)

+       (empire-log:info "User ~a logging in. Session ~a" user session)

        (redirect +root-url+))
     (usocket:connection-refused-error (e)
       (format nil "Connection error: ~a~%" e))))
        (redirect +root-url+))
     (usocket:connection-refused-error (e)
       (format nil "Connection error: ~a~%" e))))


@@ -107,5 +109,6 @@
 
 
 (defun start ()
 
 
 (defun start ()

+  (empire-log:info "Startup")

   (pushnew 'dispatch *dispatch-table* :test #'eq))
 
   (pushnew 'dispatch *dispatch-table* :test #'eq))