;;;; 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 "" s)
(write-line "" s)
(write-line
"CLASH - The Common Lisp Adaptable Simple HTTP server" s)
(write-line "" s)
(write-line "" s)
(write-line "" s)
(write-line
"![\"CLASH](\"pic/logo.jpg\")
" s)
(write-line "
" s)
(write-line "Welcom to CLASH!
" s)
(format s "
You are visitor number ~D.
" (incf *main-visits*))
(write-line "" 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)