From 7b1ec728cf66ca316a84dac02b6a4cbf6b012dc8 Mon Sep 17 00:00:00 2001 From: orbifx Date: Fri, 31 Aug 2018 23:07:20 +0100 Subject: [PATCH] Introduce client & parser, switch to Dune - Server and client now have dedicated module files - Menu and Item have their own module files - Wrote parsers for Menu and Item - Switch from jbuilder to dune - Introducing gopher client - IPv6 --- dune-project | 2 ++ gopher.opam | 9 +++--- src/dune | 5 +++ src/gopher.ml | 74 ------------------------------------------- src/item.ml | 80 +++++++++++++++++++++++++++++++++++++++++++++++ src/jbuild | 6 ---- src/lwt_client.ml | 21 +++++++++++++ src/lwt_server.ml | 24 ++++++++++++++ src/menu.ml | 5 +++ 9 files changed, 142 insertions(+), 84 deletions(-) create mode 100644 dune-project create mode 100644 src/dune create mode 100644 src/item.ml delete mode 100644 src/jbuild create mode 100644 src/lwt_client.ml create mode 100644 src/lwt_server.ml create mode 100644 src/menu.ml diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..c7ec22a --- /dev/null +++ b/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.3) +(name gopher) \ No newline at end of file diff --git a/gopher.opam b/gopher.opam index 66d162d..e540708 100644 --- a/gopher.opam +++ b/gopher.opam @@ -1,16 +1,17 @@ opam-version: "1.2" name: "gopher" -version: "0.1.0" -homepage: "https://cgit.orbitalfox.eu/ocaml-gopher/about" +synopsis: "OCaml library for creating Gopher applications" +homepage: "https://cgit.orbitalfox.eu/ocaml-gopher" +doc: "README.md" dev-repo: "git://orbitalfox.eu/ocaml-gopher" bug-reports: "mailto:sp@orbitalfox.eu" maintainer: "Stavros Polymenis " authors: "Stavros Polymenis " license: "EUPL" build: [ - ["jbuilder" "build" "--root" "." "-j" jobs "@install"] + ["dune" "build" "--root" "." "-j" jobs "@install"] ] depends: [ - "jbuilder" {build} + "dune" {build} "lwt" ] diff --git a/src/dune b/src/dune new file mode 100644 index 0000000..52e0cd0 --- /dev/null +++ b/src/dune @@ -0,0 +1,5 @@ +(library + (name gopher) + (public_name gopher) + (modules menu item lwt_server lwt_client) + (libraries lwt lwt.unix)) diff --git a/src/gopher.ml b/src/gopher.ml index 38c13e4..e69de29 100644 --- a/src/gopher.ml +++ b/src/gopher.ml @@ -1,74 +0,0 @@ -module Item = struct - type t = - | Text_file - | Submenu - | CCSO_nameserver - | Error - | Binhexencoded_file - | DOS_file - | Uuencoded_file - | Text_search - | Telnet - | Binary_file - | Alternate_server - | GIF_file - | Image_file - | Telnet_3270 - | HTML_file - | Informational_message - | Sound_file - - let char = function - | Text_file -> '0' - | Submenu -> '1' - | CCSO_nameserver -> '2' - | Error -> '3' - | Binhexencoded_file -> '4' - | DOS_file -> '5' - | Uuencoded_file -> '6' - | Text_search -> '7' - | Telnet -> '8' - | Binary_file -> '9' - | Alternate_server -> '+' - | GIF_file -> 'g' - | Image_file -> 'I' - | Telnet_3270 -> 'T' - | HTML_file -> 'h' - | Informational_message -> 'i' - | Sound_file -> 's' - - let v item user_display selector hostname port = - let (<+>) a b = a ^ "\t" ^ b in - (Char.escaped (char item)) ^ user_display <+> selector <+> hostname <+> string_of_int port <+> "\r\n" -end - -module Menu = struct - let ending = "\n." -end - -module Lwt = struct - let apply handler (file_descr, socket) = - let open Lwt.Infix in - let buf = Bytes.create 256 in - Lwt_unix.read file_descr buf 0 (Bytes.length buf) - >>= (fun x -> - let response = handler @@ Bytes.(to_string (sub buf 0 x)) in - Lwt_unix.write_string file_descr response 0 (String.length response) - ) - >>= (fun x -> Lwt_unix.(shutdown file_descr SHUTDOWN_ALL); Lwt.return_unit) - - let rec accept_all handler socket () = - let open Lwt.Infix in - Lwt_unix.accept socket - >>= (fun pair -> Lwt.catch (fun () -> apply handler pair) (fun exn -> prerr_endline (Printexc.to_string exn); Lwt.return_unit)) - >>= accept_all handler socket - - let gopherd ?(host="") ?(port=70) ?(request_queue_size=128) handler = - let open Lwt.Infix in - let socket = Lwt_unix.(socket PF_INET6 SOCK_STREAM 0) in - Lwt_unix.setsockopt socket SO_REUSEADDR true; - let host = if host = "" then Unix.inet6_addr_any else Unix.inet_addr_of_string host in - let bind = Lwt_unix.bind socket Unix.(ADDR_INET (host, port)) in - Lwt_unix.listen socket request_queue_size; - Lwt_main.run (bind >>= accept_all handler socket) -end diff --git a/src/item.ml b/src/item.ml new file mode 100644 index 0000000..bba913e --- /dev/null +++ b/src/item.ml @@ -0,0 +1,80 @@ +type item_t = + | Text_file + | Submenu + | CCSO_nameserver + | Error + | Binhexencoded_file + | DOS_file + | Uuencoded_file + | Text_search + | Telnet + | Binary_file + | Alternate_server + | GIF_file + | Image_file + | Telnet_3270 + | HTML_file + | Informational_message + | Sound_file + | Unknown + +type t = { item_type : item_t; display_string : string; selector : string; hostname : string; port : int } + +let char_of_type = function + | Text_file -> '0' + | Submenu -> '1' + | CCSO_nameserver -> '2' + | Error -> '3' + | Binhexencoded_file -> '4' + | DOS_file -> '5' + | Uuencoded_file -> '6' + | Text_search -> '7' + | Telnet -> '8' + | Binary_file -> '9' + | Alternate_server -> '+' + | GIF_file -> 'g' + | Image_file -> 'I' + | Telnet_3270 -> 'T' + | HTML_file -> 'h' + | Informational_message -> 'i' + | Sound_file -> 's' + | Unknown -> ' ' + +let type_of_char = function + | '0' -> Text_file + | '1' -> Submenu + | '2' -> CCSO_nameserver + | '3' -> Error + | '4' -> Binhexencoded_file + | '5' -> DOS_file + | '6' -> Uuencoded_file + | '7' -> Text_search + | '8' -> Telnet + | '9' -> Binary_file + | '+' -> Alternate_server + | 'g' -> GIF_file + | 'I' -> Image_file + | 'T' -> Telnet_3270 + | 'h' -> HTML_file + | 'i' -> Informational_message + | 's' -> Sound_file + | _ -> Unknown + +let line item_type user_display selector hostname port = + let (<+>) a b = a ^ "\t" ^ b in + (Char.escaped (char_of_type item_type)) ^ user_display <+> selector <+> hostname <+> string_of_int port <+> "\r\n" + +let empty = { item_type = Unknown; display_string = ""; selector = ""; hostname = ""; port = 0 } + +let of_line line = + let item_type = try type_of_char @@ String.get line 0 with _ -> Unknown in + if item_type = Unknown then empty + else ( + let fields = String.split_on_char '\t' (String.sub line 1 (String.length line - 1)) in + let nth n = match List.nth_opt fields n with Some v -> v | None -> "" in + let port = try int_of_string (nth 3) with Failure _ -> 0 in + { item_type; display_string = nth 0; selector = nth 1; hostname = nth 2; port } + ) + +let v item_type display_string selector hostname port = + { item_type; display_string; selector; hostname; port } diff --git a/src/jbuild b/src/jbuild deleted file mode 100644 index 1410ecd..0000000 --- a/src/jbuild +++ /dev/null @@ -1,6 +0,0 @@ -(jbuild_version 1) - -(library - ((name gopher) - (public_name gopher) - (libraries (lwt lwt.unix)))) diff --git a/src/lwt_client.ml b/src/lwt_client.ml new file mode 100644 index 0000000..4bebfe3 --- /dev/null +++ b/src/lwt_client.ml @@ -0,0 +1,21 @@ +open Lwt.Infix + +let session socket path () = + let rec recv_all reply_bytes () = + let recv_bytes = Bytes.create 4096 in + Lwt_unix.recv socket recv_bytes 0 (Bytes.length recv_bytes) [] + >>= function + | 0 -> Lwt.return (Bytes.to_string reply_bytes) + | _ -> recv_all (Bytes.cat reply_bytes recv_bytes) () + in + let path_bytes = Bytes.of_string path in + Lwt_unix.send socket path_bytes 0 (Bytes.length path_bytes) [] + >>= function + | -1 | 0 -> Lwt_result.fail "Couldn't send" + | _ -> Lwt_result.ok (recv_all (Bytes.create 0) ()) + +let gopher ?(port=70) host path = + let socket = Lwt_unix.(socket PF_INET SOCK_STREAM 0) in + let host = Unix.inet_addr_of_string host in + let connection = Lwt_unix.connect socket Unix.(ADDR_INET (host, port)) in + Lwt_main.run (connection >>= session socket path) diff --git a/src/lwt_server.ml b/src/lwt_server.ml new file mode 100644 index 0000000..355c586 --- /dev/null +++ b/src/lwt_server.ml @@ -0,0 +1,24 @@ +let apply handler (file_descr, _socket) = + let open Lwt.Infix in + let buf = Bytes.create 256 in + Lwt_unix.read file_descr buf 0 (Bytes.length buf) + >>= (fun x -> + let response = handler @@ Bytes.(to_string (sub buf 0 x)) in + Lwt_unix.write_string file_descr response 0 (String.length response) + ) + >>= (fun _ -> Lwt_unix.(shutdown file_descr SHUTDOWN_ALL); Lwt.return_unit) + +let rec accept_all handler socket () = + let open Lwt.Infix in + Lwt_unix.accept socket + >>= (fun pair -> Lwt.catch (fun () -> apply handler pair) (fun exn -> prerr_endline (Printexc.to_string exn); Lwt.return_unit)) + >>= accept_all handler socket + +let gopherd ?(host="") ?(port=70) ?(request_queue_size=128) handler = + let open Lwt.Infix in + let socket = Lwt_unix.(socket PF_INET6 SOCK_STREAM 0) in + Lwt_unix.setsockopt socket SO_REUSEADDR true; + let host = if host = "" then Unix.inet6_addr_any else Unix.inet_addr_of_string host in + let bind = Lwt_unix.bind socket Unix.(ADDR_INET (host, port)) in + Lwt_unix.listen socket request_queue_size; + Lwt_main.run (bind >>= accept_all handler socket) diff --git a/src/menu.ml b/src/menu.ml new file mode 100644 index 0000000..382c0f0 --- /dev/null +++ b/src/menu.ml @@ -0,0 +1,5 @@ +let ending = "\n." + +let of_string menu = + let lines = String.split_on_char '\n' menu in + List.map Item.of_line lines