(*
  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!"