From: Gerd Flaig Date: Thu, 1 Jan 2009 22:03:18 +0000 (+0100) Subject: Add logging package. Handle flush prompts. X-Git-Url: http://git.pond.sub.org/?p=eow;a=commitdiff_plain;h=761774603f988ef58b11ab22c5bbf862819f9cef;ds=inline Add logging package. Handle flush prompts. --- diff --git a/empire.lisp b/empire.lisp index 2a0c137..358d001 100644 --- a/empire.lisp +++ b/empire.lisp @@ -33,12 +33,6 @@ :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 @@ -58,7 +52,6 @@ this stream.") (server-port *default-empire-server-port*) (socket nil) (network-stream nil) - (logging-stream nil) session) (make-instance 'connection :user user @@ -67,7 +60,6 @@ this stream.") :server-port server-port :socket socket :stream network-stream - :logging-stream logging-stream :session session)) ;;; interface @@ -75,7 +67,6 @@ this stream.") (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)) @@ -84,13 +75,13 @@ this 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) + (empire-log:info "empire:connect: ~a" connection) connection)) (defgeneric quit (connection)) @@ -107,7 +98,8 @@ this stream.") #'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") @@ -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-flush (base-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) - (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) - (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))) +(defmethod handle-flush ((m play-mode) message) + (let* ((c (connection m))) + (empire-web:prompt (session c) 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))) - (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) - `(,+C_FLUSH+ . handle-simple-message) + `(,+C_FLUSH+ . handle-flush) `(,+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)) - (log (logging-stream c)) (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))) @@ -241,9 +232,8 @@ this stream.") (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 @@ -256,6 +246,7 @@ this stream.") (sb-int:closed-stream-error () (progn (decf tries) + (empire-log:info "Connection close - retrying (~a tries left)" tries) (reconnect c)))))) message)) diff --git a/eow.asd b/eow.asd index f54b676..5c7971e 100644 --- a/eow.asd +++ b/eow.asd @@ -24,6 +24,7 @@ (:file "locked-queue" :depends-on ("package")) (:file "web" - :depends-on ("package" "locked-queue")) + :depends-on ("package" "locked-queue" "log")) (:file "empire" - :depends-on ("util")))) + :depends-on ("util" "log")) + (:file "log"))) diff --git a/log.lisp b/log.lisp new file mode 100644 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 a8e0026..fa5f80d 100644 --- a/package.lisp +++ b/package.lisp @@ -17,4 +17,7 @@ (: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 9536629..19807e4 100644 --- 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(); } diff --git a/web.lisp b/web.lisp index b3a8a75..135cdb4 100644 --- a/web.lisp +++ b/web.lisp @@ -50,7 +50,7 @@ session)) (defgeneric send (session string)) -(defgeneric prompt (session minutes btus)) +(defgeneric prompt (session string)) (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)) -(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)))) @@ -79,9 +79,11 @@ ;; 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) + (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)))) @@ -107,5 +109,6 @@ (defun start () + (empire-log:info "Startup") (pushnew 'dispatch *dispatch-table* :test #'eq))