Initial upload

osmol.ml

@@ -0,0 +1,67 @@
+(*
+  OSmol: simple static Gopher server in OCaml
+  Uses the same logic as Gofor-LX in Python
+  Created by Luxferre in 2023, released into public domain
+*)
+
+let listen_port = ref "70" (* server port *)
+let root_dir = ref "."     (* content root directory *)
+let index_map = ref "index.map" (* index map file name *)
+let posargs = ref []
+let usage_msg = "Usage: " ^ Sys.argv.(0) ^ " [-p 70] [-d .] [-i index.map]"
+let speclist = [
+  ("-p", Arg.Set_string listen_port, "Port to listen on (default 70)");
+  ("-d", Arg.Set_string root_dir, "Content root directory (default .)");
+  ("-i", Arg.Set_string index_map, "Index map file name (default index.map)")
+]
+let anon_fun parg = posargs := parg :: !posargs
+let () = Arg.parse speclist anon_fun usage_msg
+
+(* get the resolved root directory with no trailing slashes *)
+
+let real_root_dir = try Unix.realpath !root_dir
+  with _ -> failwith "No root directory!"
+
+(* request processing *)
+
+(* server error message formatter *)
+let errmsg msg = 
+  Printf.sprintf "3%s\t\terror.host\t1\r\n.\r\n\r\n" msg |> Bytes.of_string
+
+(* read a file as bytes sequence for Gopher output *)
+let readfile path =
+  if Sys.file_exists path then (* read the file *)
+    let ch = open_in_bin path in
+    let len = in_channel_length ch in
+    let buf = Bytes.create len in    
+    try (really_input ch buf 0 len; close_in_noerr ch; buf)
+    with _ -> errmsg "Error reading the selector, try again later!"
+  else errmsg "Selector not found!"
+
+(* find content by selector and return it as bytes sequence *)
+let findsel sel =
+  let selpath = (try Unix.realpath (real_root_dir ^ "/" ^ sel)
+    with _ -> "###") in
+  (* check if selpath starts with rootdir *)
+  if String.starts_with ~prefix:real_root_dir selpath then
+    if Sys.is_directory selpath then (* resolve to index *)
+      readfile (selpath ^ "/" ^ !index_map)
+    else readfile selpath (* normal file *)
+  else errmsg "Selector not found!"
+
+(* inch is line-based, outch is binary *)
+let reqproc inch outch =
+  let reqparts = input_line inch |> String.split_on_char '\t' in
+  output_bytes outch (match reqparts with
+  | sel :: [] -> findsel (String.trim sel) (* valid selector with no tab *)
+  | [] -> findsel "/" (* empty root selector *)
+  | _ :: _ -> errmsg "Search selectors unsupported!"
+  );;
+
+(* start the server *)
+
+let lport = int_of_string(!listen_port) in
+  if lport > 0 && lport < 65536 then (
+    print_endline ("Starting server on port " ^ (string_of_int lport));
+    Unix.establish_server reqproc (Unix.ADDR_INET (Unix.inet_addr_any, lport))
+  ) else failwith "Invalid port!"