Booting and customizing a simple Lisp website

Here are a couple techniques I use for setting up a CL website that runs at boot time. They're not especially generic or reusable as-is, but I hope the ideas are useful.

Booting: Here's how I make sure l1sp.org starts when I reboot my Linux box.

/etc/rc.local:

su xach -c 'screen -d -m -S l1sp -c /opt/l1sp/etc/screenrc'

/opt/l1sp/etc/screenrc:

setenv SBCL_HOME "/opt/l1sp/lib/sbcl"
setenv PATH "/opt/l1sp/bin:${PATH}"

screen /opt/l1sp/bin/l1sp --load /opt/l1sp/etc/init.lisp
screen emacs -q -l /opt/l1sp/etc/init.el
screen tail -f /var/log/nginx/l1sp.org.log

chdir /opt/l1sp

/opt/l1sp/etc/init.lisp:

(defpackage #:l1sp-init
  (:use #:cl))

(in-package #:l1sp-init)

(defvar *swank-port* 7717)
(defvar *tbnl-port* 7718)
(defvar *tbnl-server*)

(require 'redirector)
(redirector:initialize)

(swank:create-server :port *swank-port*
                     :dont-close t)

(setf *tbnl-server* (tbnl:start-server :port *tbnl-port*))

/opt/l1sp/etc/init.el:

(require 'cl)

;;; elisp setup

(defun xach-generic-code-setup ()
  (setq indent-tabs-mode nil)
  (local-set-key "\C-m" 'newline-and-indent))

(add-hook 'emacs-lisp-mode-hook
	  (defun xach-emacs-setup ()
	    (interactive)
	    (xach-generic-code-setup)
	    (eldoc-mode t)))

(setq indent-tabs-mode nil)

;;; CL setup

(push "/opt/l1sp/src/slime" load-path)
(require 'slime)
(slime-setup '(slime-autodoc slime-fancy-inspector slime-editing-commands))
(setq slime-port 7717)

(add-hook 'lisp-mode-hook
          (defun xach-lisp-setup ()
            (interactive)
            (xach-generic-code-setup)))

(global-set-key "\C-cs" 'slime-selector)

Customizing: Here's how I make the customized /opt/l1sp/bin/l1sp executable. This is the nth of m iterations an idea I've been using for a while.

customizer.lisp:

;;;; customizer.lisp

(require :asdf)
(require :sb-posix)

(defpackage #:sbcl-customizer
  (:use #:cl))

(in-package #:sbcl-customizer)

(defparameter *customize-system-directory*
  (probe-file (sb-posix:getenv "CUSTOMIZE_DIR")))

(defun bomb-out (condition hook-value)
  (declare (ignore hook-value))
  (format *error-output* "~&unhandled ~S:~2%~4T~A~2%"
          (type-of condition)
          condition)
  (sb-ext:quit :unix-status 1))

(setf sb-ext:*invoke-debugger-hook* 'bomb-out)

(defun load-if-present (file)
  (when (probe-file file)
    (format *trace-output* "~&;; loading ~A~%" file)
    (load file)))

(defun pathname-system-name (pathname)
  "What system does PATHNAME end with? E.g. #\"/foo/bar/baz/\" => \"baz\"."
  (first (last (pathname-directory (pathname pathname)))))

(defun customize-file-name (system-name filename)
  (merge-pathnames (make-pathname :directory (list :relative system-name)
                                  :type "lisp"
                                  :name filename)
                   *customize-system-directory*))

(defun all-customize-files (system-name)
  (let* ((pathname (customize-file-name system-name :wild))
         (files (directory pathname)))
    (remove-if (lambda (name)
                 (member name '("pre" "post") :test #'string=))
               files
               :key #'pathname-name)))


(defun customize (system-name)
  (let ((pre (customize-file-name system-name "pre"))
        (post (customize-file-name system-name "post")))
    (load-if-present pre)
    ;; Ugh. This FIND-SYSTEM is mostly so asdf can be customized, even          
    ;; though you can't asdf:load-op it.                                        
    (unless (find-package (string-upcase system-name))
      (asdf:oos 'asdf:load-op system-name))
    (dolist (file (all-customize-files system-name))
      (load-if-present file))
    (load-if-present post)))

(defun customized-systems (pathname)
  (let ((files (directory (merge-pathnames "*/*.lisp" pathname))))
    (remove-duplicates (mapcar #'pathname-system-name files)
                       :test #'string=)))

(defun main ()
  (let ((systems (customized-systems *customize-system-directory*)))
    (load-if-present (merge-pathnames "global.lisp"
                                      *customize-system-directory*))
    (dolist (system systems)
      (customize system))
    (sb-ext:without-package-locks
      (setf (fdefinition 'sb-int:sbcl-homedir-pathname)
            (constantly (sb-posix:getenv "NEW_SBCL_HOME"))))
    (setf sb-impl::*sysinit-pathname-function* (constantly nil))
    (setf sb-impl::*userinit-pathname-function* (constantly nil))
    (setf sb-ext:*invoke-debugger-hook* nil)
    (sb-ext:save-lisp-and-die (sb-posix:getenv "OUTPUT_FILE") :executable t)))

(main)

customizer.sh:

#!/bin/bash                                                                     

function usage () {
    echo "customizer.sh SBCL COREFILE CUSTOMIZE-DIR OUTPUT-FILE NEW-SBCL-HOME"
    exit 1;
}

function check_arg () {
    if [ -z "$1" ];then
	usage
    fi
}

SBCL=$1
CORE=$2
CUSTOMIZE_DIR=$3
OUTPUT_FILE=$4
NEW_SBCL_HOME=$5

check_arg "$SBCL"
check_arg "$CORE"
check_arg "$CUSTOMIZE_DIR"
check_arg "$OUTPUT_FILE"
check_arg "$NEW_SBCL_HOME"

export CUSTOMIZE_DIR OUTPUT_FILE NEW_SBCL_HOME

$SBCL --core $CORE \
    --disable-debugger \
    --userinit /dev/null \
    --sysinit /dev/null \
    --load "customizer.lisp"

Here's the tree of customization files I load for l1sp.org:

swank/pre.lisp
html-template/no-warnings.lisp
asdf/recompile-stale.lisp
asdf/misc-useful.lisp
asdf/l1sp-registry.lisp
global.lisp
hunchentoot/post.lisp

They do things like set up a fixed location for l1sp asdf systems, turn off html-template warnings, etc.