68 lines
2.5 KiB
OCaml
68 lines
2.5 KiB
OCaml
|
(*
|
||
|
|
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!"
|