osmol

osmol.ml (2568B)

---

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