Permalink
e3e0328 Sep 24, 2018
2 contributors

Users who have contributed to this file

@fukamachi @snmsts
executable file 165 lines (137 sloc) 5.17 KB
#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
#|
A command-line interface for clack:clackup.
|#
(ql:quickload '(:uiop :split-sequence) :silent t)
(import 'split-sequence:split-sequence)
(defun help ()
(format t "~&Usage:
# run the .lisp file
~A hello.lisp
# switch server handler with --server
~:*~A --server :wookie --port 8080 hello.lisp
The .lisp file is a Common Lisp file which ends with a form
that returns a Clack application, typically LAMBDA.
Options:
--server
Selects a specific server handler to run on.
The value has to be a keyword like \":wookie\".
--port
Binds to a TCP port. Defaults to 5000.
--use-default-middlewares
A flag if use default middlewares. The default is T.
Specify NIL for preventing from loading those middlewares.
-S, --source-registry
Append ASDF source registry to the default.
(Unlike Roswell's, this doesn't override it)
-s, --system
Load systems.
-l, --load
Load a file before starting a server.
--help
Shows this message.
"
(read-from-string
(second (assoc "script"
(let ((*read-eval*))
(read-from-string (uiop:getenv "ROS_OPTS")))
:test 'equal)))))
;; Prevent a symbol conflict with CCL:TERMINATE.
(defun %terminate (code &optional message args)
(when message
(format *error-output* "~&Error: ~A~%"
(apply #'format nil (princ-to-string message) args)))
(uiop:quit code))
(defun starts-with (x starts)
(and (<= (length starts) (length x))
(string= x starts :end1 (length starts))))
(defun parse-args (args)
(flet ((parse-value (value)
(handler-case
(let ((read-value (read-from-string value)))
(typecase read-value
(boolean read-value)
((and symbol (not keyword)) value)
(otherwise read-value)))
(error ()
value))))
(loop with app-file = nil
for option = (pop args)
for value = (pop args)
while option
if (or (string= option "--source-registry")
(string= option "-S"))
append (list :source-registry value)
into opt-args
else if (or (string= option "--system")
(string= option "-s"))
collect value into load-systems
else if (or (string= option "--load")
(string= option "-l"))
collect value into load-files
else if (not (starts-with option "--"))
do (if app-file
(error "Invalid option: ~S" option)
(progn
(setf app-file option)
(push value args)))
else if (string-equal option "--server")
append (list :server
(let ((parsed (parse-value value)))
(if (keywordp parsed)
parsed
(intern (string-upcase value) :keyword))))
into key-args
else
append (list (intern (string-upcase (subseq option 2)) :keyword)
(parse-value value))
into key-args
finally
(return (values app-file key-args
(list* :load load-files :systems load-systems opt-args))))))
(defun parse-server-starter-port ()
(flet ((parse-host-port (host-port)
(parse-integer
(let ((colon-pos (position #\: host-port)))
(if colon-pos
(subseq host-port (1+ colon-pos))
host-port)))))
(let ((ss-ports (uiop:getenv "SERVER_STARTER_PORT")))
(when (stringp ss-ports)
(destructuring-bind (host-port fd)
(split-sequence #\=
;; Assuming the first binding is for the Clack web server.
(car (split-sequence #\; ss-ports :count 1)))
(values (parse-host-port host-port)
(parse-integer fd)))))))
(defun main (&rest args)
(when (or (null args)
(equal (first args) "--help"))
(help)
(uiop:quit -1))
(ql:quickload :clack :silent t)
(multiple-value-bind (app-file key-args opt-args)
(parse-args args)
(unless (probe-file app-file)
(%terminate -1 "File doesn't exist: ~A" app-file))
;; Add ASDF source-registry
(when (getf opt-args :source-registry)
(asdf:compute-source-registry (truename (getf opt-args :source-registry))))
;; Load systems
(mapc #'ql:quickload (getf opt-args :systems))
;; Load files
(mapc #'load (getf opt-args :load))
;; Add :port and :fd from Server::Starter's environment var.
(multiple-value-bind (port fd)
(parse-server-starter-port)
(when port
(setf key-args (append key-args (list :port port :fd fd)))))
;; Disable threads
(setf (getf key-args :use-thread) nil)
;; Disable debugger
(setf (getf key-args :debug) nil)
(apply (intern (string :clackup) :clack) app-file key-args)))