Reorganize entry point code

dataserver.lisp

@@ -3,36 +3,51 @@
   (:export :program-entry))
 (in-package :ywatds)
 
+;; Databases
 (defparameter *ildb* nil)
 (defparameter *nodedb* nil)
 (defparameter *trackdb* nil)
 (defparameter *trackdb-temp* nil)
 
-(defun program-entry ()
-  (let* ((argv (uiop:command-line-arguments))
-	 (worldpath (uiop:ensure-pathname (car argv)
-					  :defaults (uiop:getcwd)
-					  :ensure-directory t
-					  :want-existing t
-					  :ensure-absolute t))
-	 (serverport (parse-integer (cadr argv)))
-	 (debugp (member "--debug" (cddr argv) :test #'string=))
-	 (server (make-instance 'easy-routes:routes-acceptor
-				:port serverport)))
-    (macrolet ((savefilepath (n)
-		 `(uiop:subpathname worldpath (format nil "advtrains_~a" ,n)))
-	       (load-data ()
-		 (alexandria:with-gensyms (tf tl)
+;; Command-line arguments
+(defparameter *debugp* nil)
+(defparameter *world-path* nil)
+;; Note: do NOT change *server-port* and *server* at debug time
+(defparameter *server-port* nil)
+(defparameter *server* nil)
+
+(defmacro ensure-world-path (path)
+  `(uiop:ensure-pathname ,path :defaults (uiop:getcwd) :ensure-directory t
+			 :want-existing t :ensure-absolute t))
+
+(defmacro savefilepath (name)
+  `(uiop:subpathname *world-path* (concatenate 'string "advtrains_" ,name)))
+
+(defmacro load-data ()
+  (alexandria:with-gensyms (tdb tdbtemp)
     `(progn
        (setf *ildb* (atil:import-data (savefilepath "interlocking.ls")))
-		      (setf *nodedb* (ndb:import-data (savefilepath "ndb4.ls")))
-		      (multiple-value-bind (,tf ,tl) (tracks:import-data *nodedb*)
-			(setf *trackdb* ,tf)
-			(if debugp (setf *trackdb-temp* ,tl)))
-		      (if (not debugp) (setf *nodedb* nil))
-		      (hunchentoot:acceptor-log-message server :info "Database updated"))))
-	       (mainloop ()
-		 `(loop (load-data) (sleep 20))))
+       (if *debugp* (progn (setf *nodedb* (ndb:import-data (savefilepath "ndb4.ls")))
+			   (multiple-value-bind (,tdb ,tdbtemp)
+			       (tracks:import-data *nodedb*)
+			     (psetf *trackdb* ,tdb *trackdb-temp* ,tdbtemp)))
+	   (setf *trackdb* (tracks:import-data (ndb:import-data (savefilepath "ndb4.ls")))))
+       (hunchentoot:acceptor-log-message *server* :info "Database updated"))))
+
+(defmacro mainloop ()
+  `(loop (load-data) (sleep 20)))
+
+(defun program-entry ()
+  (let ((argv (uiop:command-line-arguments)))
+    (setf *world-path* (ensure-world-path (car argv)))
+    (setf *server-port* (coerce (parse-integer (cadr argv)) '(integer 0 65535)))
+    (setf *debugp* (member "--debug" (cddr argv) :test #'string=))
+    (setf *server* (make-instance 'easy-routes:routes-acceptor :port *server-port*))
+    (register-routes)
+    (register-debugging-routes)
+    (start-server)))
+
+(defun register-routes ()
   (ywsw:safe-text-route
    dumpser
    ("/dumpser/:p" :method :get) (&path (p 'string))
@@ -40,12 +55,12 @@
    (format nil "~s" (atsl:from-file (savefilepath p) :alist)))
   (ywsw:safe-text-route
    pretty-dump-interlocking
-       ("/pretty_dump/interlocking" :method :get) ()
+   ("/pretty-dump/interlocking" :method :get) ()
    ("Return the interlocking database that is in use")
    (format nil "~s" *ildb*))
   (ywsw:safe-text-route
    pretty-dump-registered-tracks
-       ("/pretty_dump/registered_tracks" :method :get) ()
+   ("/pretty-dump/registered-tracks" :method :get) ()
    ("Return the list of tracks known to the server")
    (tracks:dump-track-definitions))
   (ywsw:safe-json-route
@@ -108,15 +123,31 @@
 	 "Documentation"
 	 `("h2" () "Documentation")
 	 `("ul" () ,@(loop for i in (stable-sort entries #'string<)
-			    collect `("li" () ("a" ("href" ,(format nil "/doc/http_~a" i))
-						   ,i)))))))
-      (tracks:init-tracks)
-      (hunchentoot:start server)
-      (hunchentoot:acceptor-log-message server :info "~s"
+			collect `("li" () ("a" ("href" ,(format nil "/doc/http-~a" i))
+					       ,i))))))))
+
+(defun register-debugging-routes ()
+  (macrolet
+      ((debug-routes (&body body)
+	 `(progn ,@(loop for i in body collect
+			`(ywsw:safe-text-route
+			  ,(car i) ,(cadr i) ,(caddr i)
+			  ,(cons "<b>[Only available in debugging mode]</b> " (cadddr i))
+			  (if *debugp* (progn ,@(cddddr i))
+			      "Debugging mode is disabled. Please run the server with --debug or set ywatds::*debugp* to a non-nil value."))))))
+    (debug-routes
+     (debug-room ("/debug/room" :method :get) () ("Dumps the output of <code>(room t)</code>")
+		 (with-output-to-string (*standard-output*) (room t)))
+     (debug-routes ("/debug/routes" :method :get) () ("List defined routes")
 		   (with-output-to-string (s)
-					  (describe easy-routes:*routes-mapper* s)))
+		     (describe easy-routes:*routes-mapper* s))))))
+
+(defun start-server ()
+  (tracks:init-tracks)
+  (hunchentoot:start *server*)
   ;; loop until an error occurs
-      (if debugp (mainloop) (ignore-errors (mainloop)))
+  (if *debugp* (mainloop) (handler-case (mainloop)
+			    (t (c) (format *error-output* "~&~a~%" c))))
   (ignore-errors
-	(hunchentoot:stop server)
-	(uiop:quit)))))
+    (hunchentoot:stop *server*)
+    (uiop:quit)))

server-wrapper.lisp

@@ -55,7 +55,7 @@
 		 "</b><i>\\1</i><b>")))
       `(progn
 	 (defsafe
-	     ,docroute ,(format nil "/doc/http_~a" lowername) ()
+	     ,docroute ,(format nil "/doc/http-~a" lowername) ()
 	     (wrap-html
 	      ,(format nil "API ~a" lowername)
 	      ,(toxml-multiple