tools/ocaml: Remove log library from tools/ocaml/libs

The only user was oxenstored, which has had the relevant bits
merged in.

Signed-off-by: Zheng Li <zheng.li@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell.com>
Committed-by: Ian Jackson <ian.jackson.citrix.com>
Acked-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com>
This commit is contained in:
Jon Ludlam committed 2011-10-10 16:41:16 +01:00
1 parent cc3739d41c
commit c69fddbd5d
23 files changed
+235 -943

No files matched your search

+1 -1
View File
@@ -3,7 +3,7 @@ include $(XEN_ROOT)/tools/Rules.mk
SUBDIRS= \
mmap \
log xc eventchn \
xc eventchn \
xb xs xl
.PHONY: all
-5
View File
@@ -1,5 +0,0 @@
version = "@VERSION@"
description = "Log - logging library"
requires = "unix"
archive(byte) = "log.cma"
archive(native) = "log.cmxa"
-44
View File
@@ -1,44 +0,0 @@
TOPLEVEL=$(CURDIR)/../..
XEN_ROOT=$(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
mkdir -p $(OCAMLDESTDIR)
ocamlfind remove -destdir $(OCAMLDESTDIR) log
ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore log META $(INTF) $(LIBS) *.a *.so *.cmx
.PHONY: uninstall
uninstall:
ocamlfind remove -destdir $(OCAMLDESTDIR) log
include $(TOPLEVEL)/Makefile.rules
-258
View File
@@ -1,258 +0,0 @@
(*
* Copyright (C) 2006-2007 XenSource Ltd.
* Copyright (C) 2008 Citrix Ltd.
* Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
*
* 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
-55
View File
@@ -1,55 +0,0 @@
(*
* Copyright (C) 2006-2007 XenSource Ltd.
* Copyright (C) 2008 Citrix Ltd.
* Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
*
* 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
-197
View File
@@ -1,197 +0,0 @@
(*
* Copyright (C) 2006-2007 XenSource Ltd.
* Copyright (C) 2008 Citrix Ltd.
* Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
*
* 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
-46
View File
@@ -1,46 +0,0 @@
(*
* Copyright (C) 2006-2007 XenSource Ltd.
* Copyright (C) 2008 Citrix Ltd.
* Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
*
* 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
-26
View File
@@ -1,26 +0,0 @@
(*
* Copyright (C) 2006-2007 XenSource Ltd.
* Copyright (C) 2008 Citrix Ltd.
* Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
*
* 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"
-41
View File
@@ -1,41 +0,0 @@
(*
* Copyright (C) 2006-2007 XenSource Ltd.
* Copyright (C) 2008 Citrix Ltd.
* Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
*
* 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"
-75
View File
@@ -1,75 +0,0 @@
/*
* Copyright (C) 2006-2007 XenSource Ltd.
* Copyright (C) 2008 Citrix Ltd.
* Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
*
* 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);
}
-2
View File
@@ -3,7 +3,6 @@ OCAML_TOPLEVEL = $(CURDIR)/..
include $(OCAML_TOPLEVEL)/common.make
OCAMLINCLUDE += \
-I $(OCAML_TOPLEVEL)/libs/log \
-I $(OCAML_TOPLEVEL)/libs/xb \
-I $(OCAML_TOPLEVEL)/libs/mmap \
-I $(OCAML_TOPLEVEL)/libs/xc \
@@ -34,7 +33,6 @@ INTF = symbol.cmi trie.cmi
XENSTOREDLIBS = \
unix.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/xenmmap.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/log $(OCAML_TOPLEVEL)/libs/log/log.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/xeneventchn.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc $(OCAML_TOPLEVEL)/libs/xc/xenctrl.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xb $(OCAML_TOPLEVEL)/libs/xb/xenbus.cmxa \
+5
View File
@@ -232,3 +232,8 @@ let dump con chan =
Printf.fprintf chan "watch,%d,%s,%s\n" domid (Utils.hexify path) (Utils.hexify token)
) (list_watches con);
| None -> ()
let debug con =
let domid = get_domstr con in
let watches = List.map (fun (path, token) -> Printf.sprintf "watch %s: %s %s\n" domid path token) (list_watches con) in
String.concat "" watches
+6 -1
View File
@@ -15,7 +15,7 @@
* GNU Lesser General Public License for more details.
*)
let debug fmt = Logs.debug "general" fmt
let debug fmt = Logging.debug "connections" fmt
type t = {
mutable anonymous: Connection.t list;
@@ -165,3 +165,8 @@ let stats cons =
);
(List.length cons.anonymous, !nb_ops_anon, !nb_watchs_anon,
Hashtbl.length cons.domains, !nb_ops_dom, !nb_watchs_dom)
let debug cons =
let anonymous = List.map Connection.debug cons.anonymous in
let domains = Hashtbl.fold (fun _ con accu -> Connection.debug con :: accu) cons.domains [] in
String.concat "" (domains @ anonymous)
+1 -1
View File
@@ -17,7 +17,7 @@
let enable = ref false
let xs_daemon_database = "/var/run/xenstored/db"
let error = Logs.error "general"
let error fmt = Logging.error "disk" fmt
(* unescape utils *)
exception Bad_escape
+1 -1
View File
@@ -16,7 +16,7 @@
open Printf
let debug fmt = Logs.debug "general" fmt
let debug fmt = Logging.debug "domain" fmt
type t =
{
+4 -2
View File
@@ -14,6 +14,8 @@
* GNU Lesser General Public License for more details.
*)
let debug fmt = Logging.debug "domains" fmt
type domains = {
eventchn: Event.t;
table: (Xenctrl.domid, Domain.t) Hashtbl.t;
@@ -35,7 +37,7 @@ let cleanup xc doms =
try
let info = Xenctrl.domain_getinfo xc id in
if info.Xenctrl.shutdown || info.Xenctrl.dying then (
Logs.debug "general" "Domain %u died (dying=%b, shutdown %b -- code %d)"
debug "Domain %u died (dying=%b, shutdown %b -- code %d)"
id info.Xenctrl.dying info.Xenctrl.shutdown info.Xenctrl.shutdown_code;
if info.Xenctrl.dying then
dead_dom := id :: !dead_dom
@@ -43,7 +45,7 @@ let cleanup xc doms =
notify := true;
)
with Xenctrl.Error _ ->
Logs.debug "general" "Domain %u died -- no domain info" id;
debug "Domain %u died -- no domain info" id;
dead_dom := id :: !dead_dom;
) doms.table;
List.iter (fun id ->
+162 -139
View File
@@ -17,21 +17,122 @@
open Stdext
open Printf
let error fmt = Logs.error "general" fmt
let info fmt = Logs.info "general" fmt
let debug fmt = Logs.debug "general" fmt
let access_log_file = ref "/var/log/xenstored-access.log"
let access_log_nb_files = ref 20
let access_log_nb_lines = ref 13215
let activate_access_log = ref true
(* Logger common *)
(* maximal size of the lines in xenstore-acces.log file *)
let line_size = 180
type logger =
{ stop: unit -> unit;
restart: unit -> unit;
rotate: unit -> unit;
write: 'a. ('a, unit, string, unit) format4 -> 'a }
let log_read_ops = ref false
let log_transaction_ops = ref false
let log_special_ops = ref false
let truncate_line nb_chars line =
if String.length line > nb_chars - 1 then
let len = max (nb_chars - 1) 2 in
let dst_line = String.create len in
String.blit line 0 dst_line 0 (len - 2);
dst_line.[len-2] <- '.';
dst_line.[len-1] <- '.';
dst_line
else line
let log_rotate ref_ch log_file log_nb_files =
let file n = sprintf "%s.%i" log_file n in
let log_files =
let rec aux accu n =
if n >= log_nb_files then accu
else
if n = 1 && Sys.file_exists log_file
then aux [log_file,1] 2
else
let file = file (n-1) in
if Sys.file_exists file then
aux ((file, n) :: accu) (n+1)
else accu in
aux [] 1 in
List.iter (fun (f, n) -> Unix.rename f (file n)) log_files;
close_out !ref_ch;
ref_ch := open_out log_file
let make_logger log_file log_nb_files log_nb_lines log_nb_chars post_rotate =
let channel = ref (open_out_gen [Open_append; Open_creat] 0o644 log_file) in
let counter = ref 0 in
let stop() =
try flush !channel; close_out !channel
with _ -> () in
let restart() =
stop();
channel := open_out_gen [Open_append; Open_creat] 0o644 log_file in
let rotate() =
log_rotate channel log_file log_nb_files;
(post_rotate (): unit);
counter := 0 in
let output s =
let s = if log_nb_chars > 0 then truncate_line log_nb_chars s else s in
let s = s ^ "\n" in
output_string !channel s;
flush !channel;
incr counter;
if !counter > log_nb_lines then rotate() in
{ stop=stop; restart=restart; rotate=rotate; write = fun fmt -> Printf.ksprintf output fmt }
(* Xenstored logger *)
exception Unknown_level of string
type level = Debug | Info | Warn | Error | Null
let int_of_level = function
| Debug -> 0 | Info -> 1 | Warn -> 2
| Error -> 3 | Null -> max_int
let string_of_level = function
| Debug -> "debug" | Info -> "info" | Warn -> "warn"
| Error -> "error" | Null -> "null"
let level_of_string = function
| "debug" -> Debug | "info" -> Info | "warn" -> Warn
| "error" -> Error | "null" -> Null | s -> raise (Unknown_level s)
let string_of_date () =
let time = Unix.gettimeofday () in
let tm = Unix.gmtime time in
let msec = time -. (floor time) in
sprintf "%d%.2d%.2dT%.2d:%.2d:%.2d.%.3dZ"
(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 xenstored_log_file = ref "/var/log/xenstored.log"
let xenstored_log_level = ref Null
let xenstored_log_nb_files = ref 10
let xenstored_log_nb_lines = ref 13215
let xenstored_log_nb_chars = ref (-1)
let xenstored_logger = ref (None: logger option)
let init_xenstored_log () =
if !xenstored_log_level <> Null && !xenstored_log_nb_files > 0 then
let logger =
make_logger
!xenstored_log_file !xenstored_log_nb_files !xenstored_log_nb_lines
!xenstored_log_nb_chars ignore in
xenstored_logger := Some logger
let xenstored_logging level key (fmt: (_,_,_,_) format4) =
match !xenstored_logger with
| Some logger when int_of_level level >= int_of_level !xenstored_log_level ->
let date = string_of_date() in
let level = string_of_level level in
logger.write ("[%s|%5s|%s] " ^^ fmt) date level key
| _ -> Printf.ksprintf ignore fmt
let debug key = xenstored_logging Debug key
let info key = xenstored_logging Info key
let warn key = xenstored_logging Warn key
let error key = xenstored_logging Error key
(* Access logger *)
type access_type =
| Coalesce
@@ -41,38 +142,10 @@ type access_type =
| Endconn
| XbOp of Xenbus.Xb.Op.operation
type access =
{
fd: out_channel ref;
counter: int ref;
write: tid:int -> con:string -> ?data:string -> access_type -> unit;
}
let string_of_date () =
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 fill_with_space n s =
if String.length s < n
then
let r = String.make n ' ' in
String.blit s 0 r 0 (String.length s);
r
else
s
let string_of_tid ~con tid =
if tid = 0
then fill_with_space 12 (sprintf "%s" con)
else fill_with_space 12 (sprintf "%s.%i" con tid)
then sprintf "%-12s" con
else sprintf "%-12s" (sprintf "%s.%i" con tid)
let string_of_access_type = function
| Coalesce -> "coalesce "
@@ -109,41 +182,9 @@ let string_of_access_type = function
| Xenbus.Xb.Op.Error -> "error "
| Xenbus.Xb.Op.Watchevent -> "w event "
(*
| x -> Xenbus.Xb.Op.to_string x
let file_exists file =
try
Unix.close (Unix.openfile file [Unix.O_RDONLY] 0o644);
true
with _ ->
false
let log_rotate fd =
let file n = sprintf "%s.%i" !access_log_file n in
let log_files =
let rec aux accu n =
if n >= !access_log_nb_files
then accu
else if n = 1 && file_exists !access_log_file
then aux [!access_log_file,1] 2
else
let file = file (n-1) in
if file_exists file
then aux ((file,n) :: accu) (n+1)
else accu
in
aux [] 1
in
let rec rename = function
| (f,n) :: t when n < !access_log_nb_files ->
Unix.rename f (file n);
rename t
| _ -> ()
in
rename log_files;
close_out !fd;
fd := open_out !access_log_file
*)
let sanitize_data data =
let data = String.copy data in
@@ -154,86 +195,68 @@ let sanitize_data data =
done;
String.escaped data
let make save_to_disk =
let fd = ref (open_out_gen [Open_append; Open_creat] 0o644 !access_log_file) in
let counter = ref 0 in
{
fd = fd;
counter = counter;
write =
if not !activate_access_log || !access_log_nb_files = 0
then begin fun ~tid ~con ?data _ -> () end
else fun ~tid ~con ?(data="") access_type ->
let s = Printf.sprintf "[%s] %s %s %s\n" (string_of_date()) (string_of_tid ~con tid)
(string_of_access_type access_type) (sanitize_data data) in
let s =
if String.length s > line_size
then begin
let s = String.sub s 0 line_size in
s.[line_size-3] <- '.';
s.[line_size-2] <- '.';
s.[line_size-1] <- '\n';
s
end else
s
in
incr counter;
output_string !fd s;
flush !fd;
if !counter > !access_log_nb_lines
then begin
log_rotate fd;
save_to_disk ();
counter := 0;
end
}
let activate_access_log = ref true
let access_log_file = ref "/var/log/xenstored-access.log"
let access_log_nb_files = ref 20
let access_log_nb_lines = ref 13215
let access_log_nb_chars = ref 180
let access_log_read_ops = ref false
let access_log_transaction_ops = ref false
let access_log_special_ops = ref false
let access_logger = ref None
let access : (access option) ref = ref None
let init aal save_to_disk =
activate_access_log := aal;
access := Some (make save_to_disk)
let write_access_log ~con ~tid ?data access_type =
let init_access_log post_rotate =
if !access_log_nb_files > 0 then
let logger =
make_logger
!access_log_file !access_log_nb_files !access_log_nb_lines
!access_log_nb_chars post_rotate in
access_logger := Some logger
let access_logging ~con ~tid ?(data="") access_type =
try
maybe (fun a -> a.write access_type ~con ~tid ?data) !access
maybe
(fun logger ->
let date = string_of_date() in
let tid = string_of_tid ~con tid in
let access_type = string_of_access_type access_type in
let data = sanitize_data data in
logger.write "[%s] %s %s %s" date tid access_type data)
!access_logger
with _ -> ()
let new_connection = write_access_log Newconn
let end_connection = write_access_log Endconn
let new_connection = access_logging Newconn
let end_connection = access_logging Endconn
let read_coalesce ~tid ~con data =
if !log_read_ops
then write_access_log Coalesce ~tid ~con ~data:("read "^data)
let write_coalesce data = write_access_log Coalesce ~data:("write "^data)
let conflict = write_access_log Conflict
let commit = write_access_log Commit
if !access_log_read_ops
then access_logging Coalesce ~tid ~con ~data:("read "^data)
let write_coalesce data = access_logging Coalesce ~data:("write "^data)
let conflict = access_logging Conflict
let commit = access_logging Commit
let xb_op ~tid ~con ~ty data =
let print =
match ty with
| Xenbus.Xb.Op.Read | Xenbus.Xb.Op.Directory | Xenbus.Xb.Op.Getperms -> !log_read_ops
let print = match ty with
| Xenbus.Xb.Op.Read | Xenbus.Xb.Op.Directory | Xenbus.Xb.Op.Getperms -> !access_log_read_ops
| Xenbus.Xb.Op.Transaction_start | Xenbus.Xb.Op.Transaction_end ->
false (* transactions are managed below *)
| Xenbus.Xb.Op.Introduce | Xenbus.Xb.Op.Release | Xenbus.Xb.Op.Getdomainpath | Xenbus.Xb.Op.Isintroduced | Xenbus.Xb.Op.Resume ->
!log_special_ops
| _ -> true
in
if print
then write_access_log ~tid ~con ~data (XbOp ty)
!access_log_special_ops
| _ -> true in
if print then access_logging ~tid ~con ~data (XbOp ty)
let start_transaction ~tid ~con =
if !log_transaction_ops && tid <> 0
then write_access_log ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_start)
if !access_log_transaction_ops && tid <> 0
then access_logging ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_start)
let end_transaction ~tid ~con =
if !log_transaction_ops && tid <> 0
then write_access_log ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_end)
if !access_log_transaction_ops && tid <> 0
then access_logging ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_end)
let xb_answer ~tid ~con ~ty data =
let print = match ty with
| Xenbus.Xb.Op.Error when data="ENOENT " -> !log_read_ops
| Xenbus.Xb.Op.Error -> !log_special_ops
| Xenbus.Xb.Op.Error when String.startswith "ENOENT " data -> !access_log_read_ops
| Xenbus.Xb.Op.Error -> true
| Xenbus.Xb.Op.Watchevent -> true
| _ -> false
in
if print
then write_access_log ~tid ~con ~data (XbOp ty)
if print then access_logging ~tid ~con ~data (XbOp ty)
+5 -3
View File
@@ -15,6 +15,8 @@
* GNU Lesser General Public License for more details.
*)
let info fmt = Logging.info "perms" fmt
open Stdext
let activate = ref true
@@ -145,16 +147,16 @@ let check (connection:Connection.t) request (node:Node.t) =
in
match perm, request with
| NONE, _ ->
Logs.info "io" "Permission denied: Domain %d has no permission" domainid;
info "Permission denied: Domain %d has no permission" domainid;
false
| RDWR, _ -> true
| READ, READ -> true
| WRITE, WRITE -> true
| READ, _ ->
Logs.info "io" "Permission denied: Domain %d has read only access" domainid;
info "Permission denied: Domain %d has read only access" domainid;
false
| WRITE, _ ->
Logs.info "io" "Permission denied: Domain %d has write only access" domainid;
info "Permission denied: Domain %d has write only access" domainid;
false
in
if !activate
+10 -5
View File
@@ -14,6 +14,9 @@
* GNU Lesser General Public License for more details.
*)
let error fmt = Logging.error "process" fmt
let info fmt = Logging.info "process" fmt
open Printf
open Stdext
@@ -79,7 +82,7 @@ let create_implicit_path t perm path =
(* packets *)
let do_debug con t domains cons data =
if not !allow_debug
if not (Connection.is_dom0 con) && not !allow_debug
then None
else try match split None '\000' data with
| "print" :: msg :: _ ->
@@ -89,6 +92,9 @@ let do_debug con t domains cons data =
let domid = int_of_string domid in
let quota = (Store.get_quota t.Transaction.store) in
Some (Quota.to_string quota domid ^ "\000")
| "watches" :: _ ->
let watches = Connections.debug cons in
Some (watches ^ "\000")
| "mfn" :: domid :: _ ->
let domid = int_of_string domid in
let con = Connections.find_domain cons domid in
@@ -357,8 +363,7 @@ let process_packet ~store ~cons ~doms ~con ~tid ~rid ~ty ~data =
in
input_handle_error ~cons ~doms ~fct ~ty ~con ~t ~rid ~data;
with exn ->
Logs.error "general" "process packet: %s"
(Printexc.to_string exn);
error "process packet: %s" (Printexc.to_string exn);
Connection.send_error con tid rid "EIO"
let write_access_log ~ty ~tid ~con ~data =
@@ -372,7 +377,7 @@ let do_input store cons doms con =
let packet = Connection.pop_in con in
let tid, rid, ty, data = Xenbus.Xb.Packet.unpack packet in
(* As we don't log IO, do not call an unnecessary sanitize_data
Logs.info "io" "[%s] -> [%d] %s \"%s\""
info "[%s] -> [%d] %s \"%s\""
(Connection.get_domstr con) tid
(Xenbus.Xb.Op.to_string ty) (sanitize_data data); *)
process_packet ~store ~cons ~doms ~con ~tid ~rid ~ty ~data;
@@ -386,7 +391,7 @@ let do_output store cons doms con =
let packet = Connection.peek_output con in
let tid, rid, ty, data = Xenbus.Xb.Packet.unpack packet in
(* As we don't log IO, do not call an unnecessary sanitize_data
Logs.info "io" "[%s] <- %s \"%s\""
info "[%s] <- %s \"%s\""
(Connection.get_domstr con)
(Xenbus.Xb.Op.to_string ty) (sanitize_data data);*)
write_answer_log ~ty ~tid ~con ~data;
+1 -1
View File
@@ -18,7 +18,7 @@ exception Limit_reached
exception Data_too_big
exception Transaction_opened
let warn fmt = Logs.warn "general" fmt
let warn fmt = Logging.warn "quota" fmt
let activate = ref true
let maxent = ref (10000)
let maxsize = ref (4096)
+1 -1
View File
@@ -83,7 +83,7 @@ let check_perm node connection request =
let check_owner node connection =
if not (Perms.check_owner connection node.perms)
then begin
Logs.info "io" "Permission denied: Domain %d not owner" (get_owner node);
Logging.info "store|node" "Permission denied: Domain %d not owner" (get_owner node);
raise Define.Permission_denied;
end
+10 -5
View File
@@ -22,9 +22,14 @@ quota-transaction = 10
# Activate filed base backend
persistant = false
# Logs
log = error;general;file:/var/log/xenstored.log
log = warn;general;file:/var/log/xenstored.log
log = info;general;file:/var/log/xenstored.log
# Xenstored logs
# xenstored-log-file = /var/log/xenstored.log
# xenstored-log-level = null
# xenstored-log-nb-files = 10
# Xenstored access logs
# access-log-file = /var/log/xenstored-access.log
# access-log-nb-lines = 13215
# acesss-log-nb-chars = 180
# access-log-special-ops = false
# log = debug;io;file:/var/log/xenstored-io.log
+28 -34
View File
@@ -18,7 +18,10 @@
open Printf
open Parse_arg
open Stdext
open Logging
let error fmt = Logging.error "xenstored" fmt
let debug fmt = Logging.debug "xenstored" fmt
let info fmt = Logging.info "xenstored" fmt
(*------------ event klass processors --------------*)
let process_connection_fds store cons domains rset wset =
@@ -64,7 +67,8 @@ let sigusr1_handler store =
()
let sighup_handler _ =
try Logs.reopen (); info "Log re-opened" with _ -> ()
maybe (fun logger -> logger.Logging.restart()) !Logging.xenstored_logger;
maybe (fun logger -> logger.Logging.restart()) !Logging.access_logger
let config_filename cf =
match cf.config_file with
@@ -75,26 +79,6 @@ let default_pidfile = "/var/run/xenstored.pid"
let parse_config filename =
let pidfile = ref default_pidfile in
let set_log s =
let ls = String.split ~limit:3 ';' s in
let level, key, logger = match ls with
| [ level; key; logger ] -> level, key, logger
| _ -> failwith "format mismatch: expecting 3 arguments" in
let loglevel = match level with
| "debug" -> Log.Debug
| "info" -> Log.Info
| "warn" -> Log.Warn
| "error" -> Log.Error
| s -> failwith (sprintf "Unknown log level: %s" s) in
(* if key is empty, append to the default logger *)
let append =
if key = "" then
Logs.append_default
else
Logs.append key in
append loglevel logger in
let options = [
("merge-activate", Config.Set_bool Transaction.do_coalesce);
("perms-activate", Config.Set_bool Perms.activate);
@@ -104,14 +88,20 @@ let parse_config filename =
("quota-maxentity", Config.Set_int Quota.maxent);
("quota-maxsize", Config.Set_int Quota.maxsize);
("test-eagain", Config.Set_bool Transaction.test_eagain);
("log", Config.String set_log);
("persistant", Config.Set_bool Disk.enable);
("xenstored-log-file", Config.Set_string Logging.xenstored_log_file);
("xenstored-log-level", Config.String
(fun s -> Logging.xenstored_log_level := Logging.level_of_string s));
("xenstored-log-nb-files", Config.Set_int Logging.xenstored_log_nb_files);
("xenstored-log-nb-lines", Config.Set_int Logging.xenstored_log_nb_lines);
("xenstored-log-nb-chars", Config.Set_int Logging.xenstored_log_nb_chars);
("access-log-file", Config.Set_string Logging.access_log_file);
("access-log-nb-files", Config.Set_int Logging.access_log_nb_files);
("access-log-nb-lines", Config.Set_int Logging.access_log_nb_lines);
("access-log-read-ops", Config.Set_bool Logging.log_read_ops);
("access-log-transactions-ops", Config.Set_bool Logging.log_transaction_ops);
("access-log-special-ops", Config.Set_bool Logging.log_special_ops);
("access-log-nb-chars", Config.Set_int Logging.access_log_nb_chars);
("access-log-read-ops", Config.Set_bool Logging.access_log_read_ops);
("access-log-transactions-ops", Config.Set_bool Logging.access_log_transaction_ops);
("access-log-special-ops", Config.Set_bool Logging.access_log_special_ops);
("allow-debug", Config.Set_bool Process.allow_debug);
("pid-file", Config.Set_string pidfile); ] in
begin try Config.read filename options (fun _ _ -> raise Not_found)
@@ -223,9 +213,6 @@ let to_file store cons file =
end
let _ =
printf "Xen Storage Daemon, version %d.%d\n%!"
Define.xenstored_major Define.xenstored_minor;
let cf = do_argv in
let pidfile =
if Sys.file_exists (config_filename cf) then
@@ -249,13 +236,13 @@ let _ =
in
if cf.daemonize then
Unixext.daemonize ();
Unixext.daemonize ()
else
printf "Xen Storage Daemon, version %d.%d\n%!"
Define.xenstored_major Define.xenstored_minor;
(try Unixext.pidfile_write pidfile with _ -> ());
info "Xen Storage Daemon, version %d.%d"
Define.xenstored_major Define.xenstored_minor;
(* for compatilibity with old xenstored *)
begin match cf.pidfile with
| Some pidfile -> Unixext.pidfile_write pidfile
@@ -293,7 +280,14 @@ let _ =
Sys.set_signal Sys.sigusr1 (Sys.Signal_handle (fun i -> sigusr1_handler store));
Sys.set_signal Sys.sigpipe Sys.Signal_ignore;
Logging.init cf.activate_access_log (fun () -> DB.to_file store cons "/var/run/xenstored/db");
Logging.init_xenstored_log();
if cf.activate_access_log then begin
let post_rotate () = DB.to_file store cons "/var/run/xenstored/db" in
Logging.init_access_log post_rotate
end;
info "Xen Storage Daemon, version %d.%d"
Define.xenstored_major Define.xenstored_minor;
let spec_fds =
(match rw_sock with None -> [] | Some x -> [ x ]) @
Reference in new issue
Block a user
Blocking a user prevents them from interacting with repositories, such as opening or commenting on pull requests or issues. Learn more about blocking a user.