(in-package :common-lisp-user) (declaim (optimize (speed 3) (safety 1))) (eval-when (:compile-toplevel :load-toplevel) (asdf:oos 'asdf:load-op :iolib)) (defpackage :iolib-problem (:nicknames :iop) (:use #:common-lisp #:net.sockets #:iomux) (:export #:start-server #:stop-server)) (in-package :iolib-problem) (defparameter *server* nil) (defparameter *event-base* (make-instance 'event-base)) (defparameter *event-loop-thread* nil) (defparameter *server-event* nil) (defparameter *handlers* (make-hash-table :test #'eql)) (defparameter +maxconn+ 50) (defparameter *currcon* 0) (defun make-server (port) (make-socket :address-family :internet :type :stream :connect :passive :reuse-address t :local-host +ipv4-unspecified+ :local-port port :external-format '(:ascii :line-terminator :dos) :ipv6 nil)) (defun close-handler (event-base connection) (remove-event event-base (gethash (socket-fd connection) *handlers*)) (close connection)) (defun make-client-handler (event-base connection request-handler) (declare (type function request-handler)) (lambda (fd evtype) (declare (ignore fd)) (cond ((eq evtype :read) (ignore-errors (unwind-protect (progn (funcall request-handler connection) (finish-output connection)) (close-handler event-base connection) (decf *currcon*)))) (t (close-handler event-base connection))))) (defun add-connection-handler (event-base connection request-handler) (declare (type function request-handler)) (setf (gethash (socket-fd connection) *handlers*) (add-fd event-base (socket-fd connection) :read (make-client-handler event-base connection request-handler) :persistent t :timeout 1))) (defun make-listener-handler (event-base listener-socket request-handler) (lambda (fd evtype) (declare (ignore fd)) (case evtype (:read (loop :do (if (< *currcon* +maxconn+) (let ((connection (accept-connection listener-socket :wait nil))) (cond (connection (add-connection-handler event-base connection request-handler) (incf *currcon*)) (t (loop-finish)))) (loop-finish)))) (otherwise (break))))) (defun add-single-threaded-server (event-base listener-socket request-handler) (add-fd event-base (socket-fd listener-socket) :read (make-listener-handler event-base listener-socket request-handler) :persistent t)) (defparameter *response-body* "TestAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA") (defun test-handler (sock) (declare (type stream sock)) (read-line sock)(read-line sock) (format sock "HTTP/1.1 200 OK~%Content-Type: text/html~%Content-Length: ~A~%~%~A" (length *response-body*) *response-body*)) (defun start-server (port) (setf *server* (make-server port) *server-event* (add-single-threaded-server *event-base* *server* #'test-handler) *currcon* 0) (unwind-protect (event-dispatch *event-base*) (stop-server))) (defun stop-server () (remove-event *event-base* *server-event*) (close *server*) (setf *server* nil *server-event* nil))