Last active
January 30, 2024 13:52
-
-
Save higuoxing/779950f0e7b841dc669ef2ed879482cd to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| open Lwt | |
| let listen_addr = Unix.inet_addr_loopback | |
| let port = 5432 | |
| (* Shared mutable counter *) | |
| let counter = ref 0 | |
| let max_pending_req = 10 | |
| let handle_message msg = | |
| match msg with | |
| | "read" -> Printf.sprintf "%s\n" (string_of_int !counter) | |
| | "inc" -> counter := !counter + 1; "Counter is incremented!\n" | |
| | _ -> "Unknown command\n" | |
| let rec handle_conn ic oc () = | |
| Lwt_io.read_line_opt ic >>= | |
| (fun msg -> | |
| match msg with | |
| | Some msg -> | |
| let reply = handle_message msg in | |
| Lwt_io.write oc reply >>= handle_conn ic oc | |
| | None -> Logs_lwt.info (fun m -> m "Connection closed\n") >>= return) | |
| let accept_conn conn = | |
| let fd, _ = conn in | |
| let ic = Lwt_io.of_fd ~mode:Lwt_io.Input fd in | |
| let oc = Lwt_io.of_fd ~mode:Lwt_io.Output fd in | |
| Lwt.on_failure (handle_conn ic oc ()) (fun e -> Logs.err (fun m -> m "%s\n" (Printexc.to_string e))); | |
| Logs_lwt.info (fun m -> m "New connection\n") >>= return | |
| let create_server sock = | |
| let rec serve () = | |
| Lwt_unix.accept sock >>= accept_conn >>= serve | |
| in serve | |
| let create_socket () = | |
| let sock = Lwt_unix.socket Lwt_unix.PF_INET Lwt_unix.SOCK_STREAM 0 in | |
| Lwt_unix.bind sock @@ Lwt_unix.ADDR_INET (listen_addr, port) >>= fun () -> | |
| Lwt_unix.listen sock max_pending_req; | |
| return sock | |
| let () = | |
| Lwt_main.run ((create_socket ()) >>= fun sock -> | |
| let serve = create_server sock in serve ()) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment