Pierre R. Mai
e1c4504ede
nearly all concepts and simple implementations thereof needed to get a simple HTTP/0.9 "compliant" server working (there are some hacks needed that we don't yet provide, since the correct things will be added shortly, like complete HTTP/1.1 request parsing. The hacks needed are provided as part of the basic HTTP/0.9 server demo in src/test/basic-demo.cl). Further work is needed to clean up some things, Entity and Resource handling needs to be implemented right and less "naive" (the current implementations are just simple place-holders to get things up and running). Connections need to have knowledge of client identity (passed from the driver, this is implementation-specific stuff). Logging needs to be implemented (probably as server mixins). Condition handling needs to generate better responses for HTTP/0.9, and the division between condition handling and normal handling needs to be documented/rethought. Content generation is totally missing currently and needs to be implemented. If this is all in place, an HTTP/1.0 conforming server should be possible, and after porting the drivers to ACL and LW, we can make a first release.
83 lines
2.5 KiB
Common Lisp
83 lines
2.5 KiB
Common Lisp
;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
|
|
;;;; This is copyrighted software. See documentation for terms.
|
|
;;;;
|
|
;;;; basic-demo.cl --- Basic server demonstration
|
|
;;;;
|
|
;;;; Checkout Tag: $Name$
|
|
;;;; $Id$
|
|
|
|
(in-package :CLASH)
|
|
|
|
;;;; %File Description:
|
|
;;;;
|
|
;;;; This set's up a very basic HTTP/0.9 server on CMU CL.
|
|
;;;;
|
|
|
|
;;; Define basic online logging mixin
|
|
|
|
(defclass basic-logging-mixin ()
|
|
((stream :initarg :stream :initform *standard-output*
|
|
:accessor basic-logging-stream)))
|
|
|
|
(defmethod serve-connection :before ((server basic-logging-mixin) connection)
|
|
(format (basic-logging-stream server)
|
|
"~&;;; At ~D Started serving of ~A~%"
|
|
(get-internal-real-time) connection))
|
|
|
|
(defmethod serve-connection :after ((server basic-logging-mixin) connection)
|
|
(format (basic-logging-stream server)
|
|
"~&;;; At ~D Finished serving of ~A~%"
|
|
(get-internal-real-time) connection))
|
|
|
|
;;; Fudge default request class
|
|
(defmethod get-request-class (version)
|
|
(find-class 'request/0.9))
|
|
|
|
;;; Define Server class
|
|
(defclass my-server (http-server/0.9 basic-logging-mixin)
|
|
())
|
|
|
|
(defvar *my-server* (make-instance 'my-server))
|
|
|
|
;;; Populate Server Namespace
|
|
|
|
(defvar *main-visits* 0
|
|
"Number of visits to the main page.")
|
|
|
|
(defun render-main-page (s)
|
|
(write-line "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">" s)
|
|
(write-line "<HTML><HEAD>" s)
|
|
(write-line
|
|
"<TITLE>CLASH - The Common Lisp Adaptable Simple HTTP server</TITLE>" s)
|
|
(write-line "</HEAD>" s)
|
|
(write-line "<BODY BGCOLOR=\"#000000\" TEXT=\"#28b4d9\">" s)
|
|
(write-line "<CENTER><P>" s)
|
|
(write-line
|
|
"<IMG SRC=\"pic/logo.jpg\" ALT=\"CLASH Logo\">" s)
|
|
(write-line "</P></CENTER>" s)
|
|
(write-line "<CENTER><H1>Welcom to CLASH!</H1></CENTER>" s)
|
|
(format s "<HR><P>You are visitor number ~D.</P>" (incf *main-visits*))
|
|
(write-line "</BODY></HTML>" s))
|
|
|
|
(let* ((c-path #.*compile-file-pathname*)
|
|
(base-path (make-pathname
|
|
:directory (butlast (pathname-directory c-path) 2)
|
|
:name nil :type nil :version nil
|
|
:defaults c-path))
|
|
(namespace (http-server-namespace *my-server*))
|
|
(main-page (make-instance 'simple-resource
|
|
:content #'render-main-page)))
|
|
(namespace-add-url
|
|
namespace (parse-url-from-string "/pic/logo.jpg")
|
|
(make-instance 'simple-resource
|
|
:content (merge-pathnames "doc/logo2.jpg" base-path)))
|
|
(namespace-add-url namespace (parse-url-from-string "/index.html")
|
|
main-page)
|
|
(namespace-add-url namespace (parse-url-from-string "/")
|
|
main-page))
|
|
|
|
;;; Start everything
|
|
|
|
(start-http-listener 8080 *my-server*)
|
|
(initialize-clash)
|