Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
260 lines (228 sloc) 10.7 KB
;; @module Sockets
;; @author Jeff Ober <jeffober@gmail.com>, Kanen Flowers <kanendosei@gmail.com>
;; @version 1.0
;; @location http://static.artfulcode.net/newlisp/sockets.lsp
;; @package http://static.artfulcode.net/newlisp/sockets.qwerty
;; @description Classes for socket operations (requires newlisp 10)
;; Sockets are a fast, efficient method for client/server operations. newLisp
;; has a broad range of functions for dealing with socket-based connections,
;; many of them somewhat arcane if not familiar with socket jargon. The Sockets
;; module encapsulates some of this complexity into two simple classes.
;; The Socket class provides methods for reading, writing, and sending lisp
;; expressions between client and server processes. Requires newlisp 10+ and
;; unix sockets.
;;
;; <h4>Version history</h4>
;; <b>1.0</b>
;; &bull; initial release (replaces SocketServer module)
;;
;; @example
;; ; Fork a server
;; (setf pid
;; (fork
;; (let ((server (SocketServer "/tmp/newlisp.sock")))
;; (:run-server server
;; (lambda (client server , request)
;; (if client
;; (begin
;; (setf request (:read-expr client))
;; (eval request) ; not safe unless you know your client
;; (:write-expr client '(println "Hello, client!"))
;; (:close client))
;; (println "client connection error: " (net-error))))
;; nil ; no operations between connections
;; (lambda (err server) (println "An error has occurred: " err))))))
;;
;; (sleep 500) ; give server time to start
;;
;; ; Connect to server process as a client
;; (let ((socket (Sockets:make-file-socket "/tmp/newlisp.sock")))
;; (:write-expr socket '(println "Hello, server!"))
;; (setf expr (:read-expr socket))
;; (:close socket))
;; (eval expr) ; not safe unless you know your server
;;
;; (destroy pid) ; clean up
(context 'Sockets)
;; @syntax (Sockets:make-file-socket <str-file>)
;; @param <str-file> a file to use as a socket file
;; <p>Creates a new Socket instance using <str-file></p>.
;; @example
;; (setf socket (Sockets:create-socket-file "/tmp/my_app.sock"))
(define (make-file-socket file)
(Socket:Socket (net-connect file)))
;; @syntax (Sockets:make-network-socket <str-host> <int-port>)
;; @param <str-host> the HTTP hostname of the remote server
;; @param <int-port> the remote server's port number to connect to
;; <p>Creates a new Socket instance connected to <str-host>:<int-port>.</p>
;; @example
;; (setf socket (Sockets:create-network-soket "http://www.artfulcode.net" 80))
(define (make-network-socket host port)
(Socket:Socket (net-connect host port)))
(context 'MAIN)
;; @syntax (Socket <socket>)
;; @param <socket> an open socket file descriptor
;; <p>A Socket is a wrapper around a socket file descriptor and uses the
;; built-in net-* functions to manage socket operations.</p>
(define (Socket:Socket socket)
(when (net-error) (throw-error (net-error)))
(list (context) socket))
;; @syntax (:socket <inst>)
;; @param <inst> an instance of Socket
;; <p>Returns the socket file descriptor.</p>
(define (Socket:socket inst)
(inst 1))
;; @syntax (:close <inst>)
;; @param <inst> an instance of Socket
;; <p>Closes the socket connection.</p>
(define (Socket:close inst)
(net-close (:socket inst)))
;; @syntax (:peek <inst>)
;; @param <inst> an instance of Socket
;; <p>Returns the number of bytes ready to be read from the socket.</p>
(define (Socket:peek inst)
(:peek (:socket inst)))
;; @syntax (:ready? <inst>)
;; @param <inst> an instance of Socket
;; <p>Returns true if the socket is ready for reading.</p>
(define (Socket:ready? inst)
(not (zero? (:peek inst))))
;; @syntax (:write <inst> <str-message> [<int-chunk-size>])
;; @param <inst> an instance of Socket
;; @param <str-message> the message to send
;; @param <int-chunk-size> optional; sends message in chunks of size <int-chunk-size>
;; <p>Sends <str-message> along the Socket. If optional <int-chunk-size> is
;; specified, sends the message in chunks.</p>
(define (Socket:write inst message chunk-size , sent)
(if-not chunk-size
(net-send (:socket inst) message)
(until (= (length message)
(inc sent (net-send (:socket inst)
(slice message sent)
chunk-size)))
sent)))
;; @syntax (:read-chunk <inst> <int-bytes> [<block>])
;; @param <inst> an instance of Socket
;; @param <int-bytes> the number of bytes to read
;; @param <block> optional; if explicitly nil, does not block for bytes to be available
;; <p>Blocks until a maximum of <int-bytes> are available to read from the
;; socket and then returns the resulting string. If <blocks> is explicitly
;; passed as nil, returns nil when no bytes are available to read.</p>
(define (Socket:read-chunk inst bytes (block true) , bytes-read buf)
(when (net-error) (throw-error (net-error)))
(when (or block (:ready? inst))
(setf bytes-read (net-receive (:socket inst) buf bytes))
(unless (zero? bytes-read)
buf)))
;; @syntax (:read <inst> [<chunk-size> [<block>]])
;; @param <inst> an instance of Socket
;; @param <chunk-size> the number of bytes to read at a time (default is 512)
;; @param <block> whether to block for data (default is true)
;; <p>Reads from the socket until there is nothing left to read. Will block
;; until something is available to read unless block is nil. This can lead
;; to an indefinitely blocking read if neither end closes the connection.</p>
(define (Socket:read inst (chunk-size 512) (block true) , buf str)
(setf buf "" str "")
(while (setf buf (:read-chunk inst chunk-size))
(write-buffer str buf))
str)
;; @syntax (:read-line <inst>)
;; @param <inst> an instance of Socket
;; <p>Reads one line from the socket. Read-line will continue to read from
;; socket until and end-line character (\n or \r or both) is found. This
;; is not as fast as :read or :read-chunk, as it reads byte-by-byte, and
;; should not be used unless the source is trusted!</p>
(define (Socket:read-line inst , buf str)
(setf buf "" str "")
(while (and (!= buf "\n") (setf buf (:read-chunk inst 1)))
(write-buffer str buf))
(replace {(\s*$)} str "" 4))
;; @syntax (:write-expr <inst> <expr>)
;; @param <inst> an instance of Socket
;; @param <expr> a quoted lisp expression
;; <p>Sends <expr> along the socket. The other end of the socket may
;; then use :read-expr to read the expression back into lisp. Optionally,
;; <expr> may be a string, in which case it will be converted to the
;; expression '(string <expr>). Combined with :read-expr, this provides a
;; simple way to move complex data across a socket connection.</p>
(define (Socket:write-expr inst expr)
(:write inst (string (if (string? expr) (list 'string expr) expr))))
;; @syntax (:read-expr <inst>)
;; @param <inst> an instance of Socket
;; <p>Reads an expression from the socket. Returns a valid lisp expression.
;; This function will block until a valid lisp expression is encountered.
;; Combined with :write-expr, this provides a simple way to move complex
;; data across a socket connection.</p>
(define (Socket:read-expr inst , buf src expr)
(setf buf "" src "" expr "")
(while (and (not (setf expr (read-expr src 'MAIN nil)))
(setf buf (:read-chunk inst 1)))
(write-buffer src buf))
expr)
(new 'Socket 'SocketServer)
;; @syntax (SocketServer <int-port>)
;; @syntax (SocketServer <str-file>)
;; @param <int-port> the port number to listen on
;; @param <str-file> alternately, the socket file to listen on
;; <p>Creates a new SocketServer from a port number or socket file path.
;; SocketServer inherits directly from Socket, so all I/O methods from
;; Socket are available to SocketServer instances. Throws an error if it
;; encounters a problem creating the socket.</p>
(define (SocketServer:SocketServer p , socket)
(setf socket
(cond
((integer? p) (net-listen p))
((string? p) (if (number? p) (net-listen (int p)) (net-listen p)))
(true (throw-error "Invalid port or socket file path."))))
(if (net-error)
(throw-error (net-error))
(list (context) socket)))
;; @syntax (:accept <inst>)
;; @param <inst> an instance of SocketServer
;; <p>Blocks until a connection is available and returns a new Socket
;; instance for the resulting connection.</p>
(define (SocketServer:accept inst)
(setf socket (net-accept (:socket inst)))
(unless (net-error) (Socket socket)))
;; @syntax (:until-connection-ready <inst> <func> [<poll-length>])
;; @param <inst> an instance of SocketServer
;; @param <func> a function to call while awaiting a connection
;; @param <poll-length> the number of ms to wait for a connection on each poll
;; <p>Repeatedly calls <func> until a client connection is ready on the socket.
;; Optional parameter <poll-timeout> (milliseconds) controls the length of time
;; to wait for a connection before calling func. The function is passed the
;; server instance.</p>
(define (SocketServer:until-connection-ready inst func (poll-length 100))
(until (net-select (:socket inst) "read" poll-length)
(func inst)))
;; @syntax (:on-connection <inst> <func>)
;; @param <inst> an instance of SocketServer
;; @param <func> a function to call when a client connects
;; <p>Blocks for a client connection and then calls <func> with the client
;; socket and the server instance. If an error occurs accepting the connection,
;; nil is passed to <func>. The error is then available via net-error.</p>
(define (SocketServer:on-connection inst func)
(func (:accept inst) inst))
;; @syntax (:run-server <inst> <func-connect> [<func-wait> [<func-err>] [<poll-length>]])
;; @param <inst> an instance of SocketServer
;; @param <func-connect> called when a client connects
;; @param <func-wait> called repeatedly while awaiting a client
;; @param <func-err> called when a server error occurs
;; @param <poll-length> the number of ms to wait for a connection on each poll
;; <p>Runs the server in a loop. If <func-connect> is provided, it will be
;; called in the event of a server error. It is passed the error string and
;; server instance. If <func-wait> is provided, it will be called repeatedly
;; until a client connection is available. The only required parameters are the
;; SocketServer instance and <func-connect>, which will be called when a client
;; connection is accepted. It will be passed the client socket and the server
;; instance. If <func-err> is not defined, the server will throw an error when
;; an error occurs.</p>
(define (SocketServer:run-server inst on-connect until-connect on-error (poll-length 100))
(while true
(cond
((and (net-error) on-error) (on-error (net-error) server))
((net-error) (throw-error (net-error)))
(until-connect
(:until-connection-ready inst until-connect poll-length)
(:on-connection inst on-connect))
(true (:on-connection inst on-connect)))))