[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Xen-changelog] [xen-unstable] ocaml: add logging bindings.



# HG changeset patch
# User Keir Fraser <keir.fraser@xxxxxxxxxx>
# Date 1273140242 -3600
# Node ID 8281b2dde2cfd109aa7956a2fb0ede95b063b5e2
# Parent  cad29ef535d61d6135dfbcbf12d2f15ac76fd048
ocaml: add logging bindings.

Signed-off-by: Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
---
 tools/ocaml/libs/log/META.in        |    4 
 tools/ocaml/libs/log/Makefile       |   41 +++++
 tools/ocaml/libs/log/log.ml         |  258 ++++++++++++++++++++++++++++++++++++
 tools/ocaml/libs/log/log.mli        |   55 +++++++
 tools/ocaml/libs/log/logs.ml        |  197 +++++++++++++++++++++++++++
 tools/ocaml/libs/log/logs.mli       |   46 ++++++
 tools/ocaml/libs/log/syslog.ml      |   26 +++
 tools/ocaml/libs/log/syslog.mli     |   41 +++++
 tools/ocaml/libs/log/syslog_stubs.c |   73 ++++++++++
 9 files changed, 741 insertions(+)

diff -r cad29ef535d6 -r 8281b2dde2cf tools/ocaml/libs/log/META.in
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/log/META.in      Thu May 06 11:04:02 2010 +0100
@@ -0,0 +1,4 @@
+version = "@VERSION@"
+description = "Log - logging library"
+archive(byte) = "log.cma"
+archive(native) = "log.cmxa"
diff -r cad29ef535d6 -r 8281b2dde2cf tools/ocaml/libs/log/Makefile
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/log/Makefile     Thu May 06 11:04:02 2010 +0100
@@ -0,0 +1,41 @@
+TOPLEVEL=../..
+include $(TOPLEVEL)/common.make
+
+OBJS = syslog log logs
+INTF = log.cmi logs.cmi syslog.cmi
+LIBS = log.cma log.cmxa
+
+all: $(INTF) $(LIBS) $(PROGRAMS)
+
+bins: $(PROGRAMS)
+
+libs: $(LIBS)
+
+log.cmxa: libsyslog_stubs.a $(foreach obj,$(OBJS),$(obj).cmx)
+       $(call mk-caml-lib-native, $@, -cclib -lsyslog_stubs, $(foreach 
obj,$(OBJS),$(obj).cmx))
+
+log.cma: $(foreach obj,$(OBJS),$(obj).cmo)
+       $(call mk-caml-lib-bytecode, $@, -dllib dllsyslog_stubs.so -cclib 
-lsyslog_stubs, $(foreach obj,$(OBJS),$(obj).cmo))
+
+syslog_stubs.a: syslog_stubs.o
+       $(call mk-caml-stubs, $@, $+)
+
+libsyslog_stubs.a: syslog_stubs.o
+       $(call mk-caml-lib-stubs, $@, $+)
+
+logs.mli : logs.ml
+       $(OCAMLC) -i $(OCAMLCFLAGS) $< > $@
+
+syslog.mli : syslog.ml
+       $(OCAMLC) -i $< > $@
+
+.PHONY: install
+install: $(LIBS) META
+       ocamlfind install -destdir $(DESTDIR)$(shell ocamlfind printconf 
destdir) -ldconf ignore log META $(INTF) $(LIBS) *.a *.so *.cmx
+
+.PHONY: uninstall
+uninstall:
+       ocamlfind remove log
+
+include $(TOPLEVEL)/Makefile.rules
+
diff -r cad29ef535d6 -r 8281b2dde2cf tools/ocaml/libs/log/log.ml
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/log/log.ml       Thu May 06 11:04:02 2010 +0100
@@ -0,0 +1,258 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008      Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program 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; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * 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 Lesser General Public License for more details.
+ *)
+
+open Printf
+
+exception Unknown_level of string
+
+type stream_type = Stderr | Stdout | File of string
+
+type stream_log = {
+  ty : stream_type;
+  channel : out_channel option ref;
+}
+
+type level = Debug | Info | Warn | Error
+
+type output =
+       | Stream of stream_log
+       | String of string list ref
+       | Syslog of string
+       | Nil
+
+let int_of_level l =
+       match l with Debug -> 0 | Info -> 1 | Warn -> 2 | Error -> 3
+
+let string_of_level l =
+       match l with Debug -> "debug" | Info -> "info"
+                  | Warn -> "warn" | Error -> "error"
+
+let level_of_string s =
+       match s with
+       | "debug" -> Debug
+       | "info"  -> Info
+       | "warn"  -> Warn
+       | "error" -> Error
+       | _       -> raise (Unknown_level s)
+
+let mkdir_safe dir perm =
+        try Unix.mkdir dir perm with _ -> ()
+
+let mkdir_rec dir perm =
+       let rec p_mkdir dir =
+               let p_name = Filename.dirname dir in
+               if p_name = "/" || p_name = "." then
+                       ()
+               else (
+                       p_mkdir p_name;
+                       mkdir_safe dir perm
+               ) in
+       p_mkdir dir
+
+type t = { output: output; mutable level: level; }
+
+let make output level = { output = output; level = level; }
+
+let make_stream ty channel = 
+        Stream {ty=ty; channel=ref channel; }
+
+(** open a syslog logger *)
+let opensyslog k level =
+       make (Syslog k) level
+
+(** open a stderr logger *)
+let openerr level =
+       if (Unix.stat "/dev/stderr").Unix.st_kind <> Unix.S_CHR then
+               failwith "/dev/stderr is not a valid character device";
+       make (make_stream Stderr (Some (open_out "/dev/stderr"))) level
+       
+let openout level =
+       if (Unix.stat "/dev/stdout").Unix.st_kind <> Unix.S_CHR then
+               failwith "/dev/stdout is not a valid character device";
+        make (make_stream Stdout (Some (open_out "/dev/stdout"))) level
+
+
+(** open a stream logger - returning the channel. *)
+(* This needs to be separated from 'openfile' so we can reopen later *)
+let doopenfile filename =
+        if Filename.is_relative filename then
+               None
+       else (
+                try
+                 mkdir_rec (Filename.dirname filename) 0o700;
+                 Some (open_out_gen [ Open_append; Open_creat ] 0o600 filename)
+                with _ -> None
+       )
+
+(** open a stream logger - returning the output type *)
+let openfile filename level =
+        make (make_stream (File filename) (doopenfile filename)) level
+
+(** open a nil logger *)
+let opennil () =
+       make Nil Error
+
+(** open a string logger *)
+let openstring level =
+        make (String (ref [""])) level
+
+(** try to reopen a logger *)
+let reopen t =
+       match t.output with
+       | Nil              -> t
+       | Syslog k         -> Syslog.close (); opensyslog k t.level
+       | Stream s         -> (
+             match (s.ty,!(s.channel)) with 
+               | (File filename, Some c) -> close_out c; s.channel := (try 
doopenfile filename with _ -> None); t 
+               | _ -> t)
+       | String _         -> t
+
+(** close a logger *)
+let close t =
+       match t.output with
+       | Nil           -> ()
+       | Syslog k      -> Syslog.close ();
+       | Stream s      -> (
+             match !(s.channel) with 
+               | Some c -> close_out c; s.channel := None
+               | None -> ())
+       | String _      -> ()
+
+(** create a string representating the parameters of the logger *)
+let string_of_logger t =
+       match t.output with
+       | Nil           -> "nil"
+       | Syslog k      -> sprintf "syslog:%s" k
+       | String _      -> "string"
+       | Stream s      -> 
+           begin
+             match s.ty with 
+               | File f -> sprintf "file:%s" f
+               | Stderr -> "stderr"
+               | Stdout -> "stdout"
+           end
+
+(** parse a string to a logger *)
+let logger_of_string s : t =
+       match s with
+       | "nil"    -> opennil ()
+       | "stderr" -> openerr Debug
+       | "stdout" -> openout Debug
+       | "string" -> openstring Debug
+       | _        ->
+               let split_in_2 s =
+                       try
+                               let i = String.index s ':' in
+                               String.sub s 0 (i),
+                               String.sub s (i + 1) (String.length s - i - 1)
+                       with _ ->
+                               failwith "logger format error: expecting 
string:string"
+                       in
+               let k, s = split_in_2 s in
+               match k with
+               | "syslog" -> opensyslog s Debug
+               | "file"   -> openfile s Debug
+               | _        -> failwith "unknown logger type"
+
+let validate s =
+       match s with
+       | "nil"    -> ()
+       | "stderr" -> ()
+       | "stdout" -> ()
+       | "string" -> ()
+       | _        ->
+               let split_in_2 s =
+                       try
+                               let i = String.index s ':' in
+                               String.sub s 0 (i),
+                               String.sub s (i + 1) (String.length s - i - 1)
+                       with _ ->
+                               failwith "logger format error: expecting 
string:string"
+                       in
+               let k, s = split_in_2 s in
+               match k with
+               | "syslog" -> ()
+               | "file"   -> (
+                       try
+                               let st = Unix.stat s in
+                               if st.Unix.st_kind <> Unix.S_REG then
+                                       failwith "logger file is a directory";
+                               ()
+                       with Unix.Unix_error (Unix.ENOENT, _, _) -> ()
+                       )
+               | _        -> failwith "unknown logger"
+
+(** change a logger level to level *)
+let set t level = t.level <- level
+
+let gettimestring () =
+       let time = Unix.gettimeofday () in
+       let tm = Unix.localtime time in
+        let msec = time -. (floor time) in
+       sprintf "%d%.2d%.2d %.2d:%.2d:%.2d.%.3d|" (1900 + tm.Unix.tm_year)
+               (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
+               tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
+               (int_of_float (1000.0 *. msec))
+
+(*let extra_hook = ref (fun x -> x)*)
+
+let output t ?(key="") ?(extra="") priority (message: string) =
+  let construct_string withtime =
+               (*let key = if key = "" then [] else [ key ] in
+               let extra = if extra = "" then [] else [ extra ] in
+               let items = 
+      (if withtime then [ gettimestring () ] else [])
+                 @ [ sprintf "%5s" (string_of_level priority) ] @ extra @ key 
@ [ message ] in
+(*             let items = !extra_hook items in*)
+               String.concat " " items*)
+    Printf.sprintf "[%s%s|%s] %s" 
+      (if withtime then gettimestring () else "") (string_of_level priority) 
extra message
+       in
+       (* Keep track of how much we write out to streams, so that we can *)
+       (* log-rotate at appropriate times *)
+       let write_to_stream stream =
+         let string = (construct_string true) in
+         try
+           fprintf stream "%s\n%!" string
+         with _ -> () (* Trap exception when we fail to write log *)
+        in
+
+       if String.length message > 0 then
+       match t.output with
+       | Syslog k      ->
+               let sys_prio = match priority with
+               | Debug -> Syslog.Debug
+               | Info  -> Syslog.Info
+               | Warn  -> Syslog.Warning
+               | Error -> Syslog.Err in
+               Syslog.log Syslog.Daemon sys_prio ((construct_string false) ^ 
"\n")
+       | Stream s -> (
+             match !(s.channel) with
+               | Some c -> write_to_stream c
+               | None -> ())
+       | Nil           -> ()
+       | String s      -> (s := (construct_string true)::!s)
+
+let log t level (fmt: ('a, unit, string, unit) format4): 'a =
+       let b = (int_of_level t.level) <= (int_of_level level) in
+       (* ksprintf is the preferred name for kprintf, but the former
+        * is not available in OCaml 3.08.3 *)
+       Printf.kprintf (if b then output t level else (fun _ -> ())) fmt
+           
+let debug t (fmt: ('a , unit, string, unit) format4) = log t Debug fmt
+let info t (fmt: ('a , unit, string, unit) format4) = log t Info fmt
+let warn t (fmt: ('a , unit, string, unit) format4) = log t Warn fmt
+let error t (fmt: ('a , unit, string, unit) format4) = log t Error fmt
diff -r cad29ef535d6 -r 8281b2dde2cf tools/ocaml/libs/log/log.mli
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/log/log.mli      Thu May 06 11:04:02 2010 +0100
@@ -0,0 +1,55 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008      Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program 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; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * 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 Lesser General Public License for more details.
+ *)
+
+exception Unknown_level of string
+type level = Debug | Info | Warn | Error
+
+type stream_type = Stderr | Stdout | File of string
+type stream_log = {
+  ty : stream_type;
+  channel : out_channel option ref;
+}
+type output =
+    Stream of stream_log
+  | String of string list ref
+  | Syslog of string
+  | Nil
+val int_of_level : level -> int
+val string_of_level : level -> string
+val level_of_string : string -> level
+val mkdir_safe : string -> Unix.file_perm -> unit
+val mkdir_rec : string -> Unix.file_perm -> unit
+type t = { output : output; mutable level : level; }
+val make : output -> level -> t
+val opensyslog : string -> level -> t
+val openerr : level -> t
+val openout : level -> t
+val openfile : string -> level -> t
+val opennil : unit -> t
+val openstring : level -> t
+val reopen : t -> t
+val close : t -> unit
+val string_of_logger : t -> string
+val logger_of_string : string -> t
+val validate : string -> unit
+val set : t -> level -> unit
+val gettimestring : unit -> string
+val output : t -> ?key:string -> ?extra:string -> level -> string -> unit
+val log : t -> level -> ('a, unit, string, unit) format4 -> 'a
+val debug : t -> ('a, unit, string, unit) format4 -> 'a
+val info : t -> ('a, unit, string, unit) format4 -> 'a
+val warn : t -> ('a, unit, string, unit) format4 -> 'a
+val error : t -> ('a, unit, string, unit) format4 -> 'a
diff -r cad29ef535d6 -r 8281b2dde2cf tools/ocaml/libs/log/logs.ml
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/log/logs.ml      Thu May 06 11:04:02 2010 +0100
@@ -0,0 +1,197 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008      Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program 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; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * 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 Lesser General Public License for more details.
+ *)
+
+type keylogger =
+{
+       mutable debug: string list;
+       mutable info: string list;
+       mutable warn: string list;
+       mutable error: string list;
+       no_default: bool;
+}
+
+(* map all logger strings into a logger *)
+let __all_loggers = Hashtbl.create 10
+
+(* default logger that everything that doesn't have a key in __lop_mapping get 
send *)
+let __default_logger = { debug = []; info = []; warn = []; error = []; 
no_default = false }
+
+(*
+ * This describe the mapping between a name to a keylogger.
+ * a keylogger contains a list of logger string per level of debugging.
+ * Example:   "xenops", debug -> [ "stderr"; "/var/log/xensource.log" ]
+ *            "xapi", error ->   []
+ *            "xapi", debug ->   [ "/var/log/xensource.log" ]
+ *            "xenops", info ->  [ "syslog" ]
+ *)
+let __log_mapping = Hashtbl.create 32
+
+let get_or_open logstring =
+       if Hashtbl.mem __all_loggers logstring then
+               Hashtbl.find __all_loggers logstring
+       else
+               let t = Log.logger_of_string logstring in
+               Hashtbl.add __all_loggers logstring t;
+               t
+
+(** create a mapping entry for the key "name".
+ * all log level of key "name" default to "logger" logger.
+ * a sensible default is put "nil" as a logger and reopen a specific level to
+ * the logger you want to.
+ *)
+let add key logger =
+       let kl = {
+               debug = logger;
+               info = logger;
+               warn = logger;
+               error = logger;
+               no_default = false;
+       } in
+       Hashtbl.add __log_mapping key kl
+
+let get_by_level keylog level =
+       match level with
+       | Log.Debug -> keylog.debug
+       | Log.Info  -> keylog.info
+       | Log.Warn  -> keylog.warn
+       | Log.Error -> keylog.error
+
+let set_by_level keylog level logger =
+       match level with
+       | Log.Debug -> keylog.debug <- logger
+       | Log.Info  -> keylog.info <- logger
+       | Log.Warn  -> keylog.warn <- logger
+       | Log.Error -> keylog.error <- logger
+
+(** set a specific key|level to the logger "logger" *)
+let set key level logger =
+       if not (Hashtbl.mem __log_mapping key) then
+               add key [];
+
+       let keylog = Hashtbl.find __log_mapping key in
+       set_by_level keylog level logger
+
+(** set default logger *)
+let set_default level logger =
+       set_by_level __default_logger level logger
+
+(** append a logger to the list *)
+let append key level logger =
+       if not (Hashtbl.mem __log_mapping key) then
+               add key [];
+       let keylog = Hashtbl.find __log_mapping key in
+       let loggers = get_by_level keylog level in
+       set_by_level keylog level (loggers @ [ logger ])
+
+(** append a logger to the default list *)
+let append_default level logger =
+       let loggers = get_by_level __default_logger level in
+       set_by_level __default_logger level (loggers @ [ logger ])
+
+(** reopen all logger open *)
+let reopen () =
+       Hashtbl.iter (fun k v ->
+               Hashtbl.replace __all_loggers k (Log.reopen v)) __all_loggers
+
+(** reclaim close all logger open that are not use by any other keys *)
+let reclaim () =
+       let list_sort_uniq l =
+               let oldprev = ref "" and prev = ref "" in
+               List.fold_left (fun a k ->
+                       oldprev := !prev;
+                       prev := k;
+                       if k = !oldprev then a else k :: a) []
+                       (List.sort compare l)
+               in
+       let flatten_keylogger v =
+               list_sort_uniq (v.debug @ v.info @ v.warn @ v.error) in
+       let oldkeys = Hashtbl.fold (fun k v a -> k :: a) __all_loggers [] in
+       let usedkeys = Hashtbl.fold (fun k v a ->
+               (flatten_keylogger v) @ a)
+               __log_mapping (flatten_keylogger __default_logger) in
+       let usedkeys = list_sort_uniq usedkeys in
+
+       List.iter (fun k ->
+               if not (List.mem k usedkeys) then (
+                       begin try
+                               Log.close (Hashtbl.find __all_loggers k)
+                       with
+                               Not_found -> ()
+                       end;
+                       Hashtbl.remove __all_loggers k
+               )) oldkeys
+
+(** clear a specific key|level *)
+let clear key level =
+       try
+               let keylog = Hashtbl.find __log_mapping key in
+               set_by_level keylog level [];
+               reclaim ()
+       with Not_found ->
+               ()
+
+(** clear a specific default level *)
+let clear_default level =
+       set_default level [];
+       reclaim ()
+
+(** reset all the loggers to the specified logger *)
+let reset_all logger =
+       Hashtbl.clear __log_mapping;
+       set_default Log.Debug logger;
+       set_default Log.Warn logger;
+       set_default Log.Error logger;
+       set_default Log.Info logger;
+       reclaim ()
+
+(** log a fmt message to the key|level logger specified in the log mapping.
+ * if the logger doesn't exist, assume nil logger.
+ *)
+let log key level ?(extra="") (fmt: ('a, unit, string, unit) format4): 'a =
+       let keylog =
+               if Hashtbl.mem __log_mapping key then
+                       let keylog = Hashtbl.find __log_mapping key in
+                       if keylog.no_default = false &&
+                          get_by_level keylog level = [] then
+                               __default_logger
+                       else
+                               keylog
+               else
+                       __default_logger in
+       let loggers = get_by_level keylog level in
+       match loggers with
+       | [] -> Printf.kprintf ignore fmt
+       | _  ->
+               let l = List.fold_left (fun acc logger ->       
+                       try get_or_open logger :: acc
+                       with _ -> acc
+               ) [] loggers in
+               let l = List.rev l in
+
+               (* ksprintf is the preferred name for kprintf, but the former
+                * is not available in OCaml 3.08.3 *)
+               Printf.kprintf (fun s ->
+                       List.iter (fun t -> Log.output t ~key ~extra level s) 
l) fmt
+
+(* define some convenience functions *)
+let debug t ?extra (fmt: ('a , unit, string, unit) format4) =
+       log t Log.Debug ?extra fmt
+let info t ?extra (fmt: ('a , unit, string, unit) format4) =
+       log t Log.Info ?extra fmt
+let warn t ?extra (fmt: ('a , unit, string, unit) format4) =
+       log t Log.Warn ?extra fmt
+let error t ?extra (fmt: ('a , unit, string, unit) format4) =
+       log t Log.Error ?extra fmt
diff -r cad29ef535d6 -r 8281b2dde2cf tools/ocaml/libs/log/logs.mli
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/log/logs.mli     Thu May 06 11:04:02 2010 +0100
@@ -0,0 +1,46 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008      Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program 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; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * 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 Lesser General Public License for more details.
+ *)
+
+type keylogger = {
+  mutable debug : string list;
+  mutable info : string list;
+  mutable warn : string list;
+  mutable error : string list;
+  no_default : bool;
+}
+val __all_loggers : (string, Log.t) Hashtbl.t
+val __default_logger : keylogger
+val __log_mapping : (string, keylogger) Hashtbl.t
+val get_or_open : string -> Log.t
+val add : string -> string list -> unit
+val get_by_level : keylogger -> Log.level -> string list
+val set_by_level : keylogger -> Log.level -> string list -> unit
+val set : string -> Log.level -> string list -> unit
+val set_default : Log.level -> string list -> unit
+val append : string -> Log.level -> string -> unit
+val append_default : Log.level -> string -> unit
+val reopen : unit -> unit
+val reclaim : unit -> unit
+val clear : string -> Log.level -> unit
+val clear_default : Log.level -> unit
+val reset_all : string list -> unit
+val log :
+  string ->
+  Log.level -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a
+val debug : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a
+val info : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a
+val warn : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a
+val error : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a
diff -r cad29ef535d6 -r 8281b2dde2cf tools/ocaml/libs/log/syslog.ml
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/log/syslog.ml    Thu May 06 11:04:02 2010 +0100
@@ -0,0 +1,26 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008      Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program 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; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * 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 Lesser General Public License for more details.
+ *)
+
+type level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug
+type options = Cons | Ndelay | Nowait | Odelay | Perror | Pid
+type facility = Auth | Authpriv | Cron | Daemon | Ftp | Kern
+              | Local0 | Local1 | Local2 | Local3
+             | Local4 | Local5 | Local6 | Local7
+             | Lpr | Mail | News | Syslog | User | Uucp
+
+(* external init : string -> options list -> facility -> unit = "stub_openlog" 
*)
+external log : facility -> level -> string -> unit = "stub_syslog"
+external close : unit -> unit = "stub_closelog"
diff -r cad29ef535d6 -r 8281b2dde2cf tools/ocaml/libs/log/syslog.mli
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/log/syslog.mli   Thu May 06 11:04:02 2010 +0100
@@ -0,0 +1,41 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008      Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program 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; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * 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 Lesser General Public License for more details.
+ *)
+
+type level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug
+type options = Cons | Ndelay | Nowait | Odelay | Perror | Pid
+type facility =
+    Auth
+  | Authpriv
+  | Cron
+  | Daemon
+  | Ftp
+  | Kern
+  | Local0
+  | Local1
+  | Local2
+  | Local3
+  | Local4
+  | Local5
+  | Local6
+  | Local7
+  | Lpr
+  | Mail
+  | News
+  | Syslog
+  | User
+  | Uucp
+external log : facility -> level -> string -> unit = "stub_syslog"
+external close : unit -> unit = "stub_closelog"
diff -r cad29ef535d6 -r 8281b2dde2cf tools/ocaml/libs/log/syslog_stubs.c
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/log/syslog_stubs.c       Thu May 06 11:04:02 2010 +0100
@@ -0,0 +1,73 @@
+/*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008      Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program 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; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * 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 Lesser General Public License for more details.
+ */
+
+#include <syslog.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+
+static int __syslog_level_table[] = {
+       LOG_EMERG, LOG_ALERT, LOG_CRIT, LOG_ERR, LOG_WARNING,
+       LOG_NOTICE, LOG_INFO, LOG_DEBUG
+};
+
+static int __syslog_options_table[] = {
+       LOG_CONS, LOG_NDELAY, LOG_NOWAIT, LOG_ODELAY, LOG_PERROR, LOG_PID
+};
+
+static int __syslog_facility_table[] = {
+       LOG_AUTH, LOG_AUTHPRIV, LOG_CRON, LOG_DAEMON, LOG_FTP, LOG_KERN,
+       LOG_LOCAL0, LOG_LOCAL1, LOG_LOCAL2, LOG_LOCAL3,
+       LOG_LOCAL4, LOG_LOCAL5, LOG_LOCAL6, LOG_LOCAL7,
+       LOG_LPR | LOG_MAIL | LOG_NEWS | LOG_SYSLOG | LOG_USER | LOG_UUCP
+};
+
+/* According to the openlog manpage the 'openlog' call may take a reference
+   to the 'ident' string and keep it long-term. This means we cannot just pass 
in
+   an ocaml string which is under the control of the GC. Since we aren't 
actually
+   calling this function we can just comment it out for the time-being. */
+/*
+value stub_openlog(value ident, value option, value facility)
+{
+       CAMLparam3(ident, option, facility);
+       int c_option;
+       int c_facility;
+
+       c_option = caml_convert_flag_list(option, __syslog_options_table);
+       c_facility = __syslog_facility_table[Int_val(facility)];
+       openlog(String_val(ident), c_option, c_facility);
+       CAMLreturn(Val_unit);
+}
+*/
+
+value stub_syslog(value facility, value level, value msg)
+{
+       CAMLparam3(facility, level, msg);
+       int c_facility;
+
+       c_facility = __syslog_facility_table[Int_val(facility)]
+                  | __syslog_level_table[Int_val(level)];
+       syslog(c_facility, "%s", String_val(msg));
+       CAMLreturn(Val_unit);
+}
+
+value stub_closelog(value unit)
+{
+       CAMLparam1(unit);
+       closelog();
+       CAMLreturn(Val_unit);
+}

_______________________________________________
Xen-changelog mailing list
Xen-changelog@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/xen-changelog


 


Rackspace

Lists.xenproject.org is hosted with RackSpace, monitoring our
servers 24x7x365 and backed by RackSpace's Fanatical Support®.