Implementing a blog in Common Lisp: Part 3

by Vetle Roeim - last updated 2008-01-26

Table of contents

  1. Introduction
  2. Creating a new blog post
  3. Outputting HTML
  4. HTTP authentication
  5. Packaging - step 1: The system definition
  6. Packaging - step 2: ASDF-Installable
  7. End of part 3

Introduction

This is the continuation of a tutorial showing how a blog can easily be implemented in Common Lisp. This is part 3 of the tutorial, part 1 and part 2 should be read first.

This part wraps up the tutorial by fixing some outstanding issues, such as creating a new blog post, outputting HTML, HTTP authorization and packaging. For your convenience, the source code of the files created in this tutorial can be downloaded (note that this is the final code for this part of the tutorial, and that it goes through many steps).

Creating new blog post

In the previous part of the tutorial, we showed how to edit blog posts, but it is obviously a little awkward to have to create new blog posts in the REPL, so let us make a page for creating new blog posts. First, we decide which URL to use for showing the form, and add it to the dispatch table. Let's use /create/, and have it map to a function we call create-blog-post.

; Set the web server dispatch table
(setq hunchentoot:*dispatch-table*
      (list (hunchentoot:create-regex-dispatcher "^/$" 'generate-index-page)
            (hunchentoot:create-regex-dispatcher "^/view/$"
                                                 'view-blog-post-page
)

            (hunchentoot:create-regex-dispatcher "^/edit/$"
                                                 'edit-blog-post
)

            (hunchentoot:create-regex-dispatcher "^/create/$"
                                                 'create-blog-post
)
)
)

Next, we define create-blog-post. If it's a GET request, we just show the form, if it's a POST request, we read input data, create the new blog post and redirect to it.

(defun create-blog-post ()
  (with-http-authentication
      (cond ((eq (hunchentoot:request-method) :GET)
             (with-output-to-string (stream)
               (html-template:fill-and-print-template #P"post-form.tmpl" nil
                                                      :stream stream
)
)
)

            ((eq (hunchentoot:request-method) :POST)
             (save-new-blog-post)
)
)
)
)

Here we can cheat a bit, and rename post-edit.tmpl to post-form.tmpl, to use the same file for both editing and creating new blog posts. The template can be used as-is, except that in order to have it say Create blog post instead of Edit blog post, we have to use tmpl_if in the template to test if any blog post data was supplied.

<!-- tmpl_if url-part -->
  <h1>Edit blog post</h1>
<!-- tmpl_else -->
  <h1>Create blog post</h1>
<!-- /tmpl_if -->
  

Then, save-new-blog-post simply calls make-instance to create a new blog-post object and then redirect to the page showing it.

(defun save-new-blog-post ()
  (let ((blog-post (make-instance 'blog-post
                                  :title (hunchentoot:post-parameter "title")
                                  :body (hunchentoot:post-parameter "body")
)
)
)

    (hunchentoot:redirect (url-part blog-post))
)
)


Outputting HTML

Although it's now possible to create and edit blog posts, if you try to write blog posts containing HTML, it will all be escaped. Luckily it's easy to change this behaviour. html-template applies whatever function *string-modifier* points to, to any string that is used by tmpl_var in the template.

By setting it temporarily to #'cl:identity, which will simply return the value of the object we pass it - i.e. the unescaped string. We will need to add this both to generate-index-page and generate-blog-post-page

(defun generate-index-page ()
  "Generate the index page showing all the blog posts."
  (with-output-to-string (stream)
    (let ((html-template:*string-modifier* #'identity))
      (html-template:fill-and-print-template ...)
)
)
)

(defun generate-blog-post-page (template)
  "Generate a page using blog post data."
  (let ((url-part (hunchentoot:query-string)))
    (with-output-to-string (stream) ; Create a stream that will give us a sting
     (let ((blog-post (get-instance-by-value 'blog-post 'url-part url-part)) ; Get the right blog post
           (html-template:*string-modifier* #'identity)
)

        (html-template:fill-and-print-template ...)
)
)
)
)

Now any HTML you enter in the blog posts should be output unescaped as HTML in the templates.

HTTP authentication

As our blog is now, anyone can edit and create new blog posts. To add some form of authentication, let us write a macro that we will call with-http-authentication, that automatically makes it necessary for the user to log in with basic HTTP authentication.

We should be able to use the finished macro as shown below.

(defun edit-blog-post ()
  (with-http-authentication
      (cond ((eq (hunchentoot:request-method) :GET)
             (generate-blog-post-page #P"post-form.tmpl")
)

            ((eq (hunchentoot:request-method) :POST)
             (update-blog-post)
)
)
)
)

The macro is fairly simple - get the authorization data, check it against a predefined username and password. If they don't match, send HTTP headers requiring authorization.

(defmacro with-http-authentication (&rest body)
  `(multiple-value-bind (username password) (hunchentoot:authorization)
     (cond ((and (string= username *username*) (string= password *password*))
            ,@body
)

           (t (hunchentoot:require-authorization "my-blog"))
)
)
)

With that in place, it is just a matter of wrapping anything we want protected with this macro.

Packaging - step 1: The system definition

Finally, after much hard work, the blog is ready. Well, not entirely, but let's pretend.

The only thing left now is to make it ASDF installable. ASDF is short for Another System Definition Facility, and is basically for creating a system definition that describes the dependencies of your application or library. This will make it easy to install your application and its dependencies.

We will put the system definition in a file called my-blog.asd. The system definition is put in a separate package, so the first few lines in this file are used for setting up this package.

(defpackage #:my-blog-asd
  (:use :cl :asdf)
)


(in-package :my-blog-asd)

Next comes our system definition, which we define with defsystem. This can take several parameters, and only the name of the system is mandatory.

In this case, the important parameters are :components, which will define which files that are part of our system, and :depends-on, which defines which packages our system requires to run. The final result can be seen below, and should be self explanatory.

(defsystem my-blog
  :name "my-blog"
  :version "0.0.0"
  :author "Your name"
  :description "A fantastic blog"
  :components ((:file "blog"))
  :depends-on ("elephant" "hunchentoot" "html-template")
)

For more information on how to define systems, I recommend the ASDF howto or the ASDF manual.

At this stage we will have to make some changes to blog.lisp. First, we can remove any calls to require, as this is now handled by ASDF, since we have defined the packages that are required for this system. Second, I found that the initialization of our Elephant store and starting the web server had to be put into a separate function, or loading of the system would never complete.

Our new function, start-blog will simply wrap the existing code we have for initializing the store and starting the web server.

(defun start-blog ()
  "Open the Elephant store and start the web server."
  ; Open the store where our data is stored
 (defvar *elephant-store* (open-store '(:clsql (:sqlite3 "/tmp/blog.db"))))
  ; Start the web server
 (defvar *ht-server* (hunchentoot:start-server :port 8080))
)

We can also export this symbol, so that we can call this function from outside the my-blog package. This is done in the package definition, by using the :export parameter.

(defpackage :my-blog
  (:use :cl :elephant)
  (:export :start-blog)
)

At this stage we can load the blog using ASDF. The list *central-registry* contains a list of paths where it will look for system definitions, so we have to add the path to where our source code is (temporarily) to this list.

CL-USER> (let ((asdf:*central-registry* 
                (append asdf:*central-registry* '(#P"/Users/vetler/Documents/devel/cl-webapp-intro-part3/source/"))))
           (asdf:operate 'asdf:load-op 'my-blog))  
  

The required packages should now be loaded, and the blog can be started by running start-blog.

CL-USER> (my-blog:start-blog)
...
  

Packaging - step 1: ASDF-Installable

With many packages, it is possible to simply write (asdf-install:install :package-name to install them. This will search for the package on cliki.net and download the package if it can find it. asdf-install:install can also take a URL to where the package can be downloaded, which is what we will make it possible to do with our package now.

The first step is to remove the line in blog.lisp that sets html-template:*default-template-pathname*. When our package is installed, it will run within the context of the path where our source code is, so we don't need to worry about finding the templates.

Second, we create a .tar.gz package containing a directory with our files.

$ mkdir my-blog
$ cp blog.lisp my-blog.asd my-blog
$ tar zcvf my-blog.tar.gz my-blog
my-blog/
my-blog/blog.lisp
my-blog/my-blog.asd
$ 
  

Now we will have my-blog.tar.gz which we can upload to a web server and install with asdf-install:install.

(asdf-install:install "http://www.dirtyhack.org/vetler/docs/cl-webapp-intro/part-3/source/my-blog.tar.gz")
  

When installing, skip PGP check, and the application should now be installed. Now we can start it as before, by loading my-blog and running start-blog.

CL-USER> (require 'my-blog)
...
CL-USER> (my-blog:start-blog)
  

Alternativly you might have to use asdf:operate instead of require to load the system, like this: (asdf:operate 'asdf:load-op 'my-blog).

End of part 3

This concludes part 3 and ends this tutorial. We have now gone through how to create a simple web application using a few available packages. I hope you have enjoyed this short tutorial and that it can inspire you to implement web applications in Common Lisp.

There are many other packages available, and for web development and database access, I can also recommend Weblocks and CLSQL.