Using Cookies

Cookies provide a way of storing a limited amount of information on the user's browser. Typical uses include session tracking, and user authentication.

This example shows how to use cookies to store a user's login information, so that once they have logged in to a protected area of the Web site, they can remain logged in for the session, or for a specified time.

Full listing

Using cookies with CL-HTTP

CL-HTTP provides two main routines for working with cookies:

  • set-cookie-http-headers constructs a header to store a cookie in the user's browser.
  • with-cookie-values reads the values of one or more cookies and executes the body with the values variables bound to variables of the same name.

Password file

We first create a password file that will store an association-list of user names and one-way digests:

(defparameter *password-file* nil)
To construct the digest we use the routine in the CL-HTTP md5 package, md5-digest-hexadecimal-string:
(defun digest-user (username password)
  (md5:md5-digest-hexadecimal-string (concatenate 'string username password)))

The password file only contains the md5 digests, not the passwords, so even if someone gets access to the file it is hard for them to work out the password for a given user. We include the user name in constructing the digest to ensure that even if two users have chosen the same password, they will have different digests.

Here's the routine to create a user and password:

(defun create-user (name password)
  (push (cons name (digest-user name password)) *password-file*))

Note that in an actual application there would also need to be some way of saving the password file to disk and reloading it.

Page generating macro

First we create a with-headers-page macro to emit a page. This is almost identical to the with-page macro used in Generating HTML, but with the addition of a :headers keyword to allow us to add headers to the page:

(defmacro with-headers-page ((stream title &key headers) &body body)
  "Provides the response function to emit a page body."
  `(with-successful-response (,stream :html :additional-headers ,headers)
     (with-html-document (:stream ,stream)
       (with-document-preamble (:stream ,stream)
         (declare-title ,title :stream ,stream))
       (with-document-body (:stream ,stream)
         (with-section-heading (,title :stream ,stream)
           ,@body)))))

The login page

The login page displays fields for the user name and password, and then submits the form to the response page:

cookies1.png

Here's the definition:

(defun display-login-page (url stream &optional error)
  "Form function to display a login form."
  (declare (ignore url))
  (with-headers-page (stream "Login")
    (when error
      (with-paragraph (:stream stream :style "color:red")
        (write-string error stream)))
    (with-fillout-form (:post "/login.html" :stream stream)
      (with-paragraph (:stream stream)
        (accept-input 'string "name" :label "User Name:" :stream stream :size 36))
      (with-paragraph (:stream stream)
        (accept-input 'password "password" :label "Password:" :stream stream :size 36)
        (accept-input 'submit-button "Login" :display-string "Login" :stream stream)))))

It includes an optional error argument to allow us to include an error string, which is displayed in red.

The with-fillout-form macro includes an explicit url parameter to post the form to /login.html, so we can use the same routine to display the login form from a different url.

The Successful login page

The respond-to-login response page checks that the user name and digest are valid, and then displays the Successful login page:

cookies2.png

This provides a Continue link to go to the first restricted page.

The Successful login page uses the routine set-cookie-http-headers to define the cookies name and digest to store the user's login details in the user's browser:

(defun respond-to-login (url stream alist)
  "Response function to process the login."
  (bind-query-values (name password) (url alist)
    (let ((user (lookup-user name))
          (digest (digest-user name password)))
      (if (or (null user) (not (equal digest (cdr user))))
          (display-login-page url stream "Invalid user name and/or password.")
        ;; Successful login
        (let ((title "Successful login")
              (cookie (http:set-cookie-http-headers
                        (:name name :expires nil :domain ".localhost" :path "/")
                        (:digest digest :expires nil :domain ".localhost" :path "/"))))
          (with-headers-page (stream title :headers cookie)
            (with-paragraph (:stream stream)
              (write-string "Welcome!" stream))
            (note-anchor "Continue" :reference "/user.html" :stream stream)))))))

The cookies are defined with the :expires parameter set to nil, which makes the cookies expire at the end of the browser session. If you want to give the cookies a specific expiry time, use the routine:

(defun in-n-days (n) (+ (get-universal-time) (* 60 60 24 n)))

For example, to make a 30-day cookie:

:expires (in-n-days 30)

Here's the procedure to export the URL of the login page:

(export-url "http://localhost:8000/login.html"
            :html-computed-form
            :form-function 'display-login-page
            :response-function 'respond-to-login)

Avoiding the Continue link

It may seem that the Successful login page iintroduces a superfluous page fetch. However, we need to validate the user name and password posted by the user before we can set the cookie, and the cookie can only be set by a page fetch.

If you want to avoid the need for the user to do an extra click through, one solution is to do an automatic redirect:

(defun respond-to-login (url stream alist)
  "Response function to process the login."
  (bind-query-values (name password) (url alist)
    (let ((user (lookup-user name))
          (digest (digest-user name password)))
      (if (or (null user) (not (equal digest (cdr user))))
          (display-login-page url stream "Invalid user name and/or password.")
        ;; Successful login
        (let ((title "Successful login")
              (cookie (http:set-cookie-http-headers
                       (:name name :expires nil :domain ".localhost" :path "/")
                       (:digest digest :expires nil :domain ".localhost" :path "/")))
              (refresh (list :refresh "1;URL=/user.html")))
          (with-headers-page (stream title :headers (append cookie refresh))
            (with-paragraph (:stream stream)
              (write-string "Logging in..." stream))))))))

Here we add a refresh header that displays "Logging in..." and redirects to /user.html after 1 second.

Validating pages

Pages that should only be accessible to logged-in users use the following macro:

(defmacro with-valid-user ((user url stream) &body body)
  `(http:with-cookie-values ((name digest))
     (let ((,user (valid-login name digest ,url ,stream)))
       (when ,user ,@body))))

This reads the name and digest cookies and checks that the user name and digest are valid using the routine valid-login:

(defun valid-login (name digest url stream)
  (cond
   ((null name) (display-login-page url stream "You need to login to access this page.") nil)
   (t (let ((user (lookup-user name)))
        (cond
         ((or (null user) (not (equal (cdr user) digest)))
          (display-login-page url stream "Invalid user/password.") nil)
         (t user))))))

An example is the following User page:

cookies3.png

This includes a logout link to allow the user to log out:

(defun write-user-page (url stream)
  (with-valid-user (user url stream)
    (with-headers-page (stream "User Page")
      (with-paragraph (:stream stream)
      (format stream "User ~a page" (car user)))
      (note-anchor "Log out" :reference "/logout.html" :stream stream))))

This is exported with the following routine:

(export-url "http://localhost:8000/user.html"
            :computed
            :response-function 'write-user-page)

Logout page

Finally we define the logout page. This clears both the cookies by setting their expiry to a time in the past, such as zero:

(defun write-logout-page (url stream)
  (declare (ignore url))
  (let ((headers (http:set-cookie-http-headers
                  (:name "" :expires 0 :domain ".localhost" :path "/")
                  (:digest "" :expires 0 :domain ".localhost" :path "/"))))
    (with-headers-page (stream "Logout" :headers headers)
      (with-paragraph (:stream stream)
        (write-string "Logged out" stream)))))

Here's the export definition:

(export-url "http://localhost:8000/logout.html"
            :computed
            :response-function 'write-logout-page)

blog comments powered by Disqus