blob: 0e3340f685ccfdda857f5979dc89d3c9cf69c78c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
open Lwt
open Defaults
open Vyconf_config
(* On UNIX, self_init uses /dev/random for seed *)
let () = Random.self_init ()
let () = Lwt_log.add_rule "*" Lwt_log.Info
(* Default VyConf configuration *)
let daemonize = ref true
let config_file = ref defaults.config_file
let log_file = ref None
(* Global data *)
(* Command line arguments *)
let args = [
("--no-daemon", Arg.Unit (fun () -> daemonize := false),
"Do not daemonize");
("--config", Arg.String (fun s -> config_file := s),
(Printf.sprintf "<string> Configuration file, default is %s" defaults.config_file));
("--log-file", Arg.String (fun s -> log_file := Some s),
"<string> Log file");
("--version", Arg.Unit (fun () -> print_endline @@ Version.version_info (); exit 0), "Print version and exit")
]
let usage = "Usage: " ^ Sys.argv.(0) ^ " [options]"
let make_session_token () =
Sha1.string (string_of_int (Random.bits ())) |> Sha1.to_hex
let rec handle_connection ic oc () =
let open Vyconf_pb in
try%lwt
let%lwt req_msg = Message.read ic in
let%lwt req = decode_request (Pbrt.Decoder.of_bytes req_msg) |> return in
let%lwt resp =
(match req with
| Status -> {status=Success; output=None; error=None; warning=(Some "None of the other functions are implemented though")}
| _ -> failwith "Unimplemented") |> return
in
let enc = Pbrt.Encoder.create () in
let%lwt () = encode_response resp enc |> return in
let%lwt resp_msg = Pbrt.Encoder.to_bytes enc |> return in
let%lwt () = Message.write oc resp_msg in
handle_connection ic oc ()
with
| Failure e -> Lwt_log.error e >>= handle_connection ic oc
| End_of_file -> Lwt_log.info "Connection closed" >>= return
let accept_connection conn =
let fd, _ = conn in
let ic = Lwt_io.of_fd Lwt_io.Input fd in
let oc = Lwt_io.of_fd Lwt_io.Output fd in
Lwt.on_failure (handle_connection ic oc ()) (fun e -> Lwt_log.ign_error (Printexc.to_string e));
Lwt_log.info "New connection" >>= return
let main_loop config () =
let%lwt () = Startup.setup_logger !daemonize !log_file config.log_template in
let%lwt () = Lwt_log.notice @@ Printf.sprintf "Starting VyConf for %s" config.app_name in
let%lwt sock = Startup.create_socket config.socket in
let%lwt serve = Startup.create_server accept_connection sock () in
serve ()
let () =
let () = Arg.parse args (fun f -> ()) usage in
let config = Startup.load_config !config_file in
let () = Lwt_log.load_rules ("* -> " ^ config.log_level) in
let dirs = Directories.make config in
Startup.check_dirs dirs;
Lwt_main.run @@ main_loop config ()
|
