(* syslog(3) routines for ocaml
   Copyright (C) 2002 Shawn Wagner <raevnos@pennmush.org>

   This library is free software; you can redistribute it and/or
   modify it under the terms of the GNU Lesser General Public
   License as published by the Free Software Foundation; either
   version 2.1 of the License, or (at your option) any later version.
	 
   This library 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
   Lesser General Public License for more details.
	 
   You should have received a copy of the GNU Lesser General Public
   License along with this library; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
*)

(** The assorted logging facilities. The default is [`LOG_USER]. You can set a new default with openlog, or give a specific facility per syslog call. *)
type facility = [ `LOG_KERN | `LOG_USER | `LOG_MAIL | `LOG_DAEMON | `LOG_AUTH
		| `LOG_SYSLOG | `LOG_LPR | `LOG_NEWS | `LOG_UUCP | `LOG_CRON
		| `LOG_AUTHPRIV | `LOG_FTP | `LOG_NTP | `LOG_SECURITY 
		| `LOG_CONSOLE | `LOG_LOCAL0 | `LOG_LOCAL1 | `LOG_LOCAL2 
		| `LOG_LOCAL3 | `LOG_LOCAL4 | `LOG_LOCAL5 | `LOG_LOCAL6 
		| `LOG_LOCAL7 ]

(** Flags to pass to openlog. [`LOG_CONS] isn't implemented yet. *)
type flag = [ `LOG_CONS | `LOG_NDELAY | `LOG_PERROR | `LOG_PID ]

(** The priority of the error. *)
type level = [ `LOG_EMERG | `LOG_ALERT | `LOG_CRIT | `LOG_ERR | `LOG_WARNING
	     | `LOG_NOTICE | `LOG_INFO | `LOG_DEBUG ]

let facility_to_num fac =
  Int32.of_int (match fac with
		  | `LOG_KERN -> 0 lsl 3
		  | `LOG_USER -> 1 lsl 3
		  | `LOG_MAIL -> 2 lsl 3
		  | `LOG_DAEMON -> 3 lsl 3
		  | `LOG_AUTH -> 4 lsl 3
		  | `LOG_SYSLOG -> 5 lsl 3
		  | `LOG_LPR -> 6 lsl 3
		  | `LOG_NEWS -> 7 lsl 3
		  | `LOG_UUCP -> 8 lsl 3
		  | `LOG_CRON -> 9 lsl 3
		  | `LOG_AUTHPRIV -> 10 lsl 3
		  | `LOG_FTP -> 11 lsl 3
		  | `LOG_NTP -> 12 lsl 3
		  | `LOG_SECURITY -> 13 lsl 3
		  | `LOG_CONSOLE -> 14 lsl 3
		  | `LOG_LOCAL0 -> 16 lsl 3
		  | `LOG_LOCAL1 -> 17 lsl 3
		  | `LOG_LOCAL2 -> 18 lsl 3
		  | `LOG_LOCAL3 -> 19 lsl 3
		  | `LOG_LOCAL4 -> 20 lsl 3
		  | `LOG_LOCAL5 -> 21 lsl 3
		  | `LOG_LOCAL6 -> 22 lsl 3
		  | `LOG_LOCAL7 -> 23 lsl 3)

let level_to_num lev = 
  Int32.of_int (match lev with
		  | `LOG_EMERG -> 0
		  | `LOG_ALERT -> 1
		  | `LOG_CRIT -> 2
		  | `LOG_ERR -> 3
		  | `LOG_WARNING -> 4
		  | `LOG_NOTICE -> 5
		  | `LOG_INFO -> 6
		  | `LOG_DEBUG -> 7)


let level_mask = 0x07
let facility_mask = 0x03f8



type t = {
  mutable fd: Unix.file_descr;
  mutable connected: bool;
  mutable flags: flag list;
  mutable tag: string;
  mutable fac: int32;
}  

let logpath = ref "/dev/log"

let socktype = ref Unix.SOCK_DGRAM

let set_logpath newpath = 
  logpath := newpath

let set_socktype newsock =
  socktype := newsock

let loginfo = { fd = Unix.stderr; 
		connected = false; 
		flags = []; 
		tag = ""; 
		fac = facility_to_num `LOG_USER}

let open_connection () =
  if not loginfo.connected then begin
    let logaddr = Unix.ADDR_UNIX !logpath in
      loginfo.fd <- Unix.socket Unix.PF_UNIX !socktype 0;
      Unix.connect loginfo.fd logaddr;
      loginfo.connected <- true      
  end;
  ()

let openlog ident flags fac =
  loginfo.tag <- ident;
  loginfo.flags <- flags;
  loginfo.fac <- facility_to_num fac;
  if List.mem `LOG_NDELAY loginfo.flags then
    open_connection ();
  ()

let log_console msg =
  (* Nothing yet *) ()

let syslog ?fac lev str =
  if not loginfo.connected then open_connection ();
  let msg = Buffer.create 64 in
  let realfac = match fac with 
    | Some f -> facility_to_num f
    | None -> loginfo.fac in
  let levfac = Int32.logor realfac (level_to_num lev)
  and now = StrExtras.cut_first_n (Time.ctime (Time.time ())) 4 in
    Printf.bprintf msg "<%ld>%.15s" levfac (StrExtras.cut_last_n now 5);
    let len1 = Buffer.length msg 
    and len2 = String.length loginfo.tag in
      if len1 + len2 < 64 then
	Buffer.add_string msg loginfo.tag
      else
	Buffer.add_substring msg loginfo.tag 0 (64 - len1);
    if List.mem `LOG_PID loginfo.flags then
      Printf.bprintf msg "[%d]" (Unix.getpid());
    if String.length loginfo.tag > 0 then
      Buffer.add_string msg ": ";
    Buffer.add_string msg str;
    Buffer.add_char msg '\000';
    let realmsg = ref (Buffer.contents msg) in
      if String.length !realmsg > 1024 then begin
	realmsg := String.sub !realmsg 0 1024;
	String.blit "<truncated>\000" 0 !realmsg 1012 12
      end;
      begin try
	ignore (Unix.write loginfo.fd !realmsg 0 (String.length !realmsg))
      with 
	| Unix.Unix_error(_,_,_) ->
	if List.mem `LOG_CONS loginfo.flags then
	  log_console !realmsg
      end;
      if List.mem `LOG_PERROR loginfo.flags then begin
	ignore (Unix.write Unix.stderr !realmsg 0 (String.length !realmsg));
	ignore (Unix.write Unix.stderr "\n" 0 1)
      end

let closelog () =
  if loginfo.connected then
    begin
      Unix.close loginfo.fd;
      loginfo.connected <- false
    end;
  loginfo.flags <- [];
  loginfo.tag <- "";
  loginfo.fac <- facility_to_num `LOG_USER