Add logging package. Handle flush prompts.
authorGerd Flaig <gefla@gefla-mac-zrh>
Thu, 1 Jan 2009 22:03:18 +0000 (23:03 +0100)
committerGerd Flaig <gefla@gefla-mac-zrh>
Thu, 1 Jan 2009 22:03:18 +0000 (23:03 +0100)
empire.lisp
eow.asd
log.lisp [new file with mode: 0644]
package.lisp
static/eow.js
web.lisp

index 2a0c137a79684a8419573dff9a0e48cd3a6edafd..358d0010f5d8c5c1d1d715a60ebf89afd2c46ecb 100644 (file)
     :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*))
+
index a8e00266d080bdcb1c3400390fd3e878182b5691..fa5f80d1dc71a830f4143d9ca106c99682a5fd04 100644 (file)
@@ -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)))
index 95366290973af9ae6c03cb9a2f5c3bed6d7cbad0..19807e408f2a920c9390ee310b130455c26d9be2 100644 (file)
@@ -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();
 }
 
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))))
 ;; 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))))
 
 
 (defun start ()
 
 
 (defun start ()
+  (empire-log:info "Startup")
   (pushnew 'dispatch *dispatch-table* :test #'eq))
 
   (pushnew 'dispatch *dispatch-table* :test #'eq))