Public archive for the Return to Ritherdon project.
https://www.nicolaellisandritherdon.com
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
60 lines
2.0 KiB
60 lines
2.0 KiB
(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)))))
|
|
|