(* Log *)

open Unix

type level = [`Debug|`Auth|`Access|`Error|`Exception|`Info];;

let sf = Printf.sprintf;;
let mutex = Mutex.create ();;
let enable = ref true;;
let file = ref "ara-httpd.log";;

let timestamp () =
  let tm = localtime (time ()) in
  Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d"
    (tm.tm_year + 1900)
    (tm.tm_mon + 1)
    tm.tm_mday
    tm.tm_hour
    tm.tm_min
    tm.tm_sec
;;

let output_channel = ref None;;

let shutdown () =
  match !output_channel with
  | None -> ()
  | Some oc ->
      begin try close_out oc with _ -> () end;
      output_channel := None
;;

let init () =
  shutdown ();
  let oc = open_out_gen [Open_creat;Open_text;Open_append] 0o644 !file in
  output_channel := Some oc
;;

let set_file fn =
  file := fn;
  init ()
;;

let string_of_level = function
  | `Debug -> "debug"
  | `Auth -> "auth"
  | `Access -> "access"
  | `Error -> "error"
  | `Exception -> "exception"
  | `Info -> "info"
;;

let log l x =
  if !enable then
    begin
      let w =
        sf
          "%s %s(%02d): %s"
          (timestamp ())
          (string_of_level l)
          (Thread.id (Thread.self ()))
          x
      in
      match !output_channel with
      | None -> Debug.debug 0 w
      | Some oc ->
        let w' = w^"\n" in
        Mutex.lock mutex;
        try
          output_string oc w';
          flush oc;
          Mutex.unlock mutex
        with
        | x ->
            Mutex.unlock mutex;
            raise x
    end
  else
    ()
;;

let set_enable x = enable := x;;

let debug = log `Debug;;
let auth = log `Auth;;
let access = log `Access;;
let error = log `Error;;
let info = log `Info;;
let exc x msg = log `Exception (msg^": "^(Printexc.to_string x));;
