Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 85 lines (75 sloc) 3.097 kb
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (*
19 @author Louis Gesbert
20 **)
21
22 type options = { bind: Unix.inet_addr; port: int; backend: (module Badop.S) * Badop.options; daemonize: bool; pidfile: string option }
23
24 let options =
25 let default = {
26 bind = Unix.inet_addr_any;
27 port = 4849;
28 backend = Badop_meta.default;
29 daemonize = false;
30 pidfile = None;
31 } in
32 try
33 let wrap_parser parse =
34 fun o -> ServerArg.wrap (parse o.backend) (fun bo -> { o with backend = bo }) in
35 let p =
36 ServerArg.filter default
37 (ServerArg.make_parser ~final:true "Database server" (
38 (["--port";"-p"], ServerArg.func ServerArg.int (fun o p -> {o with port = p}),
39 "<int>", Printf.sprintf "Set the port the server should listen on (default %d)" default.port)
40 ::
41 (["--bind";"-b"],
42 ServerArg.func ServerArg.parse_addr
43 (fun o (addr,portopt) ->
44 {o with bind = addr; port = Option.default o.port portopt}),
45 "<addr>[:<port>]", Printf.sprintf "Bind the server to the given local address")
46 ::
c8454e4 [enhance] daemon: option not available on MacOS
Hugo Venturini authored
47 (if Config.os = Config.Mac then []
48 else [
fccc685 Initial open-source release
MLstate authored
49 (["--daemon";"-d"],
50 ServerArg.func (ServerArg.option ServerArg.string)
51 (fun o pidfile -> {o with daemonize = true; pidfile}),
9506f59 [doc] database server: better help message
Hugo Venturini authored
52 "[pidfile]", Printf.sprintf "Run in the background (does not exist on MacOS)")
c8454e4 [enhance] daemon: option not available on MacOS
Hugo Venturini authored
53 ])
54 @
fccc685 Initial open-source release
MLstate authored
55 List.map
56 (fun (arg,parse,params,help) -> arg, wrap_parser parse, params, help)
57 Badop_meta.options_parser
58 ))
59 in
60 if ServerArg.is_empty (ServerArg.get_argv ()) then p
61 else
62 (Printf.eprintf "Error: unknown command-line argument: %s\n" (ServerArg.argv_to_string ());
63 raise Exit)
64 with Exit -> exit 1
65
66 let sched = Scheduler.default
67 let endpoint = Hlnet.Tcp (options.bind, options.port)
68
69 module Db = (val (fst options.backend) : Badop.S)
70 module Server = Badop_server.F(Db)
71 let _ =
72 Server.start sched endpoint (snd options.backend)
73 (fun db ->
74 at_exit (fun () -> Server.stop db ignore);
75 if options.daemonize then
76 let child_pid = Unix.fork() in
77 if child_pid <> 0 then
78 (Option.iter
79 (fun pidfile -> let c = open_out pidfile in Printf.fprintf c "%d" child_pid; close_out c)
80 options.pidfile;
81 BaseUnix._exit 0)
82 else ignore (Unix.setsid()))
83
84 let _ = Scheduler.run sched
Something went wrong with that request. Please try again.