diff options
| -rw-r--r-- | client.el | 6 | ||||
| -rw-r--r-- | flake.nix | 6 | ||||
| -rw-r--r-- | lib/dune | 2 | ||||
| -rw-r--r-- | lib/server.ml | 40 |
4 files changed, 47 insertions, 7 deletions
@@ -9,7 +9,7 @@ (delete-process process))) (setq relational-engine-address "localhost") -(setq relational-engine-port 4457) +(setq relational-engine-port 7524) (defun relational-client (content) "" @@ -18,7 +18,7 @@ (set-process-filter connection 'relational-engine-handler) (process-send-string connection content))) -(setq msg "read") +(setq msg "Hello Relational Engine! :)") -(relational-client msg) +(relational-client msg)x *mailbox* @@ -97,7 +97,7 @@ ocamlPackages.ppx_deriving ocamlPackages.ppx_sexp_conv ocamlPackages.lwt - ocamlPackages.lwt_log + ocamlPackages.lwt-exit ]; strictDeps = true; @@ -171,7 +171,7 @@ ocamlPackages.ppx_deriving ocamlPackages.ppx_sexp_conv ocamlPackages.lwt - ocamlPackages.lwt_log + ocamlPackages.lwt-exit ]; } '' echo "checking dune and ocaml formatting" @@ -262,7 +262,7 @@ legacyPackages.gcc # legacyPackages.nixfmt-classic ocamlPackages.lwt - ocamlPackages.lwt_log + ocamlPackages.lwt-exit ]; @@ -1,6 +1,6 @@ (library (name relational_engine) - (libraries ctypes ctypes-foreign data-encoding lwt lwt.unix lwt_log) + (libraries ctypes ctypes-foreign data-encoding lwt lwt.unix lwt-exit) (preprocess (pps ppx_deriving.show ppx_sexp_conv)) ;; (c_library_flags -lssl -lcrypto -L %{env:LIBRESSL_LIB_PATH=}) ;; (foreign_stubs diff --git a/lib/server.ml b/lib/server.ml new file mode 100644 index 0000000..28f2ead --- /dev/null +++ b/lib/server.ml @@ -0,0 +1,40 @@ +open Lwt +open Unix + +let host = Unix.inet_addr_loopback +let port = 7524 + +let create_socket (): Lwt_unix.file_descr t = + let sock = Lwt_unix.socket PF_INET SOCK_STREAM 0 in + Lwt_unix.set_close_on_exec sock; + Lwt_unix.setsockopt sock Unix.SO_REUSEADDR true; + let () = Lwt_unix.set_blocking sock false in + Lwt_io.write_line Lwt_io.stdout "🔍 Relational Engine Server Started" >>= fun () -> + Lwt_unix.bind sock @@ ADDR_INET(host, port) >>= (fun () -> Lwt_unix.listen sock 10; return sock) + +let client_read sock maxlen = + let str = Bytes.create maxlen in + let rec _read sock acc = + Lwt_unix.read sock str 0 maxlen + >>= fun recvlen -> Lwt_io.write_line Lwt_io.stdout (string_of_int recvlen) + >>= fun () -> if recvlen <= maxlen + then Lwt.return acc + else _read sock (acc ^ (Bytes.to_string (Bytes.sub str 0 recvlen))) + in _read sock "" + +let rec socket_read sock = + Lwt_unix.accept sock + >>= fun (client, _) -> client_read client 512 + >>= fun results -> Lwt_io.write_line Lwt_io.stdout results + >>= fun () -> Lwt_unix.close client + >>= fun () -> socket_read sock + +let start() = + Stdlib.exit + @@ Lwt_main.run begin + Lwt_exit.wrap_and_exit (create_socket ()) >>= fun sock -> + let clean_callback = Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> Lwt_io.write_line Lwt_io.stdout "💥 Shutting down" >>= fun () -> Lwt_unix.close sock) in + Lwt_exit.wrap_and_exit (socket_read sock) >>= fun () -> + let () = Lwt_exit.unregister_clean_up_callback clean_callback in + Lwt_exit.exit_and_wait 0 + end |