Casual Game Development
Flash Socket Server in Lisp
http://blog.pettomato.com/?p=17

Here is another version of a socket server that you can use to catch your debug messages from a live swf. Python version here. This one is written in SBCL, which was compiled with threading enabled.

NOTE: I am new to Lisp. I have a feeling this script will be revised several times.

This code was built off of some example code by Patrick May. Dave Roberts, on the sbcl-help mailing list also gave me a few pointers.

This server probably doesn't need to be multithreaded if you are only using it to catch your debug output. I, however, plan to build some other servers off of this, so I am keeping it this way.

The necessary Actionscript to communicate with this server is the same as the Python version.

LISP
1. (in-package :common-user)                                                                                       
2.                                                                                                                      
3. (require :sb-bsd-sockets)                                                                                             
4.                                                                                                                      
5. (defpackage :myServer                                                                                                 
6.   (:use :common                                                                                                 
7.         :sb-thread                                                                                                   
8.         :sb-bsd-sockets                                                                                               
9.         :sb-unix                                                                                                     
10.         :sb-ext)                                                                                                     
11.   (:export :run                                                                                                       
12.            :stop))                                                                                                   
13.                                                                                                                      
14. (in-package :myServer)                                                                                               
15.                                                                                                                      
16. (defparameter *default-server-address* '(192 168 0 1)                                                                 
17.   "The default address on which instances of the server listen.")                                                     
18.                                                                                                                      
19. (defparameter *default-server-port* 8007                                                                             
20.   "The default port on which instances of the server listen.")                                                       
21.                                                                                                                      
22. (defparameter *default-server-backlog* 16                                                                             
23.   "The default number of simultaneous connections to the server.")                                                   
24.                                                                                                                      
25. (defconstant +null+ (code-char 0)                                                                                     
26.   "A null byte.")                                                                                                     
27.                                                                                                                      
28. (defun read-upto-null (stream char-array)                                                                             
29.   "Read everything from stream up until a null byte or EOF."                                                         
30.   ;; TODO: char-array was separated for efficiency, but now                                                           
31.   ;;       this isn't very clean.                                                                                     
32.   (do ((c (read-char stream nil nil) (read-char stream nil nil)))                                                     
33.       ((or (equal c +null+)                                                                                           
34.            (equal c nil))                                                                                             
35.        (if (equal c +null+) char-array nil))                                                                         
36.     (vector-push-extend c char-array)))                                                                               
37.                                                                                                                      
38. (defmethod handle-client ((socket inet-socket))                                                                       
39.   "Handle a client request."                                                                                         
40.   (let ((client-stream (socket-make-stream socket :input t :output t :element-type 'character :buffering :full))     
41.         (s (make-array 1024 :fill-pointer 0 :adjustable t :element-type 'character)))                                 
42.     (do ((message (read-upto-null client-stream s) (read-upto-null client-stream s)))                                 
43.         ((equal message nil)) ; Quit when the client closes the socket.                                               
44.       (cond                                                                                                           
45.         ((equal message "<policy-file-request/>")                                                                     
46.          (write-line "sending policy file")                                                                           
47.          (format client-stream "<?xml version=\"1.0\"?><cross-domain-policy><allow-access-from domain=\"*\" to-ports=\"~A\" /></cross-domain-policy>" *default-server-port*)
48.          (write-char +null+ client-stream) ; terminate the response with a null byte                                 
49.          (finish-output client-stream))                                                                               
50.         (t                                                                                                           
51.          (write-line message)))                                                                                       
52.       (setf (fill-pointer s) 0)))   ; Reset our character array                                                       
53.   (write-line "Closing client connection.")                                                                           
54.   (socket-close socket))                                                                                             
55.                                                                                                                      
56. (defmacro with-socket (socket &body body)                                                                             
57.   "Create and close a socket around the body."                                                                       
58.   `(let ((,socket (make-instance 'inet-socket                                                                         
59.                                  :type :stream                                                                       
60.                                  :protocol :tcp)))                                                                   
61.     (unwind-protect (progn ,@body)
62.       (socket-close ,socket))))
63.  
64. (defmethod run ()                                                                                                     
65.   "Run the server, listening on the specified port and dispatching                                                   
66.   client requests."                                                                                                   
67.   (write-line "Starting server.")                                                                                     
68.   (with-socket server-socket                                                                                         
69.     (setf (sockopt-reuse-address server-socket) t)                                                                   
70.     (socket-bind server-socket *default-server-address* *default-server-port*)                                       
71.     (socket-listen server-socket *default-server-backlog*)                                                           
72.     (do ((client-socket (socket-accept server-socket) (socket-accept server-socket)))  ; ignore peer value           
73.         (nil)  ; infinite loop                                                                                       
74.       (write-line "New client")                                                                                       
75.       (let ((client-socket client-socket))                                                                           
76.         (make-thread (lambda () (handle-client client-socket)) :name "handle-client")))))                             
77.                                                                                                                      
78. (defun start ()                                                                                                       
79.   (setf myServer-thread (make-thread (lambda () (run)) :name "myServer")))                                           
80.                                                                                                                      
81. (defun stop ()                                                                                                       
82.   (let ((st myServer-thread))                                                                                         
83.     (cond                                                                                                             
84.       ((thread-alive-p st)                                                                                           
85.        (write-line "Server stopped.")                                                                                 
86.        (terminate-thread st))                                                                                         
87.       (t                                                                                                             
88.        (write-line "Server is not running.")                                                                         
89.        nil))))                                                                                                       
90.                                                                                                                      
91. ;; start the server                                                                                                   
92. (start)

Via FeedShow.com