From f457ab38fddc9a587b37b3d97b8bcc19d5c412cb Mon Sep 17 00:00:00 2001 From: Gerd Flaig Date: Fri, 1 Aug 2008 21:21:51 +0200 Subject: [PATCH] Initial checkin --- .gitignore | 3 + empire.lisp | 159 +++++++++++++++++++++++++++++++++++++++++++++++++++ eow.asd | 25 ++++++++ net.lisp | 76 ++++++++++++++++++++++++ package.lisp | 13 +++++ scratch.lisp | 14 +++++ util.lisp | 7 +++ 7 files changed, 297 insertions(+) create mode 100644 .gitignore create mode 100644 empire.lisp create mode 100644 eow.asd create mode 100644 net.lisp create mode 100644 package.lisp create mode 100644 scratch.lisp create mode 100644 util.lisp diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..10aca94 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +*.fasl +*~ +#*# diff --git a/empire.lisp b/empire.lisp new file mode 100644 index 0000000..fa088df --- /dev/null +++ b/empire.lisp @@ -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 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 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 index 0000000..4b91d81 --- /dev/null +++ b/package.lisp @@ -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 index 0000000..23b73f6 --- /dev/null +++ b/scratch.lisp @@ -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 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)) -- 2.43.0