Initial checkin
authorGerd Flaig <gefla@gefla-mac-zrh>
Fri, 1 Aug 2008 19:21:51 +0000 (21:21 +0200)
committerGerd Flaig <gefla@gefla-mac-zrh>
Fri, 1 Aug 2008 19:21:51 +0000 (21:21 +0200)
.gitignore [new file with mode: 0644]
empire.lisp [new file with mode: 0644]
eow.asd [new file with mode: 0644]
net.lisp [new file with mode: 0644]
package.lisp [new file with mode: 0644]
scratch.lisp [new file with mode: 0644]
util.lisp [new file with mode: 0644]

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..10aca94
--- /dev/null
@@ -0,0 +1,3 @@
+*.fasl
+*~
+#*#
diff --git a/empire.lisp b/empire.lisp
new file mode 100644 (file)
index 0000000..fa088df
--- /dev/null
@@ -0,0 +1,159 @@
+(in-package :empire)
+
+(defparameter *version* "0.0.1")
+
+;;
+;; Connection
+;;
+
+(defvar *default-empire-server* "localhost")
+(defvar *default-empire-server-port* 6665)
+
+(defclass connection ()
+  ((user
+    :initarg :user
+    :accessor user)
+   (password
+    :initarg :password
+    :accessor password
+    :initform nil)
+   (server-name
+    :initarg :server-name
+    :accessor server-name
+    :initform "Unknown server")
+   (server-port
+    :initarg :server-port
+    :accessor server-port
+    :initform *default-empire-server-port*)
+   (socket
+    :initarg :socket
+    :accessor socket
+    :documentation "Slot to store socket (for internal use only).")
+   (stream
+    :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 is sent to
+this stream.")
+   (connection-handler
+    :accessor connection-handler
+    :initform nil
+    :documentation "Handler function for incoming messages")))
+
+(defun make-connection (&key (user nil)
+                       (password nil)
+                       (server-name *default-empire-server*)
+                       (server-port *default-empire-server-port*)
+                       (socket nil)
+                       (network-stream nil)
+                       (logging-stream nil))
+  (make-instance 'connection
+                :user user
+                :password password
+                :server-name server-name
+                :server-port server-port
+                :socket socket
+                :stream network-stream
+                :logging-stream logging-stream))
+
+;;; interface
+(defun connect  (&key (user nil)
+                (password nil)
+                (server-name *default-empire-server*)
+                (server-port *default-empire-server-port*)
+                (logging-stream *standard-output*))
+  "Connect to server and return a connection object."
+  (let* ((socket (usocket:socket-connect server-name server-port))
+         (stream (usocket:socket-stream socket))
+         (connection (make-connection :user user
+                                     :password password
+                                     :socket socket
+                                      :network-stream stream
+                                      :logging-stream logging-stream
+                                      :server-name server-name
+                                     :server-port server-port))
+        (handler (spawn-with-name (format nil "empire-handler-~a" user)
+                                  #'handle-connection connection)))
+    (setf (connection-handler connection) handler)
+    connection))
+
+
+(defgeneric quit (connection))
+(defgeneric handle-connection (connection))
+(defgeneric read-message (connection))
+(defgeneric send-message (connection message))
+
+(defparameter +C_CMDOK+ "0")
+(defparameter +C_DATA+ "1")
+(defparameter +C_INIT+ "2")
+(defparameter +C_EXIT+ "3")
+(defparameter +C_FLUSH+ "4")
+(defparameter +C_NOECHO+ "5")
+(defparameter +C_PROMPT+       "6")
+(defparameter +C_ABORT+ "7")
+(defparameter +C_REDIR+ "8")
+(defparameter +C_PIPE+ "9")
+(defparameter +C_CMDERR+ "a")
+(defparameter +C_BADCMD+ "b")
+(defparameter +C_EXECUTE+ "c")
+(defparameter +C_FLASH+ "d")
+(defparameter +C_INFORM+ "e")
+
+(defgeneric init-mode (connection message))
+(defmethod init-mode ((c connection) message)
+  (declare (ignorable message))
+  (play c))
+
+(defvar *line-type-dispatch*
+  (list `(,+C_INIT+ . init-mode)))
+
+(defun parse-server-line (line)
+  (let* ((first-space-index
+         (loop for i from 0 below (length line)
+            if (eq (char line i) #\Space)
+            do (return i)))
+        (message-type (subseq line 0 first-space-index))
+        (message (subseq line (+ first-space-index 1))))
+    (values message message-type)))
+
+(defmethod handle-connection ((c connection))
+  (loop while (read-message c)))
+
+(defun lookup-handler (message-type)
+  (cdr (assoc message-type *line-type-dispatch* :test 'string=)))
+
+(defmethod read-message ((c connection))
+  (let* ((s (network-stream c))
+        (log (logging-stream c))
+        (line (read-line s)))
+    (format log "< ~a~%" line)
+    (multiple-value-bind (message type) (parse-server-line line)
+      (let ((handler (lookup-handler type)))
+       (funcall handler c message)))
+    line))
+  
+(defmethod send-message ((c connection) message)
+  (let ((s (network-stream c))
+       (log (logging-stream c)))
+    (format log "< ~a~%" message)
+    (write-sequence message s)
+    (terpri s)
+    (force-output s)
+    message))
+
+(defgeneric play (connection))
+(defmethod play ((c connection))
+  (with-slots (user password) c
+    (send-message c (format nil "play FIXME ~a ~a" user password))))
+
+(defmethod quit ((c connection))
+  (usocket:socket-close (socket c)))
+
+
+;;; Tests
+(defvar *l1* "2 Empire server ready")
+;; (parse-server-line *l1*)
diff --git a/eow.asd b/eow.asd
new file mode 100644 (file)
index 0000000..993444c
--- /dev/null
+++ b/eow.asd
@@ -0,0 +1,25 @@
+
+;;;; $Id$
+;;;; $URL$
+
+;;;; See the LICENSE file for licensing information.
+
+(in-package #:cl-user)
+
+(defpackage #:eow-system
+    (:use #:cl #:asdf))
+
+(in-package #:eow-system)
+
+(defsystem eow
+    :name "eow"
+    :author "Gerd Flaig"
+    :version "0.0.1"
+    :licence "MIT"
+    :description "Web Empire client"
+    :depends-on (:usocket)
+    :components ((:file "package")
+                 (:file "util"
+                        :depends-on ("package"))
+                 (:file "empire"
+                        :depends-on ("util"))))
diff --git a/net.lisp b/net.lisp
new file mode 100644 (file)
index 0000000..7d2c4b1
--- /dev/null
+++ b/net.lisp
@@ -0,0 +1,76 @@
+(defpackage "emp-net"
+  (:use "SB-BSD-SOCKETS" "CL"))
+
+(in-package "emp-net")
+
+; 2 Empire server ready
+; client testclient
+; 0 talking to testclient
+; coun POGO
+; 0 country name POGO
+; pass peter
+; 0 password ok
+; play
+; 2 2
+; 1 You're not a deity!
+; 3 so long...
+; Connection closed by foreign host.
+
+(defvar *socket*)
+(defvar *s*)
+
+(defun init ()
+  (setf *socket* (make-instance 'inet-socket :type :stream :protocol :tcp))
+  (let ((address (host-ent-address (get-host-by-name "localhost"))))
+    (socket-connect *socket* address 6665))
+  (setf *s* (socket-make-stream *socket* :input t :output t :buffering :line)))
+
+(defun read-reply ()
+  (let ((reply (read-line *s*)))
+    (assert (char= (aref reply 1) #\ ))
+    (cons (aref reply 0) (subseq reply 2))))
+
+(defconstant +C_CMDOK+ "0")
+(defconstant +C_DATA+ "1")
+(defconstant +C_INIT+ "2")
+(defconstant +C_EXIT+ "3")
+(defconstant +C_FLUSH+ "4")
+(defconstant +C_NOECHO+ "5")
+(defconstant +C_PROMPT+        "6")
+(defconstant +C_ABORT+ "7")
+(defconstant +C_REDIR+ "8")
+(defconstant +C_PIPE+ "9")
+(defconstant +C_CMDERR+ "a")
+(defconstant +C_BADCMD+ "b")
+(defconstant +C_EXECUTE+ "c")
+(defconstant +C_FLASH+ "d")
+(defconstant +C_INFORM+ "e")
+;(defconstant +C_LAST+ "e")
+
+(defun login (username country password)
+  (user username)
+  (coun country)
+  (pass password))
+
+(defun user (username)
+  (format *s* "user ~a~%" username)
+  (assert (char= +C_CMDOK+ (car (read-reply)))))
+
+(defun coun (country)
+  (format *s* "coun ~a~%" country)
+  (assert (char= +C_CMDOK+ (car (read-reply)))))
+
+(defun pass (password)
+  (format *s* "pass ~a~%" password))
+
+(defun reader (fd)
+  (declare (ignore fd))
+  (let ((line (read-line *s*)))
+    (format t "< ~a~%" line)
+    (reader)))
+
+(defun add-reader ()
+  (sb-sys:add-fd-handler (sb-sys:fd-stream-fd *s*)
+                        :input
+                        (lambda (fd)
+                          (format t "input-handler: fd ~a~%" fd))))
diff --git a/package.lisp b/package.lisp
new file mode 100644 (file)
index 0000000..4b91d81
--- /dev/null
@@ -0,0 +1,13 @@
+;;;; $Id$
+
+;;;; See the LICENSE file for licensing information.
+
+(in-package :cl-user)
+
+;; the exports list needs some cleanup/clarification/categorization
+(eval-when (:execute :load-toplevel :compile-toplevel)
+  (defpackage :empire
+      (:use :cl)
+    (:export :read-message-loop
+             :read-message
+            :make-connection)))
diff --git a/scratch.lisp b/scratch.lisp
new file mode 100644 (file)
index 0000000..23b73f6
--- /dev/null
@@ -0,0 +1,14 @@
+(setf *r* (drakma:http-request "http://gdata.youtube.com/feeds/videos"))
+
+;; DOM
+(setf *d* (cxml:parse *r* (cxml-dom:make-dom-builder)))
+(dom:child-nodes *d*)
+(dom:get-elements-by-tag-name *d* "entry")
+(setf *c* (aref (dom:get-elements-by-tag-name *d* "entry") 0))
+(dom:map-document (cxml:make-character-stream-sink *standard-output*) *c*)
+
+;; Klacks
+(setf *s* (cxml:make-source *r*))
+(klacks:peek-next *s*)
+(klacks:find-element *s* "entry")
+(klacks:serialize-element *s* (cxml-xmls:make-xmls-builder))
diff --git a/util.lisp b/util.lisp
new file mode 100644 (file)
index 0000000..4f5e390
--- /dev/null
+++ b/util.lisp
@@ -0,0 +1,7 @@
+(in-package :empire)
+
+(defun spawn-with-name (name function &rest args)
+  "See SBCL documentation for SB-THREAD:MAKE-THREAD."
+  (sb-thread:make-thread (lambda ()
+                           (apply function args))
+                         :name name))