|
|
|
(in-package #:cl-user)
|
|
|
|
(defpackage #:ritherdon-archive
|
|
|
|
(:use #:cl)
|
|
|
|
(:import-from #:ritherdon-archive.config
|
|
|
|
#:config)
|
|
|
|
(:import-from #:clack
|
|
|
|
#:clackup)
|
|
|
|
(:export #:start
|
|
|
|
#:stop
|
|
|
|
#:main))
|
|
|
|
(in-package #:ritherdon-archive)
|
|
|
|
|
|
|
|
(defvar *appfile-path*
|
|
|
|
(asdf:system-relative-pathname :ritherdon-archive #P"app.lisp"))
|
|
|
|
|
|
|
|
(defvar *handler* nil)
|
|
|
|
|
|
|
|
(defun start (&rest args &key server port debug &allow-other-keys)
|
|
|
|
(declare (ignore server port debug))
|
|
|
|
(when *handler*
|
|
|
|
(restart-case (error "Server is already running.")
|
|
|
|
(restart-server ()
|
|
|
|
:report "Restart the server"
|
|
|
|
(stop))))
|
|
|
|
(setf *handler*
|
|
|
|
(apply #'clackup *appfile-path* args)))
|
|
|
|
|
|
|
|
(defun stop ()
|
|
|
|
(prog1
|
|
|
|
(clack:stop *handler*)
|
|
|
|
(setf *handler* nil)))
|
|
|
|
|
|
|
|
#| 'main' Function Used For Starting Server From Script (I.E. Live Deployment)
|
|
|
|
================================================================================
|
|
|
|
https://lisp-journey.gitlab.io/web-dev/#building
|
|
|
|
The code below was taken from the URL above (with slight modifications). It's
|
|
|
|
main use is to make it easier to start the server via a script.
|
|
|
|
|#
|
|
|
|
(defun main (&key (port 5000))
|
|
|
|
(start :server :woo ; hunchentoot or woo.
|
|
|
|
:port port
|
|
|
|
:debug (if (ritherdon-archive.config:productionp)
|
|
|
|
nil
|
|
|
|
t))
|
|
|
|
;; with bordeaux-threads
|
|
|
|
(handler-case (bt:join-thread
|
|
|
|
(find-if (lambda (th)
|
|
|
|
(search "woo" (bt:thread-name th)))
|
|
|
|
(bt:all-threads)))
|
|
|
|
(#+sbcl sb-sys:interactive-interrupt
|
|
|
|
#+ccl ccl:interrupt-signal-condition
|
|
|
|
#+clisp system::simple-interrupt-condition
|
|
|
|
#+ecl ext:interactive-interrupt
|
|
|
|
#+allegro excl:interrupt-signal
|
|
|
|
() (progn
|
|
|
|
(format *error-output* "Aborting.~&")
|
|
|
|
(clack:stop *handler*)
|
|
|
|
(uiop:quit 1)) ;; portable exit, included in ASDF, already loaded.
|
|
|
|
;; for others, unhandled errors (we might want to do the same).
|
|
|
|
(error (c) (format t "Woops, an unknown error occured:~&~a~&" c)))))
|