Added driver for LispWorks for Windows/Linux. This hasn't received
much testing, but should work out alright.
This commit is contained in:
53
src/drivers/simple-lwl.cl
Executable file
53
src/drivers/simple-lwl.cl
Executable file
@ -0,0 +1,53 @@
|
||||
;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
|
||||
;;;; This is copyrighted software. See documentation for terms.
|
||||
;;;;
|
||||
;;;; simple-lwl.cl --- Simple driver for LispWorks for Linux
|
||||
;;;;
|
||||
;;;; Checkout Tag: $Name$
|
||||
;;;; $Id$
|
||||
|
||||
(in-package :CLASH)
|
||||
|
||||
;;;; %File Description:
|
||||
;;;;
|
||||
;;;;
|
||||
;;;;
|
||||
|
||||
(defclass lwl-connection (connection)
|
||||
((stream :initarg :stream :reader connection-stream)))
|
||||
|
||||
(defmethod initialize-instance :after
|
||||
((instance lwl-connection) &rest initargs &key socket)
|
||||
(declare (ignore initargs))
|
||||
(setf (slot-value instance 'stream)
|
||||
(make-instance 'comm:socket-stream
|
||||
:socket socket
|
||||
:direction :io
|
||||
:element-type 'base-char)))
|
||||
|
||||
(defmethod connection-address ((connection lwl-connection))
|
||||
(comm:ip-address-string
|
||||
(comm:socket-stream-peer-address (connection-stream connection))))
|
||||
|
||||
(defmethod connection-hostname ((connection lwl-connection))
|
||||
(connection-address connection))
|
||||
|
||||
(defmethod close-connection ((connection lwl-connection))
|
||||
(ignore-errors
|
||||
(let ((stream (connection-stream connection)))
|
||||
(finish-output stream)
|
||||
(close stream))))
|
||||
|
||||
(defun start-http-handler (fd server)
|
||||
(let ((connection (make-instance 'lwl-connection :socket fd)))
|
||||
(mp:process-run-function (format nil "HTTP connection from ~A"
|
||||
(connection-address connection))
|
||||
nil
|
||||
#'serve-connection
|
||||
server connection)))
|
||||
|
||||
(defun start-http-listener (port server)
|
||||
(comm:start-up-server :service port
|
||||
:function
|
||||
#'(lambda (fd) (start-http-handler fd server))))
|
||||
|
||||
Reference in New Issue
Block a user