Application Delivery of a long-term application in Clozure CL
All the basic application delivery examples show how to replace the top-level function with your own. After performing this function, the application exits. I was wondering what is the best way to create a top-level function for an application that has been running for a long time. My code
(ql:quickload :my-app)
(defun main ()
(swank:create-server :dont-close t)
(my-app:start-server) ; Essentially creates a hunchentoot handler and returns
(loop for x = (read-line)
when (string= x "q") do (quit)
do (format t "Type q to quit~%" x)))
(save-application "my-app" :toplevel-function #'main :prepend-kernel t)
Is there a better way? I don't like the loop, but something that frees up the terminal is okay too.
source to share
As you say, after the main function completes, the application exits. Ergo, you want the function to work until you want to exit the application.
The simplest solution is to just leave the main loop in an infinite loop sleep
:
(defun main ()
(swank:create-server :dont-close t)
(my-app:start-server)
(loop (sleep 60)))
When you start the Swank server, you can enable features to cleanly log out of the application over the SLIME connection. For example, you can write something like the following using a package bt-semaphore
:
(defvar *quit-my-app* (bt-semaphore:make-semamphore))
(defun main ()
(swank:create-server :dont-close t)
(my-app:start-server)
(bt-semaphore:wait-on-semaphore *quit-my-app*)
(my-app:clean-up)) ; or whatever you need to do for cleaning up
(defun quit-my-app ()
(bt-semaphore:signal-semaphore *quit-my-app*))
Now you can just evaluate (quit-my-app)
on the SLIME connection to close the application.
You can also use the main thread for serving. On my server, I am doing a simple log rotation:
(defun seconds-until-tomorrow ()
(multiple-value-bind (second minute hour day month year daylight-p zone)
(decode-universal-time (+ (get-universal-time) (* 60 60 26))) ; safely tomorrow
(declare (ignore second minute hour daylight-p))
(- (encode-universal-time 0 0 0 day month year zone)
(get-universal-time))))
(defun main ()
(swank:create-server :dont-close t)
(let (cur-logfile
cur-logfile-name
;; assuming that start-server returns the Hunchentoot acceptor
(acpt (my-app:start-server)))
(loop
(let* ((lf-stem (log-file-name))
(logfile-name (merge-pathnames lf-stem *temp-path*))
(new-logfile (open logfile-name :direction :output
:if-exists :append
:if-does-not-exist :create)))
(setf (hunchentoot:acceptor-message-log-destination acpt) new-logfile
(hunchentoot:acceptor-access-log-destination acpt) new-logfile)
(when cur-logfile
(close cur-logfile)
(run-program "/usr/bin/xz" (list (princ-to-string cur-logfile-name))))
(setf cur-logfile new-logfile
cur-logfile-name logfile-name)
(when (bt-semaphore:wait-on-semaphore *quit-my-app* (seconds-until-tomorrow))
(return)))))
source to share