(*Configuration*)
let style_filename = "basic.css"
let style_default = "body { background : black; color: #dedede; }\n"
(*functions*)
let uri_get () = Uri.of_string (Sys.getenv "REQUEST_URI")
let dir_selector_get () = match Uri.get_query_param (uri_get ()) "d" with
| None -> Printf.fprintf stderr "Missing 'd' query parameter"; ""
| Some v -> v
let filename_get () = match Uri.get_query_param (uri_get ()) "q" with
| None -> Printf.fprintf stderr "Missing 'q' query parameter"; ""
| Some v -> v
let safe_retrive_file selector file =
let (saferet_in, saferet_out) = Unix.open_process "saferet2" in
Out_channel.output_string saferet_out (selector ^ "\n" ^ file ^ "\n");
Out_channel.close saferet_out;
let result = In_channel.input_all saferet_in in
In_channel.close saferet_in;
result
let safe_retrive_from_uri () =
safe_retrive_file (Uri.pct_decode (dir_selector_get ())) (Uri.pct_decode (filename_get ()))
let style_get () =
match style_filename with
| "" -> style_default
| _ -> match safe_retrive_file "styles" "basic.css" with
| "" -> style_default
| style_contents -> style_contents
let make_wrapper start_tag end_tag f =
(fun () -> start_tag ^ (f ()) ^ end_tag)
let wrap_to_pre f = make_wrapper "\n" "
\n" f
let wrap_to_html f = make_wrapper "\n" "\n" f
let wrap_to_body f = make_wrapper "\n" "\n" f
let wrap_to_html_with_style f = make_wrapper ("") "\n" f
let output_simple_text text =
wrap_to_pre (fun () -> text)
|> wrap_to_body
|> wrap_to_html_with_style
.