(************************************************************************)
(* This file is part of SKS.  SKS is free software; you can
   redistribute it and/or modify it under the terms of the GNU General
   Public License as published by the Free Software Foundation; either
   version 2 of the License, or (at your option) any later version.

   This program is distributed in the hope that it will be useful, but
   WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
   USA *)
(***********************************************************************)

(** Common services, including error reporting, logging, 
  exception handling and port definitions  *)

open Printf
open StdLabels
open MoreLabels
module Unix = UnixLabels

exception Bug of string
exception Transaction_aborted of string
exception Argument_error of string

module Map = PMap.Map 
let (|<) map key = (fun data -> Map.add ~key ~data map)
let (|=) map key = Map.find key map

(********************************************************************)

(** filters applied to all incoming keys *)
let enforced_filters = ["yminsky.dedup"]

let version_tuple = (__VERSION__)
let compatible_version_tuple = (0,1,5)
let version = 
  let (maj_version,min_version,release) = version_tuple in
  sprintf "%d.%d.%d" maj_version min_version release

let period_regexp = Str.regexp "[.]"

let parse_version_string vstr = 
  let ar = Array.of_list (Str.bounded_split period_regexp vstr 3) in
  (int_of_string ar.(0), int_of_string ar.(1), int_of_string ar.(2))

let err_to_string err = match err with
    Unix.Unix_error (enum,fname,param) ->
      sprintf "Unix error: %s - %s(%s)"
      (Unix.error_message enum) fname param
  | e -> Printexc.to_string e

(**************************************************************************)
(** Logfile control *)

let logfile = ref stdout
let stored_logfile_name = ref None

(**************************************************************************)

let plerror level format = 
  kprintf (fun s -> 
	     if !Settings.debug && level  <= !Settings.debuglevel 
	     then  (
	       let tm = Unix.localtime (Unix.time ()) in
	       fprintf !logfile "%04d-%02d-%02d %02d:%02d:%02d " 
		 (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) 
		 tm.Unix.tm_mday (* date *)
		 tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec; (* time *)
	       output_string !logfile s; 
	       output_string !logfile "\n";
	       flush !logfile;
	     ) )
    format

(**************************************************************************)

let set_logfile extension = 
  if !Settings.filelog then
    let fname = (Filename.concat !Settings.basedir "log") ^ extension in
    stored_logfile_name := Some fname;
    logfile := open_out_gen [ Open_wronly; Open_creat; Open_append; ] 
      0o600 fname;
    plerror 0 "Opening log"

let reopen_logfile () =
  match !stored_logfile_name with
    | None -> ()
    | Some name ->
	close_out !logfile;
	logfile := open_out_gen [ Open_wronly; Open_creat; Open_append; ]  
	  0o600 name

(**************************************************************************)

let perror x = plerror 3 x

let eplerror level e format = 
  kprintf (fun s ->
	     if !Settings.debug && level  <= !Settings.debuglevel 
	     then  (
	       let tm = Unix.localtime (Unix.time ()) in
	       fprintf !logfile "%04d-%02d-%02d %02d:%02d:%02d " 
		 (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) 
		 tm.Unix.tm_mday (* date *)
		 tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec;
	       output_string !logfile s;
	       fprintf !logfile ": %s\n" (err_to_string e);
	       flush !logfile;
	     )
	  )
    format

let eperror x = eplerror 3 x

(********************************************************************)
(** Setup signals.  In particular, most of the time we want to catch and
  gracefully handle both sigint and sigterm *)

let catch_break = ref false
let handle_interrupt i =
  if !catch_break 
  then raise Sys.Break


let () = Sys.set_signal Sys.sigterm (Sys.Signal_handle handle_interrupt)
let () = Sys.set_signal Sys.sigint (Sys.Signal_handle handle_interrupt)
let () = Sys.set_signal Sys.sigpipe Sys.Signal_ignore
let () = Sys.set_signal Sys.sighup 
	   (Sys.Signal_handle (fun _ -> reopen_logfile ()))

let set_catch_break bool = 
  catch_break := bool
  (* Sys.catch_break bool; *)

let () = set_catch_break true 

(********************************************************************)

let protect ~f ~finally = 
  let result = ref None in
  let pfinally () = 
    set_catch_break false;
    (try (finally () : unit)
     with ee -> 
       set_catch_break true;
       raise ee);
    set_catch_break true;
  in
  try 
    result := Some (f ());
    raise Exit
  with
      Exit as e -> 
	pfinally (); 
	(match !result with Some x -> x | None -> raise e)
    | e -> 
	pfinally ();
	raise e

let fprotect ~f ~finally () = protect ~f ~finally

let rec filter_opts optlist = match optlist with
    [] -> []
  | (Some x)::tl -> x::(filter_opts tl)
  | None::tl -> filter_opts tl

let decomment l = 
  try
    let pos = String.index l '#' in
    String.sub l ~pos:0 ~len:pos
  with
      Not_found -> l

let rec strip_opt list = match list with
    [] -> []
  | None::tl -> strip_opt tl
  | (Some hd)::tl -> hd::(strip_opt tl)

let apply_opt ~f opt = match opt with
    None -> None
  | Some x -> Some (f x)

(***************************)

type event = | Add of string   
	     | Delete of string

type timestamp = float

(************************************************************)
(************************************************************)
(**  Network Related definitions   *)

let recon_port = !Settings.recon_port 
let recon_address = !Settings.recon_address
let http_port = !Settings.hkp_port
let http_address = !Settings.hkp_address
let db_command_name = Filename.concat !Settings.basedir "db_com_sock"
let recon_command_name = Filename.concat !Settings.basedir "recon_com_sock"

let db_command_addr = Unix.ADDR_UNIX db_command_name
let recon_command_addr = Unix.ADDR_UNIX recon_command_name

let recon_addr_to_http_addr addr = match addr with
    Unix.ADDR_UNIX _ -> failwith "Can't convert UNIX address"
  | Unix.ADDR_INET (inet_addr,port) -> Unix.ADDR_INET (inet_addr,port + 1)


let get_client_recon_addr () =
  Unix.ADDR_INET (Unix.inet_addr_of_string recon_address,0)
let get_client_recon_addr = 
  Utils.unit_memoize get_client_recon_addr