diff options
| -rw-r--r-- | spork/netrepl.janet | 72 | ||||
| -rw-r--r-- | spork/services.janet | 65 |
2 files changed, 116 insertions, 21 deletions
diff --git a/spork/netrepl.janet b/spork/netrepl.janet index 85db5ec..baf366d 100644 --- a/spork/netrepl.janet +++ b/spork/netrepl.janet @@ -34,6 +34,18 @@ (let [e (make-env)] (put e :pretty-format "%.20Q")))) +# +# Allow the netrepl functions to be called and waited on +# + +(defn- serve-and-wait + "Alternative to net/server that suspends the fiber until the server is closed." + [host port handler] + (def s (net/listen host port)) + (net/accept-loop s handler) + (:close s) + nil) + # NETREPL Protocol # # Clients don't need to support steps 4. and 5. if they never send messages prefixed @@ -111,22 +123,14 @@ (enter-debugger f x) (do (debug/stacktrace f x "") (eflush)))))) -(defn server - "Start a repl server. The default host is \"127.0.0.1\" and the default port - is \"9365\". Calling this will start a TCP server that exposes a - repl into the given env. If no env is provided, a new env will be created - per connection. If env is a function, that function will be invoked with - the name and stream on each connection to generate an environment. `cleanup` is - an optional function that will be called for each stream after closing if provided. - `welcome-msg` is an optional string or function (welcome-msg client-name) to generate - a message to print for the client on connection." - [&opt host port env cleanup welcome-msg] +(defn- server-impl + [server-ctor &opt host port env cleanup welcome-msg] (default host default-host) (default port default-port) (eprint "Starting networked repl server on " host ", port " port "...") (def name-set @{}) (def syspath (dyn :syspath)) - (net/server + (server-ctor host port (fn repl-handler [stream] @@ -266,10 +270,10 @@ (eprint "closing client " name) (when cleanup (cleanup stream))))) -(defn server-single +(defn- server-single-impl "Short-hand for serving up a a repl that has a single environment table in it. `env` must be a proper env table, not a function as is possible in netrepl/server." - [&opt host port env cleanup welcome-msg] + [server-ctor &opt host port env cleanup welcome-msg] (def client-table @{}) (def inverse-client-table @{}) (let [e (coerce-to-env (or env (make-env)) nil nil)] @@ -285,7 +289,43 @@ (put inverse-client-table stream nil)) (put e :pretty-format "%.20Q") (put e :clients client-table) - (server host port env-factory cleanup2 welcome-msg))) + (server-impl server-ctor host port env-factory cleanup2 welcome-msg))) + +### +### Server API +### + +(defn server + "Start a repl server. The default host is \"127.0.0.1\" and the default port + is \"9365\". Calling this will start a TCP server that exposes a + repl into the given env. If no env is provided, a new env will be created + per connection. If env is a function, that function will be invoked with + the name and stream on each connection to generate an environment. `cleanup` is + an optional function that will be called for each stream after closing if provided. + `welcome-msg` is an optional string or function (welcome-msg client-name) to generate + a message to print for the client on connection." + [&opt host port env cleanup welcome-msg] + (server-impl net/server host port env cleanup welcome-msg)) + +(defn server-single + "Short-hand for serving up a a repl that has a single environment table in it. `env` + must be a proper env table, not a function as is possible in netrepl/server." + [&opt host port env cleanup welcome-msg] + (server-single-impl net/server host port env cleanup welcome-msg)) + +(defn run-server + "Short-hand to more easily run `server` and wait until it has finished. Waits until the repl closes and returns nil." + [&opt host port env cleanup welcome-msg] + (server-impl serve-and-wait host port env cleanup welcome-msg)) + +(defn run-server-single + "Short-hand to more easily run `server-single` and wait until it has finished. Waits until the repl closes and returns nil." + [&opt host port env cleanup welcome-msg] + (server-single-impl serve-and-wait host port env cleanup welcome-msg)) + +### +### Client +### (defn- make-recv-client "Similar to msg/make-recv, except has exceptions for out-of-band @@ -333,6 +373,10 @@ (when doc-string (string "\n" (doc-format doc-string ,w 4 true)))))) +### +### Client API +### + (defn client "Connect to a repl server. The default host is \"127.0.0.1\" and the default port is \"9365\"." diff --git a/spork/services.janet b/spork/services.janet index 53ebe36..d04cec0 100644 --- a/spork/services.janet +++ b/spork/services.janet @@ -36,11 +36,11 @@ ### (defn- signal-handler - [service sig msg fiber] + [service service-name sig msg fiber] (def f (get service :logfile)) - (eprintf "%s from service %s: %.4q" sig service msg) - (with-dyns [*err* (get service :logfile)] - (debug/stacktrace fiber msg)) + (eprintf "%s from service %s: %.4q" sig service-name msg) + (with-dyns [*err* f] + (debug/stacktrace fiber msg "signal: ")) (put service :last-msg msg) (file/flush f)) @@ -58,7 +58,7 @@ (def service-name (or task-id (get services-inverse fiber))) (when-let [service (get services service-name)] (put service :status (fiber/status (get service :fiber))) - (protect (signal-handler service-name sig msg fiber))))) + (signal-handler service service-name sig msg fiber)))) (defn make-manager "Group a number of fibers into a single object for structured concurrency. @@ -98,7 +98,7 @@ (setdyn *out* logfile) (setdyn *err* logfile) (setdyn *pretty-format* "%.5q") - (xprintf logfile "started service %s - args: %q" service-name args) + (xprintf logfile "========================\nstarted service %s - args: %q" service-name args) (file/flush logfile) (setdyn *current-service* service) (setdyn *current-manager* manager) @@ -108,10 +108,13 @@ (put service :started-at (os/time)) (main-function ;args)) (def service @{:name service-name :logfile logfile :main main-function :args args}) - (def f (ev/go wrapper service (get manager :supervisor))) + (def f + (with-dyns [] + (ev/go wrapper service (get manager :supervisor)))) (put service :fiber f) (put (get manager :services) service-name service) (put (get manager :services-inverse) service service-name) + (ev/sleep 0) # one loop so that wrapper has been called service-name) (defn stop-service @@ -181,6 +184,54 @@ (ev/cancel (get manager :handler) "kill manager"))) ### +### Definition Helpers +### + +(defn run-subprocess + `` + Create a service entry function that runs in a subprocess. + Example usage: + + (services/add-service :my-service services/run-subprocess "janet-netrepl" "-s") + `` + [prog & args] + (def f (assert (dyn *out*))) + (assert (= :core/file (type f))) + (os/execute [prog ;args] :px {:out f :err f})) + +(defn run-module-in-thread + `` + A service entry function that will run on a module's function on a new thread. + Takes the name of a module to import and a function name, and will execute function of that module. + + Example usage: + + (services/add-service :my-service services/run-module-in-thread "spork/netrepl" 'run-server-single) + `` + [module-name &opt func & args] + (default func 'main) + (def f (assert (dyn *out*))) + (assert (= :core/file (type f))) + (def sp (dyn *syspath*)) + (def tid (dyn :task-id)) + (ev/do-thread + (try + (do + (setdyn *err* f) + (setdyn *out* f) + (setdyn *syspath* sp) + (setdyn *pretty-format* "%.5q") + (setdyn :task-id tid) + (def main (module/value (require module-name) (symbol func))) + (setdyn *args* [module-name ;args]) + (main ;(dyn *args*))) + ([err f] + (debug/stacktrace f err "in worker thread: ") + (file/flush f) # flush f after making error stack trace + (propagate f err))) + (file/flush f))) + +### ### Reporting ### |