OCaml library for creating Gopher daemons

README.md

@@ -0,0 +1,4 @@
+# OCaml Gopher
+
+Library for creating Gopher servers in OCaml.
+Depends on [Lwt](http://ocsigen.org/lwt).

gopher.opam

@@ -0,0 +1,16 @@
+opam-version: "1.2"
+name: "gopher"
+version: "0.1.0"
+homepage: "https://cgit.orbitalfox.eu/ocaml-gopher/about"
+dev-repo: "git://orbitalfox.eu/ocaml-gopher"
+bug-reports: "mailto:sp@orbitalfox.eu"
+maintainer: "Stavros Polymenis <sp@orbitalfox.eu>"
+authors: "Stavros Polymenis <sp@orbitalfox.eu>"
+license: "EUPL"
+build: [
+  ["jbuilder" "build" "--root" "." "-j" jobs "@install"]
+]
+depends: [
+  "jbuilder" {build}
+  "lwt"
+]

src/gopher.ml

@@ -0,0 +1,74 @@
+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

src/jbuild

@@ -0,0 +1,6 @@
+(jbuild_version 1)
+
+(library
+ ((name        gopher)
+  (public_name gopher)
+  (libraries (lwt lwt.unix))))