From mboxrd@z Thu Jan 1 00:00:00 1970 From: Vincent Hanquez Subject: [PATCH 05/10] add logs ocaml bindings Date: Tue, 9 Mar 2010 14:41:10 +0000 Message-ID: <1268145675-10375-6-git-send-email-vincent.hanquez@eu.citrix.com> References: <1268145675-10375-1-git-send-email-vincent.hanquez@eu.citrix.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------1.7.0" Return-path: In-Reply-To: <1268145675-10375-1-git-send-email-vincent.hanquez@eu.citrix.com> List-Unsubscribe: , List-Post: List-Help: List-Subscribe: , Sender: xen-devel-bounces@lists.xensource.com Errors-To: xen-devel-bounces@lists.xensource.com To: xen-devel@lists.xensource.com Cc: Vincent Hanquez List-Id: xen-devel@lists.xenproject.org --------------1.7.0 Content-Type: text/plain; charset="UTF-8"; format=fixed Content-Transfer-Encoding: quoted-printable Signed-off-by: Vincent Hanquez --- 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(+), 0 deletions(-) create mode 100644 tools/ocaml/libs/log/META.in create mode 100644 tools/ocaml/libs/log/Makefile create mode 100644 tools/ocaml/libs/log/log.ml create mode 100644 tools/ocaml/libs/log/log.mli create mode 100644 tools/ocaml/libs/log/logs.ml create mode 100644 tools/ocaml/libs/log/logs.mli create mode 100644 tools/ocaml/libs/log/syslog.ml create mode 100644 tools/ocaml/libs/log/syslog.mli create mode 100644 tools/ocaml/libs/log/syslog_stubs.c --------------1.7.0 Content-Type: text/x-patch; name="0005-add-logs-ocaml-bindings.patch" Content-Disposition: attachment; filename="0005-add-logs-ocaml-bindings.patch" Content-Transfer-Encoding: quoted-printable diff --git a/tools/ocaml/libs/log/META.in b/tools/ocaml/libs/log/META.in new file mode 100644 index 0000000..5c3646a --- /dev/null +++ b/tools/ocaml/libs/log/META.in @@ -0,0 +1,4 @@ +version =3D "@VERSION@" +description =3D "Log - logging library" +archive(byte) =3D "log.cma" +archive(native) =3D "log.cmxa" diff --git a/tools/ocaml/libs/log/Makefile b/tools/ocaml/libs/log/Makefil= e new file mode 100644 index 0000000..47c7918 --- /dev/null +++ b/tools/ocaml/libs/log/Makefile @@ -0,0 +1,41 @@ +TOPLEVEL=3D../.. +include $(TOPLEVEL)/common.make + +OBJS =3D syslog log logs +INTF =3D log.cmi logs.cmi syslog.cmi +LIBS =3D 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,$(O= BJS),$(obj).cmx)) + +log.cma: $(foreach obj,$(OBJS),$(obj).cmo) + $(call mk-caml-lib-bytecode, $@, -dllib dllsyslog_stubs.so -cclib -lsys= log_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 destdi= r) -ldconf ignore log META $(INTF) $(LIBS) *.a *.so *.cmx + +.PHONY: uninstall +uninstall: + ocamlfind remove log + +include $(TOPLEVEL)/Makefile.rules + diff --git a/tools/ocaml/libs/log/log.ml b/tools/ocaml/libs/log/log.ml new file mode 100644 index 0000000..4f42759 --- /dev/null +++ b/tools/ocaml/libs/log/log.ml @@ -0,0 +1,258 @@ +(* + * Copyright (C) 2006-2007 XenSource Ltd. + * Copyright (C) 2008 Citrix Ltd. + * Author Vincent Hanquez + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as publis= hed + * 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 =3D Stderr | Stdout | File of string + +type stream_log =3D { + ty : stream_type; + channel : out_channel option ref; +} + +type level =3D Debug | Info | Warn | Error + +type output =3D + | Stream of stream_log + | String of string list ref + | Syslog of string + | Nil + +let int_of_level l =3D + match l with Debug -> 0 | Info -> 1 | Warn -> 2 | Error -> 3 + +let string_of_level l =3D + match l with Debug -> "debug" | Info -> "info" + | Warn -> "warn" | Error -> "error" + +let level_of_string s =3D + match s with + | "debug" -> Debug + | "info" -> Info + | "warn" -> Warn + | "error" -> Error + | _ -> raise (Unknown_level s) + +let mkdir_safe dir perm =3D + try Unix.mkdir dir perm with _ -> () + +let mkdir_rec dir perm =3D + let rec p_mkdir dir =3D + let p_name =3D Filename.dirname dir in + if p_name =3D "/" || p_name =3D "." then + () + else ( + p_mkdir p_name; + mkdir_safe dir perm + ) in + p_mkdir dir + +type t =3D { output: output; mutable level: level; } + +let make output level =3D { output =3D output; level =3D level; } + +let make_stream ty channel =3D=20 + Stream {ty=3Dty; channel=3Dref channel; } + +(** open a syslog logger *) +let opensyslog k level =3D + make (Syslog k) level + +(** open a stderr logger *) +let openerr level =3D + 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 +=09 +let openout level =3D + 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 =3D + 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 =3D + make (make_stream (File filename) (doopenfile filename)) level + +(** open a nil logger *) +let opennil () =3D + make Nil Error + +(** open a string logger *) +let openstring level =3D + make (String (ref [""])) level + +(** try to reopen a logger *) +let reopen t =3D + match t.output with + | Nil -> t + | Syslog k -> Syslog.close (); opensyslog k t.level + | Stream s -> ( + match (s.ty,!(s.channel)) with=20 + | (File filename, Some c) -> close_out c; s.channel :=3D (try doopenfi= le filename with _ -> None); t=20 + | _ -> t) + | String _ -> t + +(** close a logger *) +let close t =3D + match t.output with + | Nil -> () + | Syslog k -> Syslog.close (); + | Stream s -> ( + match !(s.channel) with=20 + | Some c -> close_out c; s.channel :=3D None + | None -> ()) + | String _ -> () + +(** create a string representating the parameters of the logger *) +let string_of_logger t =3D + match t.output with + | Nil -> "nil" + | Syslog k -> sprintf "syslog:%s" k + | String _ -> "string" + | Stream s ->=20 + begin + match s.ty with=20 + | File f -> sprintf "file:%s" f + | Stderr -> "stderr" + | Stdout -> "stdout" + end + +(** parse a string to a logger *) +let logger_of_string s : t =3D + match s with + | "nil" -> opennil () + | "stderr" -> openerr Debug + | "stdout" -> openout Debug + | "string" -> openstring Debug + | _ -> + let split_in_2 s =3D + try + let i =3D 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 =3D split_in_2 s in + match k with + | "syslog" -> opensyslog s Debug + | "file" -> openfile s Debug + | _ -> failwith "unknown logger type" + +let validate s =3D + match s with + | "nil" -> () + | "stderr" -> () + | "stdout" -> () + | "string" -> () + | _ -> + let split_in_2 s =3D + try + let i =3D 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 =3D split_in_2 s in + match k with + | "syslog" -> () + | "file" -> ( + try + let st =3D 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 =3D t.level <- level + +let gettimestring () =3D + let time =3D Unix.gettimeofday () in + let tm =3D Unix.localtime time in + let msec =3D 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 =3D ref (fun x -> x)*) + +let output t ?(key=3D"") ?(extra=3D"") priority (message: string) =3D + let construct_string withtime =3D + (*let key =3D if key =3D "" then [] else [ key ] in + let extra =3D if extra =3D "" then [] else [ extra ] in + let items =3D=20 + (if withtime then [ gettimestring () ] else []) + @ [ sprintf "%5s" (string_of_level priority) ] @ extra @ key @ [ mes= sage ] in +(* let items =3D !extra_hook items in*) + String.concat " " items*) + Printf.sprintf "[%s%s|%s] %s"=20 + (if withtime then gettimestring () else "") (string_of_level prior= ity) 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 =3D + let string =3D (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 =3D 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 :=3D (construct_string true)::!s) + +let log t level (fmt: ('a, unit, string, unit) format4): 'a =3D + let b =3D (int_of_level t.level) <=3D (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 + =20 +let debug t (fmt: ('a , unit, string, unit) format4) =3D log t Debug fmt +let info t (fmt: ('a , unit, string, unit) format4) =3D log t Info fmt +let warn t (fmt: ('a , unit, string, unit) format4) =3D log t Warn fmt +let error t (fmt: ('a , unit, string, unit) format4) =3D log t Error fmt diff --git a/tools/ocaml/libs/log/log.mli b/tools/ocaml/libs/log/log.mli new file mode 100644 index 0000000..36c5a6b --- /dev/null +++ b/tools/ocaml/libs/log/log.mli @@ -0,0 +1,55 @@ +(* + * Copyright (C) 2006-2007 XenSource Ltd. + * Copyright (C) 2008 Citrix Ltd. + * Author Vincent Hanquez + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as publis= hed + * 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 =3D Debug | Info | Warn | Error + +type stream_type =3D Stderr | Stdout | File of string +type stream_log =3D { + ty : stream_type; + channel : out_channel option ref; +} +type output =3D + 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 =3D { 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 -> uni= t +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 --git a/tools/ocaml/libs/log/logs.ml b/tools/ocaml/libs/log/logs.ml new file mode 100644 index 0000000..2a40896 --- /dev/null +++ b/tools/ocaml/libs/log/logs.ml @@ -0,0 +1,197 @@ +(* + * Copyright (C) 2006-2007 XenSource Ltd. + * Copyright (C) 2008 Citrix Ltd. + * Author Vincent Hanquez + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as publis= hed + * 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 =3D +{ + 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 =3D Hashtbl.create 10 + +(* default logger that everything that doesn't have a key in __lop_mappi= ng get send *) +let __default_logger =3D { debug =3D []; info =3D []; warn =3D []; error= =3D []; no_default =3D 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 =3D Hashtbl.create 32 + +let get_or_open logstring =3D + if Hashtbl.mem __all_loggers logstring then + Hashtbl.find __all_loggers logstring + else + let t =3D 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 lev= el to + * the logger you want to. + *) +let add key logger =3D + let kl =3D { + debug =3D logger; + info =3D logger; + warn =3D logger; + error =3D logger; + no_default =3D false; + } in + Hashtbl.add __log_mapping key kl + +let get_by_level keylog level =3D + 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 =3D + 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 =3D + if not (Hashtbl.mem __log_mapping key) then + add key []; + + let keylog =3D Hashtbl.find __log_mapping key in + set_by_level keylog level logger + +(** set default logger *) +let set_default level logger =3D + set_by_level __default_logger level logger + +(** append a logger to the list *) +let append key level logger =3D + if not (Hashtbl.mem __log_mapping key) then + add key []; + let keylog =3D Hashtbl.find __log_mapping key in + let loggers =3D 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 =3D + let loggers =3D get_by_level __default_logger level in + set_by_level __default_logger level (loggers @ [ logger ]) + +(** reopen all logger open *) +let reopen () =3D + 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 () =3D + let list_sort_uniq l =3D + let oldprev =3D ref "" and prev =3D ref "" in + List.fold_left (fun a k -> + oldprev :=3D !prev; + prev :=3D k; + if k =3D !oldprev then a else k :: a) [] + (List.sort compare l) + in + let flatten_keylogger v =3D + list_sort_uniq (v.debug @ v.info @ v.warn @ v.error) in + let oldkeys =3D Hashtbl.fold (fun k v a -> k :: a) __all_loggers [] in + let usedkeys =3D Hashtbl.fold (fun k v a -> + (flatten_keylogger v) @ a) + __log_mapping (flatten_keylogger __default_logger) in + let usedkeys =3D 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 =3D + try + let keylog =3D Hashtbl.find __log_mapping key in + set_by_level keylog level []; + reclaim () + with Not_found -> + () + +(** clear a specific default level *) +let clear_default level =3D + set_default level []; + reclaim () + +(** reset all the loggers to the specified logger *) +let reset_all logger =3D + 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 mappi= ng. + * if the logger doesn't exist, assume nil logger. + *) +let log key level ?(extra=3D"") (fmt: ('a, unit, string, unit) format4):= 'a =3D + let keylog =3D + if Hashtbl.mem __log_mapping key then + let keylog =3D Hashtbl.find __log_mapping key in + if keylog.no_default =3D false && + get_by_level keylog level =3D [] then + __default_logger + else + keylog + else + __default_logger in + let loggers =3D get_by_level keylog level in + match loggers with + | [] -> Printf.kprintf ignore fmt + | _ -> + let l =3D List.fold_left (fun acc logger ->=09 + try get_or_open logger :: acc + with _ -> acc + ) [] loggers in + let l =3D 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) =3D + log t Log.Debug ?extra fmt +let info t ?extra (fmt: ('a , unit, string, unit) format4) =3D + log t Log.Info ?extra fmt +let warn t ?extra (fmt: ('a , unit, string, unit) format4) =3D + log t Log.Warn ?extra fmt +let error t ?extra (fmt: ('a , unit, string, unit) format4) =3D + log t Log.Error ?extra fmt diff --git a/tools/ocaml/libs/log/logs.mli b/tools/ocaml/libs/log/logs.ml= i new file mode 100644 index 0000000..76e10db --- /dev/null +++ b/tools/ocaml/libs/log/logs.mli @@ -0,0 +1,46 @@ +(* + * Copyright (C) 2006-2007 XenSource Ltd. + * Copyright (C) 2008 Citrix Ltd. + * Author Vincent Hanquez + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as publis= hed + * 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 =3D { + 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 --git a/tools/ocaml/libs/log/syslog.ml b/tools/ocaml/libs/log/syslog= .ml new file mode 100644 index 0000000..2b417da --- /dev/null +++ b/tools/ocaml/libs/log/syslog.ml @@ -0,0 +1,26 @@ +(* + * Copyright (C) 2006-2007 XenSource Ltd. + * Copyright (C) 2008 Citrix Ltd. + * Author Vincent Hanquez + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as publis= hed + * 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 =3D Emerg | Alert | Crit | Err | Warning | Notice | Info | De= bug +type options =3D Cons | Ndelay | Nowait | Odelay | Perror | Pid +type facility =3D 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 =3D "stub_= openlog" *) +external log : facility -> level -> string -> unit =3D "stub_syslog" +external close : unit -> unit =3D "stub_closelog" diff --git a/tools/ocaml/libs/log/syslog.mli b/tools/ocaml/libs/log/syslo= g.mli new file mode 100644 index 0000000..425f42a --- /dev/null +++ b/tools/ocaml/libs/log/syslog.mli @@ -0,0 +1,41 @@ +(* + * Copyright (C) 2006-2007 XenSource Ltd. + * Copyright (C) 2008 Citrix Ltd. + * Author Vincent Hanquez + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as publis= hed + * 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 =3D Emerg | Alert | Crit | Err | Warning | Notice | Info | De= bug +type options =3D Cons | Ndelay | Nowait | Odelay | Perror | Pid +type facility =3D + 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 =3D "stub_syslog" +external close : unit -> unit =3D "stub_closelog" diff --git a/tools/ocaml/libs/log/syslog_stubs.c b/tools/ocaml/libs/log/s= yslog_stubs.c new file mode 100644 index 0000000..965610a --- /dev/null +++ b/tools/ocaml/libs/log/syslog_stubs.c @@ -0,0 +1,73 @@ +/* + * Copyright (C) 2006-2007 XenSource Ltd. + * Copyright (C) 2008 Citrix Ltd. + * Author Vincent Hanquez + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as publis= hed + * 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 +#include +#include +#include +#include + +static int __syslog_level_table[] =3D { + LOG_EMERG, LOG_ALERT, LOG_CRIT, LOG_ERR, LOG_WARNING, + LOG_NOTICE, LOG_INFO, LOG_DEBUG +}; + +static int __syslog_options_table[] =3D { + LOG_CONS, LOG_NDELAY, LOG_NOWAIT, LOG_ODELAY, LOG_PERROR, LOG_PID +}; + +static int __syslog_facility_table[] =3D { + 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 refere= nce + to the 'ident' string and keep it long-term. This means we cannot jus= t 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 =3D caml_convert_flag_list(option, __syslog_options_table); + c_facility =3D __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 =3D __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); +} --------------1.7.0 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Xen-devel mailing list Xen-devel@lists.xensource.com http://lists.xensource.com/xen-devel --------------1.7.0--