Commit df789f37 authored by Romain Beauxis's avatar Romain Beauxis

Merge commit 'upstream/0.2.0'

parents 17c0dfe2 cb04161d
0.2.0 (19-08-2010)
=====
* Use Thread.join instead of Thread.wait_signal
under Win32 (Thread.wait_signal is not implemented
in this case). Also do not use sigmask since it is
not implemented either.
* Added support for Syslog when detected.
0.1.6 (15-04-2008)
=====
* Added support for --enable-debugging configure option
* Reopen stdin/out/er instead of closing them
* Install .cmx file when available
* Set as blocked signals that we use with Thread.wait_signal,
i.e. sigterm and sigint. Those are not blocked
by default on some systems (e.g. freeBSD).
0.1.5 (12-12-2007)
=====
......
......@@ -2,7 +2,7 @@
SRC=src
PROGNAME=ocaml-dtools
DISTFILES = bootstrap VERSION CHANGES configure configure.ac \
DISTFILES = bootstrap CHANGES configure configure.ac \
COPYING Makefile README \
src/OCamlMakefile src/*Makefile.in src/META.in src/*.ml src/*.mli \
doc/html
......
This source diff could not be displayed because it is too large. You can view the blob instead.
AC_INIT(ocaml-dtools, 0.1.6, savonet-users@lists.sourceforge.net)
AC_INIT(ocaml-dtools, 0.2.0, savonet-users@lists.sourceforge.net)
VERSION=$PACKAGE_VERSION
AC_MSG_RESULT(configuring $PACKAGE_STRING)
REQUIRES="str unix thread"
OCAMLFIND_LDCONF=""
AC_ARG_ENABLE([ldconf], AC_HELP_STRING([--disable-ldconf],[don't modify the dynamic loader configuration file (default is enable)]),[ac_enable_ldconf=$enableval],[ac_enable_ldconf=$enableval],[ac_enable_ldconf=yes])
if test "$ac_enable_ldconf" = no ; then
......@@ -91,6 +92,15 @@ fi
AC_PATH_PROG(OCAMLDOC,ocamldoc,no)
AC_ARG_ENABLE([debugging],
AC_HELP_STRING(
[--enable-debugging],
[compile with debugging information (backtrace printing in particular)]))
if test "x$enable_debugging" = "xyes" ; then
OCAMLFLAGS="$OCAMLFLAGS -g"
fi
AC_PATH_PROG(OCAMLMKTOP,ocamlmktop,no)
if test "$OCAMLMKTOP" = no ; then
AC_MSG_ERROR(Cannot find ocamlmktop.)
......@@ -130,9 +140,34 @@ AC_PATH_PROG(PS2PDF,ps2pdf,no)
# AC_MSG_ERROR(Cannot find ps2pdf.)
#fi
#
# Syslog
#
AC_ARG_WITH([syslog-dir],
AC_HELP_STRING(
[--with-syslog-dir=path],
[look for ocaml-syslog library in "path" (autodetected by default)]))
AC_ARG_ENABLE([syslog],
AC_HELP_STRING([--disable-syslog],["don't use ocaml-syslog"]))
if test "x$enable_syslog" != "xno" ; then
AC_MSG_CHECKING(for ocaml-syslog)
if ! $OCAMLFIND query syslog > /dev/null 2>&1 ; then
SYSLOG_FILES=""
AC_MSG_RESULT(not found)
else
SYSLOG_FILES="dtools_syslog.ml"
AC_MSG_RESULT(ok)
REQUIRES="$REQUIRES syslog"
INC="$INC `$OCAMLFIND query syslog`"
fi
fi
# substitutions to perform
AC_SUBST(OCAMLC)
AC_SUBST(OCAMLOPT)
AC_SUBST(OCAMLFLAGS)
AC_SUBST(OCAMLDEP)
AC_SUBST(OCAMLLEX)
AC_SUBST(OCAMLYACC)
......@@ -147,6 +182,9 @@ AC_SUBST(OCAMLFIND_LDCONF)
AC_SUBST(OCAMLCP) # TODO
AC_SUBST(CAMLLIBPATH)
AC_SUBST(BEST)
AC_SUBST(REQUIRES)
AC_SUBST(SYSLOG_FILES)
AC_SUBST(INC)
AC_SUBST(LATEX) # TODO
AC_SUBST(DVIPS) # TODO
......
......@@ -24,6 +24,30 @@
Type for loggers.<br>
</div>
<br><code><span class="keyword">type</span> <a name="TYPEcustom_log"></a><code class="type"></code>custom_log = {</code><table class="typetable">
<tr>
<td align="left" valign="top" >
<code>&nbsp;&nbsp;</code></td>
<td align="left" valign="top" >
<code>timestamp&nbsp;: <code class="type">bool</code>;</code></td>
</tr>
<tr>
<td align="left" valign="top" >
<code>&nbsp;&nbsp;</code></td>
<td align="left" valign="top" >
<code>exec&nbsp;: <code class="type">string -> unit</code>;</code></td>
</tr></table>
}
<pre><span class="keyword">val</span> <a name="VALadd_custom_log"></a>add_custom_log : <code class="type">string -> <a href="Dtools.Log.html#TYPEcustom_log">custom_log</a> -> unit</code></pre><div class="info">
Add a custom logging functions.<br>
</div>
<pre><span class="keyword">val</span> <a name="VALrm_custom_log"></a>rm_custom_log : <code class="type">string -> unit</code></pre><div class="info">
Remove a custom logging functions.<br>
</div>
<pre><span class="keyword">val</span> <a name="VALmake"></a>make : <code class="type"><a href="Dtools.Conf.html#TYPEpath">Dtools.Conf.path</a> -> <a href="Dtools.Log.html#TYPEt">t</a></code></pre><div class="info">
Make a logger labeled according to the given path.<br>
</div>
......
......@@ -18,6 +18,9 @@
Receipt to build a 'a key
</div>
</td></tr>
<tr><td align="left"><br>C</td></tr>
<tr><td><a href="Dtools.Log.html#TYPEcustom_log">custom_log</a> [<a href="Dtools.Log.html">Dtools.Log</a>]</td>
<td></td></tr>
<tr><td align="left"><br>L</td></tr>
<tr><td><a href="Dtools.Conf.html#TYPElink">link</a> [<a href="Dtools.Conf.html">Dtools.Conf</a>]</td>
<td><div class="info">
......
......@@ -13,6 +13,11 @@
<center><h1>Index of values</h1></center>
<table>
<tr><td align="left"><br>A</td></tr>
<tr><td><a href="Dtools.Log.html#VALadd_custom_log">add_custom_log</a> [<a href="Dtools.Log.html">Dtools.Log</a>]</td>
<td><div class="info">
Add a custom logging functions.
</div>
</td></tr>
<tr><td><a href="Dtools.Log.html#VALargs">args</a> [<a href="Dtools.Log.html">Dtools.Log</a>]</td>
<td><div class="info">
A set of command line options to be used with the Arg module.
......@@ -156,6 +161,12 @@ Define a init atom associated with the given <code class="code">(unit -&gt; unit
Convert a dot separated string to a path
</div>
</td></tr>
<tr><td align="left"><br>R</td></tr>
<tr><td><a href="Dtools.Log.html#VALrm_custom_log">rm_custom_log</a> [<a href="Dtools.Log.html">Dtools.Log</a>]</td>
<td><div class="info">
Remove a custom logging functions.
</div>
</td></tr>
<tr><td align="left"><br>S</td></tr>
<tr><td><a href="Dtools.Log.html#VALstart">start</a> [<a href="Dtools.Log.html">Dtools.Log</a>]</td>
<td><div class="info">
......
......@@ -13,6 +13,9 @@
&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;t&nbsp;=<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;&nbsp;active&nbsp;:&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool;<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;f&nbsp;:&nbsp;<span class="keywordsign">'</span>a.&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;string,&nbsp;unit)&nbsp;<span class="constructor">Pervasives</span>.format4&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;&gt;<br>
&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;custom_log&nbsp;=&nbsp;{&nbsp;timestamp&nbsp;:&nbsp;bool;&nbsp;exec&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit;&nbsp;}<br>
&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;add_custom_log&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dtools</span>.<span class="constructor">Log</span>.custom_log&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;rm_custom_log&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;make&nbsp;:&nbsp;<span class="constructor">Dtools</span>.<span class="constructor">Conf</span>.path&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dtools</span>.<span class="constructor">Log</span>.t<br>
&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;start&nbsp;:&nbsp;<span class="constructor">Dtools</span>.<span class="constructor">Init</span>.t<br>
&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;stop&nbsp;:&nbsp;<span class="constructor">Dtools</span>.<span class="constructor">Init</span>.t<br>
......
......@@ -107,6 +107,9 @@
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;t&nbsp;=<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;&nbsp;active&nbsp;:&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool;<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;f&nbsp;:&nbsp;<span class="keywordsign">'</span>a.&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;string,&nbsp;unit)&nbsp;<span class="constructor">Pervasives</span>.format4&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;&gt;<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;custom_log&nbsp;=&nbsp;{&nbsp;timestamp&nbsp;:&nbsp;bool;&nbsp;exec&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit;&nbsp;}<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;add_custom_log&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dtools</span>.<span class="constructor">Log</span>.custom_log&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;rm_custom_log&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;make&nbsp;:&nbsp;<span class="constructor">Dtools</span>.<span class="constructor">Conf</span>.path&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dtools</span>.<span class="constructor">Log</span>.t<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;start&nbsp;:&nbsp;<span class="constructor">Dtools</span>.<span class="constructor">Init</span>.t<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;stop&nbsp;:&nbsp;<span class="constructor">Dtools</span>.<span class="constructor">Init</span>.t<br>
......
name="dtools"
version="@PACKAGE_VERSION@"
description="OCaml deamon tools library"
requires="str unix threads"
requires="@REQUIRES@"
archive(byte) = "dtools.cma"
archive(native) = "dtools.cmxa"
......@@ -19,11 +19,13 @@ OCAMLLIBPATH = @CAMLLIBPATH@
BEST = @BEST@
THREADS = "yes"
SOURCES = dtools.ml dtools.mli
SOURCES = dtools.ml dtools.mli @SYSLOG_FILES@
RESULT = dtools
LIBINSTALL_FILES = $(wildcard *.cma *.cmxa *.cmx *.mli *.cmi *.a)
OCAMLLDFLAGS =
LIBS =
OCAMLLDFLAGS = -linkall
INCDIRS = @INC@
NO_CUSTOM = yes
OCAMLFLAGS = @OCAMLFLAGS@
all: $(BEST)
......
(**************************************************************************)
(* ocaml-dtools *)
(* Copyright (C) 2003-2006 The Savonet Team *)
(* Copyright (C) 2003-2010 The Savonet Team *)
(**************************************************************************)
(* This program is free software; you can redistribute it and/or modify *)
(* it under the terms of the GNU General Public License as published by *)
(* the Free Software Foundation; either version 2 of the License, or *)
(* any later version. *)
(**************************************************************************)
(* Contact: dev@gim.name *)
(* Contact: savonet-devl@lists.sourceforge.net *)
(**************************************************************************)
(* $Id: dtools.ml 5102 2008-02-09 14:19:41Z metamorph68 $ *)
(* $Id: dtools.ml 7381 2010-07-11 05:49:58Z metamorph68 $ *)
(**
ocaml-dtools
......@@ -382,8 +382,12 @@ struct
let conf =
Conf.void "initialization configuration"
(* Unix.fork is not implemented in Win32. *)
let daemon_conf =
if Sys.os_type <> "Win32" then conf
else Conf.void "dummy conf"
let conf_daemon =
Conf.bool ~p:(conf#plug "daemon") ~d:false
Conf.bool ~p:(daemon_conf#plug "daemon") ~d:false
"run in daemon mode"
let conf_daemon_pidfile =
Conf.bool ~p:(conf_daemon#plug "pidfile") ~d:false
......@@ -501,7 +505,10 @@ struct
let main f () =
begin try exec start with e -> raise (StartError e) end;
let quit pid = Unix.kill pid Sys.sigterm in
let quit pid =
if Sys.os_type <> "Win32" then
Unix.kill pid Sys.sigterm
in
let thread pid =
begin try f (); quit pid with
| e ->
......@@ -512,8 +519,11 @@ struct
if conf_catch_exn#get then quit pid else raise e
end
in
ignore (Thread.create thread (Unix.getpid ()));
wait_signal ();
let th = Thread.create thread (Unix.getpid ()) in
if Sys.os_type <> "Win32" then
wait_signal ()
else
Thread.join th ;
begin try exec stop with e -> raise (StopError e) end
let catch f clean =
......@@ -535,14 +545,16 @@ struct
end
(** A function to reopen a file descriptor
* Thanks to Xavier Leroy !
* Ref: http://caml.inria.fr/pub/ml-archives/caml-list/2000/01/a7e3bbdfaab33603320d75dbdcd40c37.en.html
* Thanks to Xavier Leroy!
* Ref: http://caml.inria.fr/pub/ml-archives/caml-list/2000/01/
* a7e3bbdfaab33603320d75dbdcd40c37.en.html
*)
let reopen_out outchan filename =
flush outchan;
let fd1 = Unix.descr_of_out_channel outchan in
let fd2 =
Unix.openfile filename [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0o666 in
Unix.openfile filename [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0o666
in
Unix.dup2 fd2 fd1;
Unix.close fd2
......@@ -550,7 +562,8 @@ struct
let reopen_in inchan filename =
let fd1 = Unix.descr_of_in_channel inchan in
let fd2 =
Unix.openfile filename [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0o666 in
Unix.openfile filename [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0o666
in
Unix.dup2 fd2 fd1;
Unix.close fd2
......@@ -601,16 +614,25 @@ struct
let signal_h i = () in
Sys.set_signal Sys.sigterm (Sys.Signal_handle signal_h);
Sys.set_signal Sys.sigint (Sys.Signal_handle signal_h);
if conf_daemon#get
then daemonize (main f)
else catch (main f) (fun () -> ())
(* We block signals that would kill us,
* we'll wait for them and shutdown cleanly.
* On Windows this is impossible so the only way for the application
* to shutdown is to terminate the main function [f]. *)
if Sys.os_type <> "Win32" then
ignore (Unix.sigprocmask Unix.SIG_BLOCK [Sys.sigterm; Sys.sigint]);
if conf_daemon#get && Sys.os_type <> "Win32" then
daemonize (main f)
else
catch (main f) (fun () -> ())
let args =
[
["--daemon";"-d"],
Arg.Unit (fun () -> conf_daemon#set true),
"run in daemon mode";
]
if Sys.os_type <> "Win32" then
[
["--daemon";"-d"],
Arg.Unit (fun () -> conf_daemon#set true),
"run in daemon mode";
]
else []
end
......@@ -623,11 +645,23 @@ struct
f: 'a. int -> ('a, unit, string, unit) format4 -> 'a;
>
type custom_log =
{
timestamp : bool ;
exec : string -> unit
}
let log_ch = ref None
(* Mutex to avoid interlacing logs *)
let log_mutex = Mutex.create ()
(* Custom logging methods. *)
let custom_log : (string, custom_log) Hashtbl.t = Hashtbl.create 0
let add_custom_log name f = Hashtbl.replace custom_log name f
let rm_custom_log name = Hashtbl.remove custom_log name
let conf =
Conf.void "log configuration"
......@@ -680,22 +714,27 @@ struct
let print (time, str) =
let to_stdout = conf_stdout#get in
let to_file = !log_ch <> None in
let timestamp = timestamp time in
let message =
Printf.sprintf "%s %s" timestamp str
in
begin match to_stdout || to_file with
| true ->
let timestamp = timestamp time in
let do_stdout () =
Printf.printf "%s %s\n%!" timestamp str;
Printf.printf "%s\n%!" message;
in
let do_file () =
begin match !log_ch with
| None -> ()
| Some ch -> Printf.fprintf ch "%s %s\n%!" timestamp str;
| Some ch -> Printf.fprintf ch "%s\n%!" message;
end
in
if to_stdout then do_stdout ();
if to_file then do_file ();
| false -> ()
end
end ;
let f _ x = x.exec (if x.timestamp then message else str) in
Hashtbl.iter f custom_log
let proceed entry =
mutexify (fun () ->
......@@ -768,7 +807,8 @@ struct
let log_file_path = conf_file_path#get in
let log_file_perms = conf_file_perms#get in
(* Re-open log file on SIGUSR1 -- for logrotate *)
Sys.set_signal Sys.sigusr1
if Sys.os_type <> "Win32" then
Sys.set_signal Sys.sigusr1
(Sys.Signal_handle
begin fun _ ->
begin match !log_ch with
......
(**************************************************************************)
(* ocaml-dtools *)
(* Copyright (C) 2003-2006 The Savonet Team *)
(* Copyright (C) 2003-2010 The Savonet Team *)
(**************************************************************************)
(* This program is free software; you can redistribute it and/or modify *)
(* it under the terms of the GNU General Public License as published by *)
(* the Free Software Foundation; either version 2 of the License, or *)
(* any later version. *)
(**************************************************************************)
(* Contact: dev@gim.name *)
(* Contact: savonet-devl@lists.sourceforge.net *)
(**************************************************************************)
(* $Id: dtools.mli 4647 2007-10-06 16:35:48Z dbaelde $ *)
(* $Id: dtools.mli 7381 2010-07-11 05:49:58Z metamorph68 $ *)
(**
ocaml-dtools.
......@@ -255,6 +255,22 @@ sig
Type for loggers.
*)
type custom_log =
{
timestamp : bool ;
exec : string -> unit
}
val add_custom_log : string -> custom_log -> unit
(**
Add a custom logging functions.
*)
val rm_custom_log : string -> unit
(**
Remove a custom logging functions.
*)
val make : Conf.path -> t
(**
Make a logger labeled according to the given path.
......
(**************************************************************************)
(* ocaml-dtools *)
(* Copyright (C) 2003-2010 The Savonet Team *)
(**************************************************************************)
(* This program is free software; you can redistribute it and/or modify *)
(* it under the terms of the GNU General Public License as published by *)
(* the Free Software Foundation; either version 2 of the License, or *)
(* any later version. *)
(**************************************************************************)
(* Contact: savonet-devl@lists.sourceforge.net *)
(**************************************************************************)
(* $Id: dtools_syslog.ml 7381 2010-07-11 05:49:58Z metamorph68 $ *)
(* Syslog logging. *)
open Dtools
let conf_syslog =
Conf.bool ~p:(Log.conf#plug "syslog") ~d:false
"Enable syslog logging."
let conf_program =
Conf.string ~p:(conf_syslog#plug "program")
~d:(Filename.basename Sys.executable_name)
"Name of the program."
let conf_facility =
Conf.string ~p:(conf_syslog#plug "facility") ~d:"DAEMON"
"Logging facility."
let logging = ref None
let () =
let start () =
if conf_syslog#get then
let facility =
Syslog.facility_of_string conf_facility#get
in
let program =
Printf.sprintf "%s[%d]" conf_program#get (Unix.getpid ())
in
let log = Syslog.openlog ~facility program in
logging := Some log ;
let exec s = Syslog.syslog log `LOG_INFO s in
Log.add_custom_log
program { Log.
timestamp = false ;
exec = exec }
in
let stop () =
match !logging with
| Some x -> Syslog.closelog x
|_ -> ()
in
ignore (Dtools.Init.at_start ~before:[Log.start] start) ;
ignore (Dtools.Init.at_stop ~after:[Log.stop] stop)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment