diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/session.ml | 4 | ||||
| -rw-r--r-- | src/session.mli | 3 | ||||
| -rw-r--r-- | src/vyconf_client.ml | 16 | ||||
| -rw-r--r-- | src/vyconf_client.mli | 2 | ||||
| -rw-r--r-- | src/vyconf_pb.ml | 129 | ||||
| -rw-r--r-- | src/vyconf_pb.mli | 31 | ||||
| -rw-r--r-- | src/vyconfd.ml | 102 |
7 files changed, 240 insertions, 47 deletions
diff --git a/src/session.ml b/src/session.ml index 02166c2..86374dd 100644 --- a/src/session.ml +++ b/src/session.ml @@ -9,7 +9,7 @@ type cfg_op = | CfgDelete of string list * string option type world = { - mutable running_config: CT.t; + running_config: CT.t; reference_tree: RT.t; vyconf_config: Vyconf_config.t; dirs: Directories.t @@ -18,6 +18,7 @@ type world = { type session_data = { proposed_config : Config_tree.t; modified: bool; + conf_mode: bool; changeset: cfg_op list; client_app: string; user: string; @@ -26,6 +27,7 @@ type session_data = { let make world client_app user = { proposed_config = world.running_config; modified = false; + conf_mode = false; changeset = []; client_app = client_app; user = user diff --git a/src/session.mli b/src/session.mli index 160cb72..dfe2967 100644 --- a/src/session.mli +++ b/src/session.mli @@ -3,7 +3,7 @@ type cfg_op = | CfgDelete of string list * string option type world = { - mutable running_config: Config_tree.t; + running_config: Config_tree.t; reference_tree: Reference_tree.t; vyconf_config: Vyconf_config.t; dirs: Directories.t @@ -12,6 +12,7 @@ type world = { type session_data = { proposed_config : Config_tree.t; modified: bool; + conf_mode: bool; changeset: cfg_op list; client_app: string; user: string diff --git a/src/vyconf_client.ml b/src/vyconf_client.ml index 7db59ff..7528def 100644 --- a/src/vyconf_client.ml +++ b/src/vyconf_client.ml @@ -10,6 +10,11 @@ type t = { closed: bool } +let substitute_default d o= + match o with + | None -> d + | Some v -> v + let create sockfile = let open Lwt_unix in let sock = socket PF_UNIX SOCK_STREAM 0 in @@ -39,3 +44,14 @@ let get_status client = let req = Status in let%lwt resp = do_request client req in Lwt.return resp + +let setup_session ?(on_behalf_of=None) client client_app = + let id = on_behalf_of |> (function None -> None | Some x -> (Some (Int32.of_int x))) in + let req = Setup_session {client_application=(Some client_app); on_behalf_of=id} in + let%lwt resp = do_request client req in + match resp.status with + | Success -> + (match resp.output with + | Some token -> Lwt.return (Ok token) + | None -> failwith "setup_session did not return a token!") + | _ -> Error (substitute_default "Unknown error" resp.error) |> Lwt.return diff --git a/src/vyconf_client.mli b/src/vyconf_client.mli index 87fffdd..ff48d86 100644 --- a/src/vyconf_client.mli +++ b/src/vyconf_client.mli @@ -24,3 +24,5 @@ val create : string -> t Lwt.t val shutdown : t -> t Lwt.t val get_status : t -> response Lwt.t + +val setup_session : ?on_behalf_of:(int option) -> t -> string -> (string, string) result Lwt.t diff --git a/src/vyconf_pb.ml b/src/vyconf_pb.ml index ef36473..b2937cd 100644 --- a/src/vyconf_pb.ml +++ b/src/vyconf_pb.ml @@ -167,13 +167,13 @@ and request_run_op_mode_mutable = { } type request_enter_configuration_mode = { - exclusive : bool option; - override_exclusive : bool option; + exclusive : bool; + override_exclusive : bool; } and request_enter_configuration_mode_mutable = { - mutable exclusive : bool option; - mutable override_exclusive : bool option; + mutable exclusive : bool; + mutable override_exclusive : bool; } type request = @@ -196,6 +196,18 @@ type request = | Run_op_mode of request_run_op_mode | Confirm | Configure of request_enter_configuration_mode + | Exit_configure + | Teardown of string + +type request_envelope = { + token : string option; + request : request; +} + +and request_envelope_mutable = { + mutable token : string option; + mutable request : request; +} type status = | Success @@ -434,20 +446,33 @@ and default_request_run_op_mode_mutable () : request_run_op_mode_mutable = { } let rec default_request_enter_configuration_mode - ?exclusive:((exclusive:bool option) = None) - ?override_exclusive:((override_exclusive:bool option) = None) + ?exclusive:((exclusive:bool) = false) + ?override_exclusive:((override_exclusive:bool) = false) () : request_enter_configuration_mode = { exclusive; override_exclusive; } and default_request_enter_configuration_mode_mutable () : request_enter_configuration_mode_mutable = { - exclusive = None; - override_exclusive = None; + exclusive = false; + override_exclusive = false; } let rec default_request (): request = Status +let rec default_request_envelope + ?token:((token:string option) = None) + ?request:((request:request) = default_request ()) + () : request_envelope = { + token; + request; +} + +and default_request_envelope_mutable () : request_envelope_mutable = { + token = None; + request = default_request (); +} + let rec default_status () = (Success:status) let rec default_response @@ -907,14 +932,14 @@ let rec decode_request_enter_configuration_mode d = | None -> ( ) | Some (1, Pbrt.Varint) -> ( - v.exclusive <- Some (Pbrt.Decoder.bool d); + v.exclusive <- Pbrt.Decoder.bool d; loop () ) | Some (1, pk) -> raise ( Protobuf.Decoder.Failure (Protobuf.Decoder.Unexpected_payload ("Message(request_enter_configuration_mode), field(1)", pk)) ) | Some (2, Pbrt.Varint) -> ( - v.override_exclusive <- Some (Pbrt.Decoder.bool d); + v.override_exclusive <- Pbrt.Decoder.bool d; loop () ) | Some (2, pk) -> raise ( @@ -949,6 +974,8 @@ let rec decode_request d = | Some (17, _) -> Run_op_mode (decode_request_run_op_mode (Pbrt.Decoder.nested d)) | Some (18, _) -> (Pbrt.Decoder.empty_nested d ; Confirm) | Some (19, _) -> Configure (decode_request_enter_configuration_mode (Pbrt.Decoder.nested d)) + | Some (20, _) -> (Pbrt.Decoder.empty_nested d ; Exit_configure) + | Some (21, _) -> Teardown (Pbrt.Decoder.string d) | Some (n, payload_kind) -> ( Pbrt.Decoder.skip d payload_kind; loop () @@ -958,6 +985,32 @@ let rec decode_request d = in loop () +let rec decode_request_envelope d = + let v = default_request_envelope_mutable () in + let rec loop () = + match Pbrt.Decoder.key d with + | None -> ( + ) + | Some (1, Pbrt.Bytes) -> ( + v.token <- Some (Pbrt.Decoder.string d); + loop () + ) + | Some (1, pk) -> raise ( + Protobuf.Decoder.Failure (Protobuf.Decoder.Unexpected_payload ("Message(request_envelope), field(1)", pk)) + ) + | Some (2, Pbrt.Bytes) -> ( + v.request <- decode_request (Pbrt.Decoder.nested d); + loop () + ) + | Some (2, pk) -> raise ( + Protobuf.Decoder.Failure (Protobuf.Decoder.Unexpected_payload ("Message(request_envelope), field(2)", pk)) + ) + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind; loop () + in + loop (); + let v:request_envelope = Obj.magic v in + v + let rec decode_status d = match Pbrt.Decoder.int_as_varint d with | 0 -> (Success:status) @@ -1210,22 +1263,10 @@ let rec encode_request_run_op_mode (v:request_run_op_mode) encoder = () let rec encode_request_enter_configuration_mode (v:request_enter_configuration_mode) encoder = - ( - match v.exclusive with - | Some x -> ( - Pbrt.Encoder.key (1, Pbrt.Varint) encoder; - Pbrt.Encoder.bool x encoder; - ) - | None -> (); - ); - ( - match v.override_exclusive with - | Some x -> ( - Pbrt.Encoder.key (2, Pbrt.Varint) encoder; - Pbrt.Encoder.bool x encoder; - ) - | None -> (); - ); + Pbrt.Encoder.key (1, Pbrt.Varint) encoder; + Pbrt.Encoder.bool v.exclusive encoder; + Pbrt.Encoder.key (2, Pbrt.Varint) encoder; + Pbrt.Encoder.bool v.override_exclusive encoder; () let rec encode_request (v:request) encoder = @@ -1306,6 +1347,27 @@ let rec encode_request (v:request) encoder = Pbrt.Encoder.key (19, Pbrt.Bytes) encoder; Pbrt.Encoder.nested (encode_request_enter_configuration_mode x) encoder; ) + | Exit_configure -> ( + Pbrt.Encoder.key (20, Pbrt.Bytes) encoder; + Pbrt.Encoder.empty_nested encoder + ) + | Teardown x -> ( + Pbrt.Encoder.key (21, Pbrt.Bytes) encoder; + Pbrt.Encoder.string x encoder; + ) + +let rec encode_request_envelope (v:request_envelope) encoder = + ( + match v.token with + | Some x -> ( + Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; + Pbrt.Encoder.string x encoder; + ) + | None -> (); + ); + Pbrt.Encoder.key (2, Pbrt.Bytes) encoder; + Pbrt.Encoder.nested (encode_request v.request) encoder; + () let rec encode_status (v:status) encoder = match v with @@ -1505,8 +1567,8 @@ let rec pp_request_run_op_mode fmt (v:request_run_op_mode) = let rec pp_request_enter_configuration_mode fmt (v:request_enter_configuration_mode) = let pp_i fmt () = Format.pp_open_vbox fmt 1; - Pbrt.Pp.pp_record_field "exclusive" (Pbrt.Pp.pp_option Pbrt.Pp.pp_bool) fmt v.exclusive; - Pbrt.Pp.pp_record_field "override_exclusive" (Pbrt.Pp.pp_option Pbrt.Pp.pp_bool) fmt v.override_exclusive; + Pbrt.Pp.pp_record_field "exclusive" Pbrt.Pp.pp_bool fmt v.exclusive; + Pbrt.Pp.pp_record_field "override_exclusive" Pbrt.Pp.pp_bool fmt v.override_exclusive; Format.pp_close_box fmt () in Pbrt.Pp.pp_brk pp_i fmt () @@ -1532,6 +1594,17 @@ let rec pp_request fmt (v:request) = | Run_op_mode x -> Format.fprintf fmt "@[Run_op_mode(%a)@]" pp_request_run_op_mode x | Confirm -> Format.fprintf fmt "Confirm" | Configure x -> Format.fprintf fmt "@[Configure(%a)@]" pp_request_enter_configuration_mode x + | Exit_configure -> Format.fprintf fmt "Exit_configure" + | Teardown x -> Format.fprintf fmt "@[Teardown(%a)@]" Pbrt.Pp.pp_string x + +let rec pp_request_envelope fmt (v:request_envelope) = + let pp_i fmt () = + Format.pp_open_vbox fmt 1; + Pbrt.Pp.pp_record_field "token" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.token; + Pbrt.Pp.pp_record_field "request" pp_request fmt v.request; + Format.pp_close_box fmt () + in + Pbrt.Pp.pp_brk pp_i fmt () let rec pp_status fmt (v:status) = match v with diff --git a/src/vyconf_pb.mli b/src/vyconf_pb.mli index 49976b9..8205491 100644 --- a/src/vyconf_pb.mli +++ b/src/vyconf_pb.mli @@ -89,8 +89,8 @@ type request_run_op_mode = { } type request_enter_configuration_mode = { - exclusive : bool option; - override_exclusive : bool option; + exclusive : bool; + override_exclusive : bool; } type request = @@ -113,6 +113,13 @@ type request = | Run_op_mode of request_run_op_mode | Confirm | Configure of request_enter_configuration_mode + | Exit_configure + | Teardown of string + +type request_envelope = { + token : string option; + request : request; +} type status = | Success @@ -254,8 +261,8 @@ val default_request_run_op_mode : (** [default_request_run_op_mode ()] is the default value for type [request_run_op_mode] *) val default_request_enter_configuration_mode : - ?exclusive:bool option -> - ?override_exclusive:bool option -> + ?exclusive:bool -> + ?override_exclusive:bool -> unit -> request_enter_configuration_mode (** [default_request_enter_configuration_mode ()] is the default value for type [request_enter_configuration_mode] *) @@ -263,6 +270,13 @@ val default_request_enter_configuration_mode : val default_request : unit -> request (** [default_request ()] is the default value for type [request] *) +val default_request_envelope : + ?token:string option -> + ?request:request -> + unit -> + request_envelope +(** [default_request_envelope ()] is the default value for type [request_envelope] *) + val default_status : unit -> status (** [default_status ()] is the default value for type [status] *) @@ -338,6 +352,9 @@ val decode_request_enter_configuration_mode : Pbrt.Decoder.t -> request_enter_co val decode_request : Pbrt.Decoder.t -> request (** [decode_request decoder] decodes a [request] value from [decoder] *) +val decode_request_envelope : Pbrt.Decoder.t -> request_envelope +(** [decode_request_envelope decoder] decodes a [request_envelope] value from [decoder] *) + val decode_status : Pbrt.Decoder.t -> status (** [decode_status decoder] decodes a [status] value from [decoder] *) @@ -407,6 +424,9 @@ val encode_request_enter_configuration_mode : request_enter_configuration_mode - val encode_request : request -> Pbrt.Encoder.t -> unit (** [encode_request v encoder] encodes [v] with the given [encoder] *) +val encode_request_envelope : request_envelope -> Pbrt.Encoder.t -> unit +(** [encode_request_envelope v encoder] encodes [v] with the given [encoder] *) + val encode_status : status -> Pbrt.Encoder.t -> unit (** [encode_status v encoder] encodes [v] with the given [encoder] *) @@ -476,6 +496,9 @@ val pp_request_enter_configuration_mode : Format.formatter -> request_enter_conf val pp_request : Format.formatter -> request -> unit (** [pp_request v] formats v *) +val pp_request_envelope : Format.formatter -> request_envelope -> unit +(** [pp_request_envelope v] formats v *) + val pp_status : Format.formatter -> status -> unit (** [pp_status v] formats v *) diff --git a/src/vyconfd.ml b/src/vyconfd.ml index 0e3340f..c07b1b3 100644 --- a/src/vyconfd.ml +++ b/src/vyconfd.ml @@ -1,6 +1,7 @@ open Lwt open Defaults open Vyconf_config +open Vyconf_pb (* On UNIX, self_init uses /dev/random for seed *) let () = Random.self_init () @@ -13,7 +14,11 @@ let config_file = ref defaults.config_file let log_file = ref None (* Global data *) +let sessions : (string, Session.session_data) Hashtbl.t = Hashtbl.create 10 +let commit_lock : string option ref = ref None + +let conf_mode_lock : string option ref = ref None (* Command line arguments *) let args = [ @@ -27,47 +32,118 @@ let args = [ ] let usage = "Usage: " ^ Sys.argv.(0) ^ " [options]" +let response_tmpl = {status=Success; output=None; error=None; warning=None} + let make_session_token () = Sha1.string (string_of_int (Random.bits ())) |> Sha1.to_hex -let rec handle_connection ic oc () = +let setup_session world req = + let token = make_session_token () in + let user = "unknown user" in + let client_app = Util.substitute_default req.client_application "unknown client" in + let () = Hashtbl.add sessions token (Session.make world client_app user) in + {response_tmpl with output=(Some token)} + +let enter_conf_mode req token = + let open Session in + let aux token session = + let open Session in + let session = {session with conf_mode=true} in + Hashtbl.replace sessions token session; + response_tmpl + in + let lock = !conf_mode_lock in + let session = Hashtbl.find sessions token in + match lock with + | Some user -> + if req.override_exclusive then aux token session + else + {response_tmpl with + status=Configuration_locked; + error=Some (Printf.sprintf "Configuration was locked by %s" user)} + | None -> + if req.exclusive then (conf_mode_lock := Some session.user; aux token session) + else aux token session + +let exit_conf_mode world token = + let open Session in + let session = Hashtbl.find sessions token in + let session = {session with + proposed_config=world.running_config; + changeset = []; + modified = false} + in Hashtbl.replace sessions token session; + response_tmpl + +let teardown_session token = + try + Hashtbl.remove sessions token; + response_tmpl + with Not_found -> + {response_tmpl with status=Fail; error=(Some "Session not found")} + +let rec handle_connection world 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 req = + let envelope = decode_request_envelope (Pbrt.Decoder.of_bytes req_msg) in + Lwt.return (envelope.token, envelope.request) + in let%lwt resp = (match req with - | Status -> {status=Success; output=None; error=None; warning=(Some "None of the other functions are implemented though")} + | _, Status -> response_tmpl + | _, Setup_session r -> setup_session world r + | None, _ -> {response_tmpl with status=Fail; output=(Some "Operation requires session token")} + | Some t, Teardown _ -> teardown_session t + | Some t, Configure r -> enter_conf_mode r t + | Some t, Exit_configure -> exit_conf_mode world t | _ -> 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 () + handle_connection world ic oc () with - | Failure e -> Lwt_log.error e >>= handle_connection ic oc + | Failure e -> Lwt_log.error e >>= handle_connection world ic oc | End_of_file -> Lwt_log.info "Connection closed" >>= return -let accept_connection conn = +let accept_connection world 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.on_failure (handle_connection world 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 +let main_loop world () = + let open Session in + let%lwt () = Startup.setup_logger !daemonize !log_file world.vyconf_config.log_template in + let%lwt () = Lwt_log.notice @@ Printf.sprintf "Starting VyConf for %s" world.vyconf_config.app_name in + let%lwt sock = Startup.create_socket world.vyconf_config.socket in + let%lwt serve = Startup.create_server (accept_connection world) sock () in serve () +let load_interface_definitions dir = + let open Session in + let reftree = Reference_tree.load_interface_definitions dir in + match reftree with + | Ok r -> r + | Error s -> Startup.panic s + +let make_world config dirs = + let open Directories in + let open Session in + let reftree = load_interface_definitions dirs.interface_definitions in + let running_config = Config_tree.make "root" in + {running_config=running_config; reference_tree=reftree; vyconf_config=config; dirs=dirs} + 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 () + let world = make_world config dirs in + Lwt_main.run @@ main_loop world () |