diff options
70 files changed, 3401 insertions, 4901 deletions
@@ -7,13 +7,10 @@ *.cmx *.cmxs *.cmxa -*.native -*.byte *.mllib *.mldylib *.rej -setup.log -setup.data .ocp-indent -_build -META +_build/* +*.merlin +*.install diff --git a/.merlin b/.merlin deleted file mode 100644 index 81f4e4a..0000000 --- a/.merlin +++ /dev/null @@ -1,9 +0,0 @@ -S src -S test -B _build/src -B _build/test -PKG lwt lwt.unix -PKG ppx_deriving.runtime ppx_deriving.show -PKG fileutils pcre toml xml-light batteries -PKG oUnit -EXT lwt oUnit diff --git a/.ocamlinit b/.ocamlinit deleted file mode 100644 index 58bfe4a..0000000 --- a/.ocamlinit +++ /dev/null @@ -1,29 +0,0 @@ -(* Vyconf development environment for OCaml toplevel - * - * NOTE: To keep this functioning as expected, we will need to register new - * package dependencies here as they are added to the project. - * - * TODO: Automate the addition of dependencies via an _oasis plugin. - *) - -let () = - try Topdirs.dir_directory (Sys.getenv "OCAML_TOPLEVEL_PATH") - with Not_found -> () -;; - -#use "topfind";; - -#require "lwt";; -#require "lwt.unix";; -#require "lwt.ppx";; -#require "ppx_deriving.show";; -#require "ppx_deriving_yojson";; -#require "fileutils";; -#require "pcre";; -#require "toml";; -#require "xml-light";; -#require "batteries";; - -#cd "_build/src";; - -print_string "VyConf .ocamlinit has been successfully loaded\n";; diff --git a/Makefile b/Makefile deleted file mode 100644 index dcda8bd..0000000 --- a/Makefile +++ /dev/null @@ -1,49 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: a3c674b4239234cbbe53afe090018954) - -SETUP = ocaml setup.ml - -build: setup.data - $(SETUP) -build $(BUILDFLAGS) - -doc: setup.data build - $(SETUP) -doc $(DOCFLAGS) - -test: setup.data build - $(SETUP) -test $(TESTFLAGS) - -all: - $(SETUP) -all $(ALLFLAGS) - -install: setup.data - $(SETUP) -install $(INSTALLFLAGS) - -uninstall: setup.data - $(SETUP) -uninstall $(UNINSTALLFLAGS) - -reinstall: setup.data - $(SETUP) -reinstall $(REINSTALLFLAGS) - -clean: - $(SETUP) -clean $(CLEANFLAGS) - -distclean: - $(SETUP) -distclean $(DISTCLEANFLAGS) - -setup.data: - $(SETUP) -configure $(CONFIGUREFLAGS) - -configure: - $(SETUP) -configure $(CONFIGUREFLAGS) - -.PHONY: build doc test all install uninstall reinstall clean distclean configure - -# OASIS_STOP - -.PHONY: -schema: - scripts/rnc2rng.sh all data/schemata/ - -.PHONY: -protobuf: - ocaml-protoc -ml_out src/ data/vyconf.proto @@ -1,179 +0,0 @@ -Name: VyConf -Version: 0.1 -Synopsis: Appliance configuration framework -Authors: VyOS maintainers <maintainers@vyos.net> -License: LGPL with OCaml linking exception - -Description: VyConf -Homepage: http://vyos.net - -OASISFormat: 0.4 -BuildTools: ocamlbuild -Plugins: META (0.4), DevFiles (0.4) - -Library "vyconf" - Path: src - Modules: Config_tree, Reference_tree, Curly_parser, Curly_lexer, Value_checker, Vytree - InternalModules: Util, Vylist - BuildDepends: fileutils, pcre, ppx_deriving.show, ppx_deriving_yojson, xml-light, batteries - -Library "vyconfd-config" - Path: src - Modules: Vyconf_config - FindlibParent: vyconf - Install: false - BuildDepends: toml, fileutils, ppx_deriving.show, batteries - -Library "client" - Path: src - Modules: Vyconf_client - InternalModules: Vyconf_pb, Vyconf_types, Message, Util, Vylist - FindlibParent: vyconf - BuildDepends: lwt, lwt_ppx, lwt_log, ocaml-protoc, ocplib-endian, batteries, fileutils, yojson - -Executable "vyconfd" - Path: src - MainIs: vyconfd.ml - CompiledObject: best - BuildDepends: lwt, lwt.unix, lwt_ppx, lwt_log, ocaml-protoc, ocplib-endian, sha, batteries, vyconf, vyconf.vyconfd-config - -Executable "vycli" - Path: src - MainIs: vycli.ml - CompiledObject: best - BuildDepends: lwt, lwt.unix, lwt_ppx, ocaml-protoc, ocplib-endian, pcre, vyconf.client - -Executable "vytree_test" - Path: test - MainIs: vytree_test.ml - Build$: flag(tests) - CompiledObject: best - Install: false - BuildDepends: oUnit, vyconf - -Executable "reference_tree_test" - Path: test - MainIs: reference_tree_test.ml - Build$: flag(tests) - CompiledObject: best - Install: false - BuildDepends: oUnit, vyconf - -Executable "config_tree_test" - Path: test - MainIs: config_tree_test.ml - Build$: flag(tests) - CompiledObject: best - Install: false - BuildDepends: oUnit, vyconf, batteries - -Executable "vylist_test" - Path: test - MainIs: vylist_test.ml - Build$: flag(tests) - CompiledObject: best - Install: false - BuildDepends: oUnit - -Executable "value_checker_test" - Path: test - MainIs: value_checker_test.ml - Build$: flag(tests) - CompiledObject: best - Install: false - BuildDepends: oUnit, vyconf - -Executable "util_test" - Path: test - MainIs: util_test.ml - Build$: flag(tests) - CompiledObject: best - Install: false - BuildDepends: oUnit, vyconf - -Executable "vyconf_config_test" - Path: test - MainIs: vyconf_config_test.ml - Build$: flag(tests) - CompiledObject: best - Install: false - BuildDepends: oUnit, vyconf.vyconfd-config - -Executable "curly_parser_test" - Path: test - MainIs: curly_parser_test.ml - Build$: flag(tests) - CompiledObject: best - Install: false - BuildDepends: oUnit, vyconf - -Executable "session_test" - Path: test - MainIs: session_test.ml - Build$: flag(tests) - CompiledObject: best - Install: false - BuildDepends: oUnit, vyconf, vyconf.vyconfd-config - -Executable "vytree_load_test" - Path: test - MainIs: vytree_load_test.ml - Build$: flag(tests) - CompiledObject: best - Install: false - BuildDepends: vyconf - -Test "vytree_test" - Run$: flag(tests) - TestTools: vytree_test - Command: $vytree_test - WorkingDirectory: test - -Test "reference_tree_test" - Run$: flag(tests) - TestTools: reference_tree_test - Command: $reference_tree_test - WorkingDirectory: test - -Test "config_tree_test" - Run$: flag(tests) - TestTools: config_tree_test - Command: $config_tree_test - WorkingDirectory: test - -Test "vylist_test" - Run$: flag(tests) - TestTools: vylist_test - Command: $vylist_test - WorkingDirectory: test - -Test "value_checker_test" - Run$: flag(tests) - TestTools: value_checker_test - Command: $value_checker_test - WorkingDirectory: test - -Test "vyconf_config_test" - Run$: flag(tests) - TestTools: vyconf_config_test - Command: $vyconf_config_test - WorkingDirectory: test - -Test "curly_parser_test" - Run$: flag(tests) - TestTools: curly_parser_test - Command: $curly_parser_test - WorkingDirectory: test - -Test "util_test" - Run$: flag(tests) - TestTools: util_test - Command: $util_test - WorkingDirectory: test - -Test "session_test" - Run$: flag(tests) - TestTools: session_test - Command: $session_test - WorkingDirectory: test - @@ -1,150 +0,0 @@ -# OASIS_START -# DO NOT EDIT (digest: 4f1983ffc92b04ffaba30b6e019eb870) -# Ignore VCS directories, you can use the same kind of rule outside -# OASIS_START/STOP if you want to exclude directories that contains -# useless stuff for the build process -true: annot, bin_annot -<**/.svn>: -traverse -<**/.svn>: not_hygienic -".bzr": -traverse -".bzr": not_hygienic -".hg": -traverse -".hg": not_hygienic -".git": -traverse -".git": not_hygienic -"_darcs": -traverse -"_darcs": not_hygienic -# Library vyconf -"src/vyconf.cmxs": use_vyconf -# Library vyconf-config -"src/vyconf-config.cmxs": use_vyconf-config -# Library vyconf-client -"src/vyconf-client.cmxs": use_vyconf-client -# Executable vyconfd -<src/vyconfd.{native,byte}>: pkg_batteries -<src/vyconfd.{native,byte}>: pkg_fileutils -<src/vyconfd.{native,byte}>: pkg_lwt -<src/vyconfd.{native,byte}>: pkg_lwt.ppx -<src/vyconfd.{native,byte}>: pkg_lwt.unix -<src/vyconfd.{native,byte}>: pkg_ocaml-protoc -<src/vyconfd.{native,byte}>: pkg_ocplib-endian -<src/vyconfd.{native,byte}>: pkg_pcre -<src/vyconfd.{native,byte}>: pkg_ppx_deriving.show -<src/vyconfd.{native,byte}>: pkg_ppx_deriving_yojson -<src/vyconfd.{native,byte}>: pkg_sha -<src/vyconfd.{native,byte}>: pkg_toml -<src/vyconfd.{native,byte}>: pkg_xml-light -<src/vyconfd.{native,byte}>: use_vyconf -<src/vyconfd.{native,byte}>: use_vyconf-config -<src/*.ml{,i,y}>: pkg_batteries -<src/*.ml{,i,y}>: pkg_fileutils -<src/*.ml{,i,y}>: pkg_lwt -<src/*.ml{,i,y}>: pkg_lwt.ppx -<src/*.ml{,i,y}>: pkg_lwt.unix -<src/*.ml{,i,y}>: pkg_ocaml-protoc -<src/*.ml{,i,y}>: pkg_ocplib-endian -<src/*.ml{,i,y}>: pkg_pcre -<src/*.ml{,i,y}>: pkg_ppx_deriving.show -<src/*.ml{,i,y}>: pkg_ppx_deriving_yojson -<src/*.ml{,i,y}>: pkg_sha -<src/*.ml{,i,y}>: pkg_toml -<src/*.ml{,i,y}>: pkg_xml-light -<src/*.ml{,i,y}>: use_vyconf -<src/*.ml{,i,y}>: use_vyconf-config -# Executable vytree_test -<test/vytree_test.{native,byte}>: pkg_batteries -<test/vytree_test.{native,byte}>: pkg_fileutils -<test/vytree_test.{native,byte}>: pkg_oUnit -<test/vytree_test.{native,byte}>: pkg_pcre -<test/vytree_test.{native,byte}>: pkg_ppx_deriving.show -<test/vytree_test.{native,byte}>: pkg_ppx_deriving_yojson -<test/vytree_test.{native,byte}>: pkg_xml-light -<test/vytree_test.{native,byte}>: use_vyconf -# Executable reference_tree_test -<test/reference_tree_test.{native,byte}>: pkg_batteries -<test/reference_tree_test.{native,byte}>: pkg_fileutils -<test/reference_tree_test.{native,byte}>: pkg_oUnit -<test/reference_tree_test.{native,byte}>: pkg_pcre -<test/reference_tree_test.{native,byte}>: pkg_ppx_deriving.show -<test/reference_tree_test.{native,byte}>: pkg_ppx_deriving_yojson -<test/reference_tree_test.{native,byte}>: pkg_xml-light -<test/reference_tree_test.{native,byte}>: use_vyconf -# Executable config_tree_test -<test/config_tree_test.{native,byte}>: pkg_batteries -<test/config_tree_test.{native,byte}>: pkg_fileutils -<test/config_tree_test.{native,byte}>: pkg_oUnit -<test/config_tree_test.{native,byte}>: pkg_pcre -<test/config_tree_test.{native,byte}>: pkg_ppx_deriving.show -<test/config_tree_test.{native,byte}>: pkg_ppx_deriving_yojson -<test/config_tree_test.{native,byte}>: pkg_xml-light -<test/config_tree_test.{native,byte}>: use_vyconf -# Executable vylist_test -<test/vylist_test.{native,byte}>: pkg_oUnit -# Executable value_checker_test -<test/value_checker_test.{native,byte}>: pkg_batteries -<test/value_checker_test.{native,byte}>: pkg_fileutils -<test/value_checker_test.{native,byte}>: pkg_oUnit -<test/value_checker_test.{native,byte}>: pkg_pcre -<test/value_checker_test.{native,byte}>: pkg_ppx_deriving.show -<test/value_checker_test.{native,byte}>: pkg_ppx_deriving_yojson -<test/value_checker_test.{native,byte}>: pkg_xml-light -<test/value_checker_test.{native,byte}>: use_vyconf -# Executable util_test -<test/util_test.{native,byte}>: pkg_batteries -<test/util_test.{native,byte}>: pkg_fileutils -<test/util_test.{native,byte}>: pkg_oUnit -<test/util_test.{native,byte}>: pkg_pcre -<test/util_test.{native,byte}>: pkg_ppx_deriving.show -<test/util_test.{native,byte}>: pkg_ppx_deriving_yojson -<test/util_test.{native,byte}>: pkg_xml-light -<test/util_test.{native,byte}>: use_vyconf -# Executable vyconf_config_test -<test/vyconf_config_test.{native,byte}>: pkg_batteries -<test/vyconf_config_test.{native,byte}>: pkg_fileutils -<test/vyconf_config_test.{native,byte}>: pkg_oUnit -<test/vyconf_config_test.{native,byte}>: pkg_ppx_deriving.show -<test/vyconf_config_test.{native,byte}>: pkg_toml -<test/vyconf_config_test.{native,byte}>: use_vyconf-config -# Executable curly_parser_test -<test/curly_parser_test.{native,byte}>: pkg_batteries -<test/curly_parser_test.{native,byte}>: pkg_fileutils -<test/curly_parser_test.{native,byte}>: pkg_oUnit -<test/curly_parser_test.{native,byte}>: pkg_pcre -<test/curly_parser_test.{native,byte}>: pkg_ppx_deriving.show -<test/curly_parser_test.{native,byte}>: pkg_ppx_deriving_yojson -<test/curly_parser_test.{native,byte}>: pkg_xml-light -<test/curly_parser_test.{native,byte}>: use_vyconf -# Executable session_test -<test/session_test.{native,byte}>: pkg_batteries -<test/session_test.{native,byte}>: pkg_fileutils -<test/session_test.{native,byte}>: pkg_oUnit -<test/session_test.{native,byte}>: pkg_pcre -<test/session_test.{native,byte}>: pkg_ppx_deriving.show -<test/session_test.{native,byte}>: pkg_ppx_deriving_yojson -<test/session_test.{native,byte}>: pkg_toml -<test/session_test.{native,byte}>: pkg_xml-light -<test/session_test.{native,byte}>: use_vyconf -<test/session_test.{native,byte}>: use_vyconf-config -<test/*.ml{,i,y}>: pkg_oUnit -<test/*.ml{,i,y}>: pkg_toml -<test/*.ml{,i,y}>: use_vyconf-config -# Executable vytree_load_test -<test/vytree_load_test.{native,byte}>: pkg_batteries -<test/vytree_load_test.{native,byte}>: pkg_fileutils -<test/vytree_load_test.{native,byte}>: pkg_pcre -<test/vytree_load_test.{native,byte}>: pkg_ppx_deriving.show -<test/vytree_load_test.{native,byte}>: pkg_ppx_deriving_yojson -<test/vytree_load_test.{native,byte}>: pkg_xml-light -<test/vytree_load_test.{native,byte}>: use_vyconf -<test/*.ml{,i,y}>: pkg_batteries -<test/*.ml{,i,y}>: pkg_fileutils -<test/*.ml{,i,y}>: pkg_pcre -<test/*.ml{,i,y}>: pkg_ppx_deriving.show -<test/*.ml{,i,y}>: pkg_ppx_deriving_yojson -<test/*.ml{,i,y}>: pkg_xml-light -<test/*.ml{,i,y}>: use_vyconf -# OASIS_STOP - -true: strict_sequence -true: bin_annot -true: use_menhir, explain diff --git a/build-setup.sh b/build-setup.sh deleted file mode 100755 index b10e06b..0000000 --- a/build-setup.sh +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/sh -oasis setup -setup-update dynamic diff --git a/configure b/configure deleted file mode 100755 index 6acfaeb..0000000 --- a/configure +++ /dev/null @@ -1,27 +0,0 @@ -#!/bin/sh - -# OASIS_START -# DO NOT EDIT (digest: dc86c2ad450f91ca10c931b6045d0499) -set -e - -FST=true -for i in "$@"; do - if $FST; then - set -- - FST=false - fi - - case $i in - --*=*) - ARG=${i%%=*} - VAL=${i##*=} - set -- "$@" "$ARG" "$VAL" - ;; - *) - set -- "$@" "$i" - ;; - esac -done - -ocaml setup.ml -configure "$@" -# OASIS_STOP diff --git a/data/dune b/data/dune new file mode 100644 index 0000000..e5ffaa6 --- /dev/null +++ b/data/dune @@ -0,0 +1,3 @@ +(install + (files vyconfd.conf vyconf.proto) + (section share)) diff --git a/data/examples/vyconfd.conf b/data/examples/vyconfd.conf index db9e493..68b0531 100644 --- a/data/examples/vyconfd.conf +++ b/data/examples/vyconfd.conf @@ -9,6 +9,7 @@ config_dir = "/etc/testappliance" # paths relative to config_dir primary_config = "config.boot" fallback_config = "config.failsafe" +reference_tree = "reftree.cache" [vyconf] diff --git a/data/vyconf.proto b/data/vyconf.proto index 6bd2796..d989fb3 100644 --- a/data/vyconf.proto +++ b/data/vyconf.proto @@ -17,6 +17,15 @@ message Request { optional int32 OnBehalfOf = 2; } + message Teardown { + optional int32 OnBehalfOf = 1; + } + + message Validate { + repeated string Path = 1; + optional OutputFormat output_format = 2; + } + message Set { repeated string Path = 1; optional bool Ephemeral = 3; @@ -129,8 +138,9 @@ message Request { Confirm confirm = 18; EnterConfigurationMode configure = 19; ExitConfigurationMode exit_configure = 20; - string teardown = 21; - } + Validate validate = 21; + Teardown teardown = 22; + } } message RequestEnvelope { diff --git a/data/vyconfd.conf b/data/vyconfd.conf new file mode 100644 index 0000000..e0b16d0 --- /dev/null +++ b/data/vyconfd.conf @@ -0,0 +1,20 @@ +[appliance] + +name = "vyconfd-minimal" + +data_dir = "/usr/share/vyos/vyconf" +program_dir = "/usr/libexec/vyos" +config_dir = "/usr/libexec/vyos/vyconf/config" + +# paths relative to config_dir +primary_config = "config.boot" +fallback_config = "config.failsafe" +reference_tree = "reftree.cache" + +[vyconf] + +socket = "/var/run/vyconfd.sock" +pid_file = "/var/run/vyconfd.pid" +log_file = "/var/log/vyconfd.log" +log_template = "$(date) $(name)[$(pid)]: $(message)" +log_level = "notice" diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..41c3051 --- /dev/null +++ b/dune-project @@ -0,0 +1,3 @@ +(lang dune 2.0) +(using menhir 2.0) +(name vyconf) diff --git a/myocamlbuild.ml b/myocamlbuild.ml deleted file mode 100644 index 859c97a..0000000 --- a/myocamlbuild.ml +++ /dev/null @@ -1,906 +0,0 @@ -(* OASIS_START *) -(* DO NOT EDIT (digest: bdb3fd5d41e0b702a74a64a780ae3714) *) -module OASISGettext = struct -(* # 22 "src/oasis/OASISGettext.ml" *) - - - let ns_ str = str - let s_ str = str - let f_ (str: ('a, 'b, 'c, 'd) format4) = str - - - let fn_ fmt1 fmt2 n = - if n = 1 then - fmt1^^"" - else - fmt2^^"" - - - let init = [] -end - -module OASISString = struct -(* # 22 "src/oasis/OASISString.ml" *) - - - (** Various string utilities. - - Mostly inspired by extlib and batteries ExtString and BatString libraries. - - @author Sylvain Le Gall - *) - - - let nsplitf str f = - if str = "" then - [] - else - let buf = Buffer.create 13 in - let lst = ref [] in - let push () = - lst := Buffer.contents buf :: !lst; - Buffer.clear buf - in - let str_len = String.length str in - for i = 0 to str_len - 1 do - if f str.[i] then - push () - else - Buffer.add_char buf str.[i] - done; - push (); - List.rev !lst - - - (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the - separator. - *) - let nsplit str c = - nsplitf str ((=) c) - - - let find ~what ?(offset=0) str = - let what_idx = ref 0 in - let str_idx = ref offset in - while !str_idx < String.length str && - !what_idx < String.length what do - if str.[!str_idx] = what.[!what_idx] then - incr what_idx - else - what_idx := 0; - incr str_idx - done; - if !what_idx <> String.length what then - raise Not_found - else - !str_idx - !what_idx - - - let sub_start str len = - let str_len = String.length str in - if len >= str_len then - "" - else - String.sub str len (str_len - len) - - - let sub_end ?(offset=0) str len = - let str_len = String.length str in - if len >= str_len then - "" - else - String.sub str 0 (str_len - len) - - - let starts_with ~what ?(offset=0) str = - let what_idx = ref 0 in - let str_idx = ref offset in - let ok = ref true in - while !ok && - !str_idx < String.length str && - !what_idx < String.length what do - if str.[!str_idx] = what.[!what_idx] then - incr what_idx - else - ok := false; - incr str_idx - done; - if !what_idx = String.length what then - true - else - false - - - let strip_starts_with ~what str = - if starts_with ~what str then - sub_start str (String.length what) - else - raise Not_found - - - let ends_with ~what ?(offset=0) str = - let what_idx = ref ((String.length what) - 1) in - let str_idx = ref ((String.length str) - 1) in - let ok = ref true in - while !ok && - offset <= !str_idx && - 0 <= !what_idx do - if str.[!str_idx] = what.[!what_idx] then - decr what_idx - else - ok := false; - decr str_idx - done; - if !what_idx = -1 then - true - else - false - - - let strip_ends_with ~what str = - if ends_with ~what str then - sub_end str (String.length what) - else - raise Not_found - - - let replace_chars f s = - let buf = Buffer.create (String.length s) in - String.iter (fun c -> Buffer.add_char buf (f c)) s; - Buffer.contents buf - - let lowercase_ascii = - replace_chars - (fun c -> - if (c >= 'A' && c <= 'Z') then - Char.chr (Char.code c + 32) - else - c) - - let uncapitalize_ascii s = - if s <> "" then - (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) - else - s - - let uppercase_ascii = - replace_chars - (fun c -> - if (c >= 'a' && c <= 'z') then - Char.chr (Char.code c - 32) - else - c) - - let capitalize_ascii s = - if s <> "" then - (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) - else - s - -end - -module OASISUtils = struct -(* # 22 "src/oasis/OASISUtils.ml" *) - - - open OASISGettext - - - module MapExt = - struct - module type S = - sig - include Map.S - val add_list: 'a t -> (key * 'a) list -> 'a t - val of_list: (key * 'a) list -> 'a t - val to_list: 'a t -> (key * 'a) list - end - - module Make (Ord: Map.OrderedType) = - struct - include Map.Make(Ord) - - let rec add_list t = - function - | (k, v) :: tl -> add_list (add k v t) tl - | [] -> t - - let of_list lst = add_list empty lst - - let to_list t = fold (fun k v acc -> (k, v) :: acc) t [] - end - end - - - module MapString = MapExt.Make(String) - - - module SetExt = - struct - module type S = - sig - include Set.S - val add_list: t -> elt list -> t - val of_list: elt list -> t - val to_list: t -> elt list - end - - module Make (Ord: Set.OrderedType) = - struct - include Set.Make(Ord) - - let rec add_list t = - function - | e :: tl -> add_list (add e t) tl - | [] -> t - - let of_list lst = add_list empty lst - - let to_list = elements - end - end - - - module SetString = SetExt.Make(String) - - - let compare_csl s1 s2 = - String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2) - - - module HashStringCsl = - Hashtbl.Make - (struct - type t = string - let equal s1 s2 = (compare_csl s1 s2) = 0 - let hash s = Hashtbl.hash (OASISString.lowercase_ascii s) - end) - - module SetStringCsl = - SetExt.Make - (struct - type t = string - let compare = compare_csl - end) - - - let varname_of_string ?(hyphen='_') s = - if String.length s = 0 then - begin - invalid_arg "varname_of_string" - end - else - begin - let buf = - OASISString.replace_chars - (fun c -> - if ('a' <= c && c <= 'z') - || - ('A' <= c && c <= 'Z') - || - ('0' <= c && c <= '9') then - c - else - hyphen) - s; - in - let buf = - (* Start with a _ if digit *) - if '0' <= s.[0] && s.[0] <= '9' then - "_"^buf - else - buf - in - OASISString.lowercase_ascii buf - end - - - let varname_concat ?(hyphen='_') p s = - let what = String.make 1 hyphen in - let p = - try - OASISString.strip_ends_with ~what p - with Not_found -> - p - in - let s = - try - OASISString.strip_starts_with ~what s - with Not_found -> - s - in - p^what^s - - - let is_varname str = - str = varname_of_string str - - - let failwithf fmt = Printf.ksprintf failwith fmt - - - let rec file_location ?pos1 ?pos2 ?lexbuf () = - match pos1, pos2, lexbuf with - | Some p, None, _ | None, Some p, _ -> - file_location ~pos1:p ~pos2:p ?lexbuf () - | Some p1, Some p2, _ -> - let open Lexing in - let fn, lineno = p1.pos_fname, p1.pos_lnum in - let c1 = p1.pos_cnum - p1.pos_bol in - let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in - Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2 - | _, _, Some lexbuf -> - file_location - ~pos1:(Lexing.lexeme_start_p lexbuf) - ~pos2:(Lexing.lexeme_end_p lexbuf) - () - | None, None, None -> - s_ "<position undefined>" - - - let failwithpf ?pos1 ?pos2 ?lexbuf fmt = - let loc = file_location ?pos1 ?pos2 ?lexbuf () in - Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt - - -end - -module OASISExpr = struct -(* # 22 "src/oasis/OASISExpr.ml" *) - - - open OASISGettext - open OASISUtils - - - type test = string - type flag = string - - - type t = - | EBool of bool - | ENot of t - | EAnd of t * t - | EOr of t * t - | EFlag of flag - | ETest of test * string - - - type 'a choices = (t * 'a) list - - - let eval var_get t = - let rec eval' = - function - | EBool b -> - b - - | ENot e -> - not (eval' e) - - | EAnd (e1, e2) -> - (eval' e1) && (eval' e2) - - | EOr (e1, e2) -> - (eval' e1) || (eval' e2) - - | EFlag nm -> - let v = - var_get nm - in - assert(v = "true" || v = "false"); - (v = "true") - - | ETest (nm, vl) -> - let v = - var_get nm - in - (v = vl) - in - eval' t - - - let choose ?printer ?name var_get lst = - let rec choose_aux = - function - | (cond, vl) :: tl -> - if eval var_get cond then - vl - else - choose_aux tl - | [] -> - let str_lst = - if lst = [] then - s_ "<empty>" - else - String.concat - (s_ ", ") - (List.map - (fun (cond, vl) -> - match printer with - | Some p -> p vl - | None -> s_ "<no printer>") - lst) - in - match name with - | Some nm -> - failwith - (Printf.sprintf - (f_ "No result for the choice list '%s': %s") - nm str_lst) - | None -> - failwith - (Printf.sprintf - (f_ "No result for a choice list: %s") - str_lst) - in - choose_aux (List.rev lst) - - -end - - -# 443 "myocamlbuild.ml" -module BaseEnvLight = struct -(* # 22 "src/base/BaseEnvLight.ml" *) - - - module MapString = Map.Make(String) - - - type t = string MapString.t - - - let default_filename = Filename.concat (Sys.getcwd ()) "setup.data" - - - let load ?(allow_empty=false) ?(filename=default_filename) ?stream () = - let line = ref 1 in - let lexer st = - let st_line = - Stream.from - (fun _ -> - try - match Stream.next st with - | '\n' -> incr line; Some '\n' - | c -> Some c - with Stream.Failure -> None) - in - Genlex.make_lexer ["="] st_line - in - let rec read_file lxr mp = - match Stream.npeek 3 lxr with - | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> - Stream.junk lxr; Stream.junk lxr; Stream.junk lxr; - read_file lxr (MapString.add nm value mp) - | [] -> mp - | _ -> - failwith - (Printf.sprintf "Malformed data file '%s' line %d" filename !line) - in - match stream with - | Some st -> read_file (lexer st) MapString.empty - | None -> - if Sys.file_exists filename then begin - let chn = open_in_bin filename in - let st = Stream.of_channel chn in - try - let mp = read_file (lexer st) MapString.empty in - close_in chn; mp - with e -> - close_in chn; raise e - end else if allow_empty then begin - MapString.empty - end else begin - failwith - (Printf.sprintf - "Unable to load environment, the file '%s' doesn't exist." - filename) - end - - let rec var_expand str env = - let buff = Buffer.create ((String.length str) * 2) in - Buffer.add_substitute - buff - (fun var -> - try - var_expand (MapString.find var env) env - with Not_found -> - failwith - (Printf.sprintf - "No variable %s defined when trying to expand %S." - var - str)) - str; - Buffer.contents buff - - - let var_get name env = var_expand (MapString.find name env) env - let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst -end - - -# 523 "myocamlbuild.ml" -module MyOCamlbuildFindlib = struct -(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *) - - - (** OCamlbuild extension, copied from - * https://ocaml.org/learn/tutorials/ocamlbuild/Using_ocamlfind_with_ocamlbuild.html - * by N. Pouillard and others - * - * Updated on 2016-06-02 - * - * Modified by Sylvain Le Gall - *) - open Ocamlbuild_plugin - - - type conf = {no_automatic_syntax: bool} - - - let run_and_read = Ocamlbuild_pack.My_unix.run_and_read - - - let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings - - - let exec_from_conf exec = - let exec = - let env = BaseEnvLight.load ~allow_empty:true () in - try - BaseEnvLight.var_get exec env - with Not_found -> - Printf.eprintf "W: Cannot get variable %s\n" exec; - exec - in - let fix_win32 str = - if Sys.os_type = "Win32" then begin - let buff = Buffer.create (String.length str) in - (* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'. - *) - String.iter - (fun c -> Buffer.add_char buff (if c = '\\' then '/' else c)) - str; - Buffer.contents buff - end else begin - str - end - in - fix_win32 exec - - - let split s ch = - let buf = Buffer.create 13 in - let x = ref [] in - let flush () = - x := (Buffer.contents buf) :: !x; - Buffer.clear buf - in - String.iter - (fun c -> - if c = ch then - flush () - else - Buffer.add_char buf c) - s; - flush (); - List.rev !x - - - let split_nl s = split s '\n' - - - let before_space s = - try - String.before s (String.index s ' ') - with Not_found -> s - - (* ocamlfind command *) - let ocamlfind x = S[Sh (exec_from_conf "ocamlfind"); x] - - (* This lists all supported packages. *) - let find_packages () = - List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list")) - - - (* Mock to list available syntaxes. *) - let find_syntaxes () = ["camlp4o"; "camlp4r"] - - - let well_known_syntax = [ - "camlp4.quotations.o"; - "camlp4.quotations.r"; - "camlp4.exceptiontracer"; - "camlp4.extend"; - "camlp4.foldgenerator"; - "camlp4.listcomprehension"; - "camlp4.locationstripper"; - "camlp4.macro"; - "camlp4.mapgenerator"; - "camlp4.metagenerator"; - "camlp4.profiler"; - "camlp4.tracer" - ] - - - let dispatch conf = - function - | After_options -> - (* By using Before_options one let command line options have an higher - * priority on the contrary using After_options will guarantee to have - * the higher priority override default commands by ocamlfind ones *) - Options.ocamlc := ocamlfind & A"ocamlc"; - Options.ocamlopt := ocamlfind & A"ocamlopt"; - Options.ocamldep := ocamlfind & A"ocamldep"; - Options.ocamldoc := ocamlfind & A"ocamldoc"; - Options.ocamlmktop := ocamlfind & A"ocamlmktop"; - Options.ocamlmklib := ocamlfind & A"ocamlmklib" - - | After_rules -> - - (* Avoid warnings for unused tag *) - flag ["tests"] N; - - (* When one link an OCaml library/binary/package, one should use - * -linkpkg *) - flag ["ocaml"; "link"; "program"] & A"-linkpkg"; - - (* For each ocamlfind package one inject the -package option when - * compiling, computing dependencies, generating documentation and - * linking. *) - List.iter - begin fun pkg -> - let base_args = [A"-package"; A pkg] in - (* TODO: consider how to really choose camlp4o or camlp4r. *) - let syn_args = [A"-syntax"; A "camlp4o"] in - let (args, pargs) = - (* Heuristic to identify syntax extensions: whether they end in - ".syntax"; some might not. - *) - if not (conf.no_automatic_syntax) && - (Filename.check_suffix pkg "syntax" || - List.mem pkg well_known_syntax) then - (syn_args @ base_args, syn_args) - else - (base_args, []) - in - flag ["ocaml"; "compile"; "pkg_"^pkg] & S args; - flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args; - flag ["ocaml"; "doc"; "pkg_"^pkg] & S args; - flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args; - flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args; - - (* TODO: Check if this is allowed for OCaml < 3.12.1 *) - flag ["ocaml"; "compile"; "package("^pkg^")"] & S pargs; - flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs; - flag ["ocaml"; "doc"; "package("^pkg^")"] & S pargs; - flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs; - end - (find_packages ()); - - (* Like -package but for extensions syntax. Morover -syntax is useless - * when linking. *) - List.iter begin fun syntax -> - flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; - flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; - flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; - flag ["ocaml"; "infer_interface"; "syntax_"^syntax] & - S[A"-syntax"; A syntax]; - end (find_syntaxes ()); - - (* The default "thread" tag is not compatible with ocamlfind. - * Indeed, the default rules add the "threads.cma" or "threads.cmxa" - * options when using this tag. When using the "-linkpkg" option with - * ocamlfind, this module will then be added twice on the command line. - * - * To solve this, one approach is to add the "-thread" option when using - * the "threads" package using the previous plugin. - *) - flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]); - flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]); - flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]); - flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]); - flag ["c"; "pkg_threads"; "compile"] (S[A "-thread"]); - flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]); - flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]); - flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]); - flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]); - flag ["c"; "package(threads)"; "compile"] (S[A "-thread"]); - - | _ -> - () -end - -module MyOCamlbuildBase = struct -(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) - - - (** Base functions for writing myocamlbuild.ml - @author Sylvain Le Gall - *) - - - open Ocamlbuild_plugin - module OC = Ocamlbuild_pack.Ocaml_compiler - - - type dir = string - type file = string - type name = string - type tag = string - - - type t = - { - lib_ocaml: (name * dir list * string list) list; - lib_c: (name * dir * file list) list; - flags: (tag list * (spec OASISExpr.choices)) list; - (* Replace the 'dir: include' from _tags by a precise interdepends in - * directory. - *) - includes: (dir * dir list) list; - } - - -(* # 110 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) - - - let env_filename = Pathname.basename BaseEnvLight.default_filename - - - let dispatch_combine lst = - fun e -> - List.iter - (fun dispatch -> dispatch e) - lst - - - let tag_libstubs nm = - "use_lib"^nm^"_stubs" - - - let nm_libstubs nm = - nm^"_stubs" - - - let dispatch t e = - let env = BaseEnvLight.load ~allow_empty:true () in - match e with - | Before_options -> - let no_trailing_dot s = - if String.length s >= 1 && s.[0] = '.' then - String.sub s 1 ((String.length s) - 1) - else - s - in - List.iter - (fun (opt, var) -> - try - opt := no_trailing_dot (BaseEnvLight.var_get var env) - with Not_found -> - Printf.eprintf "W: Cannot get variable %s\n" var) - [ - Options.ext_obj, "ext_obj"; - Options.ext_lib, "ext_lib"; - Options.ext_dll, "ext_dll"; - ] - - | After_rules -> - (* Declare OCaml libraries *) - List.iter - (function - | nm, [], intf_modules -> - ocaml_lib nm; - let cmis = - List.map (fun m -> (OASISString.uncapitalize_ascii m) ^ ".cmi") - intf_modules in - dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis - | nm, dir :: tl, intf_modules -> - ocaml_lib ~dir:dir (dir^"/"^nm); - List.iter - (fun dir -> - List.iter - (fun str -> - flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir])) - ["compile"; "infer_interface"; "doc"]) - tl; - let cmis = - List.map (fun m -> dir^"/"^(OASISString.uncapitalize_ascii m)^".cmi") - intf_modules in - dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"] - cmis) - t.lib_ocaml; - - (* Declare directories dependencies, replace "include" in _tags. *) - List.iter - (fun (dir, include_dirs) -> - Pathname.define_context dir include_dirs) - t.includes; - - (* Declare C libraries *) - List.iter - (fun (lib, dir, headers) -> - (* Handle C part of library *) - flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib] - (S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib"; - A("-l"^(nm_libstubs lib))]); - - flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib] - (S[A"-cclib"; A("-l"^(nm_libstubs lib))]); - - if bool_of_string (BaseEnvLight.var_get "native_dynlink" env) then - flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib] - (S[A"-dllib"; A("dll"^(nm_libstubs lib))]); - - (* When ocaml link something that use the C library, then one - need that file to be up to date. - This holds both for programs and for libraries. - *) - dep ["link"; "ocaml"; tag_libstubs lib] - [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; - - dep ["compile"; "ocaml"; tag_libstubs lib] - [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; - - (* TODO: be more specific about what depends on headers *) - (* Depends on .h files *) - dep ["compile"; "c"] - headers; - - (* Setup search path for lib *) - flag ["link"; "ocaml"; "use_"^lib] - (S[A"-I"; P(dir)]); - ) - t.lib_c; - - (* Add flags *) - List.iter - (fun (tags, cond_specs) -> - let spec = BaseEnvLight.var_choose cond_specs env in - let rec eval_specs = - function - | S lst -> S (List.map eval_specs lst) - | A str -> A (BaseEnvLight.var_expand str env) - | spec -> spec - in - flag tags & (eval_specs spec)) - t.flags - | _ -> - () - - - let dispatch_default conf t = - dispatch_combine - [ - dispatch t; - MyOCamlbuildFindlib.dispatch conf; - ] - - -end - - -# 884 "myocamlbuild.ml" -open Ocamlbuild_plugin;; -let package_default = - { - MyOCamlbuildBase.lib_ocaml = - [ - ("vyconf", ["src"], []); - ("vyconf-config", ["src"], []); - ("vyconf-client", ["src"], []) - ]; - lib_c = []; - flags = []; - includes = [("test", ["src"])] - } - ;; - -let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false} - -let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;; - -# 905 "myocamlbuild.ml" -(* OASIS_STOP *) -Ocamlbuild_plugin.dispatch dispatch_default;; diff --git a/setup.ml b/setup.ml deleted file mode 100644 index 6958297..0000000 --- a/setup.ml +++ /dev/null @@ -1,39 +0,0 @@ -(* setup.ml generated for the first time by OASIS v0.4.8 *) - -(* OASIS_START *) -(* DO NOT EDIT (digest: a426e2d026defb34183b787d31fbdcff) *) -(******************************************************************************) -(* OASIS: architecture for building OCaml libraries and applications *) -(* *) -(* Copyright (C) 2011-2016, Sylvain Le Gall *) -(* Copyright (C) 2008-2011, OCamlCore SARL *) -(* *) -(* This library 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; either version 2.1 of the License, or (at *) -(* your option) any later version, with the OCaml static compilation *) -(* exception. *) -(* *) -(* This library 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 file COPYING for more *) -(* details. *) -(* *) -(* You should have received a copy of the GNU Lesser General Public License *) -(* along with this library; if not, write to the Free Software Foundation, *) -(* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) -(******************************************************************************) - -let () = - try - Topdirs.dir_directory (Sys.getenv "OCAML_TOPLEVEL_PATH") - with Not_found -> () -;; -#use "topfind";; -#require "oasis.dynrun";; -open OASISDynRun;; - -let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t -open BaseCompat.Compat_0_4 -(* OASIS_STOP *) -let () = setup ();; diff --git a/src/adapter/vy_delete.ml b/src/adapter/vy_delete.ml new file mode 100644 index 0000000..304e74b --- /dev/null +++ b/src/adapter/vy_delete.ml @@ -0,0 +1,30 @@ +let () = + let path_list = Array.to_list (Array.sub Sys.argv 1 (Array.length Sys.argv - 1)) + in + let () = + if List.length path_list = 0 then + (Printf.printf "no path specified\n"; exit 1) + in + let handle = + let h = Vyos1x_adapter.cstore_handle_init () in + if not (Vyos1x_adapter.cstore_in_config_session_handle h) then + (Vyos1x_adapter.cstore_handle_free h; + Printf.printf "not in config session\n"; exit 1) + else Some h + in + let output = + match handle with + | Some h -> Vyos1x_adapter.cstore_delete_path h path_list + | None -> "missing session handle" + in + let ret = + if output = "" then 0 + else 1 + in + let () = + match handle with + | Some h -> Vyos1x_adapter.cstore_handle_free h + | None -> () + in + let () = print_endline output in + exit ret diff --git a/src/adapter/vy_load_config.ml b/src/adapter/vy_load_config.ml new file mode 100644 index 0000000..66bbfb8 --- /dev/null +++ b/src/adapter/vy_load_config.ml @@ -0,0 +1,47 @@ +(* Adapter load_config + *) + +open Vyos1x + +let read_config filename = + let ch = open_in filename in + let s = really_input_string ch (in_channel_length ch) in + let ct = + try + Ok (Parser.from_string s) + with Vyos1x.Util.Syntax_error (opt, msg) -> + begin + match opt with + | None -> Error msg + | Some (line, pos) -> + let out = Printf.sprintf "%s line %d pos %d\n" msg line pos + in Error out + end + in + close_in ch; + ct + +let read_configs f g = + let l = read_config f in + let r = read_config g in + match l, r with + | Ok left, Ok right -> Ok (left, right) + | Error msg_l, Error msg_r -> Error (msg_l ^ msg_r) + | Error msg_l, _ -> Error msg_l + | _, Error msg_r -> Error msg_r + + +let args = [] +let usage = Printf.sprintf "Usage: %s <config> <new config>" Sys.argv.(0) + +let () = if Array.length Sys.argv <> 3 then (Arg.usage args usage; exit 1) + +let () = +let left_name = Sys.argv.(1) in +let right_name = Sys.argv.(2) in +let read = read_configs left_name right_name in +let res = + match read with + | Ok (left, right) -> Vyos1x_adapter.load_config left right + | Error msg -> msg +in Printf.printf "%s\n" res diff --git a/src/adapter/vy_set.ml b/src/adapter/vy_set.ml new file mode 100644 index 0000000..b631de0 --- /dev/null +++ b/src/adapter/vy_set.ml @@ -0,0 +1,77 @@ +let valid = ref false + +let format_out l = + let fl = List.filter (fun s -> (String.length s) > 0) l in + String.concat "\n\n" fl + +let is_valid v = + match v with + | None -> true + | Some _ -> false + +let valid_err v = + Option.value v ~default:"" + +let () = + let path_list = Array.to_list (Array.sub Sys.argv 1 (Array.length Sys.argv - 1)) + in + let () = + if List.length path_list = 0 then + (Printf.printf "no path specified\n"; exit 1) + in + let legacy = + try + let _ = Sys.getenv "LEGACY_VALIDATE" in + true + with Not_found -> false + in + let no_set = + try + let _ = Sys.getenv "LEGACY_NO_SET" in + true + with Not_found -> false + in + let handle = + if legacy || not no_set then + let h = Vyos1x_adapter.cstore_handle_init () in + if not (Vyos1x_adapter.cstore_in_config_session_handle h) then + (Vyos1x_adapter.cstore_handle_free h; + Printf.printf "not in config session\n"; exit 1) + else Some h + else None + in + let valid = + if not legacy then + Vyos1x_adapter.vyconf_validate_path path_list + else + begin + let out = + match handle with + | Some h -> Vyos1x_adapter.legacy_validate_path h path_list + | None -> "missing session handle" + in + match out with + | "" -> None + | _ -> Some out + end + in + let res = + if not no_set && (is_valid valid) then + match handle with + | Some h -> + Vyos1x_adapter.cstore_set_path h path_list + | None -> "missing session handle" + else "" + in + let ret = + if (is_valid valid) && (res = "") then 0 + else 1 + in + let output = format_out [(valid_err valid); res] in + let () = + match handle with + | Some h -> Vyos1x_adapter.cstore_handle_free h + | None -> () + in + let () = print_endline output in + exit ret diff --git a/src/adapter/vyos1x_adapter.ml b/src/adapter/vyos1x_adapter.ml new file mode 100644 index 0000000..5835f5a --- /dev/null +++ b/src/adapter/vyos1x_adapter.ml @@ -0,0 +1,140 @@ +open Ctypes +open Foreign + +let libvyatta = Dl.dlopen ~flags:[Dl.RTLD_LAZY] ~filename:"libvyatta-cfg.so" + +let cstore_init = foreign ~from:libvyatta "vy_cstore_init" (void @-> returning uint64_t) +let cstore_free = foreign ~from:libvyatta "vy_cstore_free" (uint64_t @-> returning void) +let in_session = foreign ~from:libvyatta "vy_in_session" (uint64_t @-> returning int) +let cstore_set_path = foreign ~from:libvyatta "vy_set_path" (uint64_t @-> (ptr void) @-> size_t @-> returning string) +let cstore_del_path = foreign ~from:libvyatta "vy_delete_path" (uint64_t @-> (ptr void) @-> size_t @-> returning string) +let cstore_validate_path = foreign ~from:libvyatta "vy_validate_path" (uint64_t @-> (ptr void) @-> size_t @-> returning string) +let cstore_legacy_set_path = foreign ~from:libvyatta "vy_legacy_set_path" (uint64_t @-> (ptr void) @-> size_t @-> returning string) + +let cstore_handle_init () = Unsigned.UInt64.to_int (cstore_init ()) +let cstore_handle_free h = cstore_free (Unsigned.UInt64.of_int h) +let cstore_in_config_session_handle h = in_session (Unsigned.UInt64.of_int h) = 1 +let cstore_in_config_session () = cstore_in_config_session_handle (cstore_handle_init ()) + +let cstore_set_path handle path = + let len = List.length path in + let arr = CArray.of_list string path in + cstore_set_path (Unsigned.UInt64.of_int handle) (to_voidp (CArray.start arr)) (Unsigned.Size_t.of_int len) + +let legacy_validate_path handle path = + let len = List.length path in + let arr = CArray.of_list string path in + cstore_validate_path (Unsigned.UInt64.of_int handle) (to_voidp (CArray.start arr)) (Unsigned.Size_t.of_int len) + +let legacy_set_path handle path = + let len = List.length path in + let arr = CArray.of_list string path in + cstore_legacy_set_path (Unsigned.UInt64.of_int handle) (to_voidp (CArray.start arr)) (Unsigned.Size_t.of_int len) + +let cstore_delete_path handle path = + let len = List.length path in + let arr = CArray.of_list string path in + cstore_del_path (Unsigned.UInt64.of_int handle) (to_voidp (CArray.start arr)) (Unsigned.Size_t.of_int len) + +let set_path_reversed handle path _len = + let path = List.rev path in + cstore_set_path handle path + +let delete_path_reversed handle path _len = + let path = List.rev path in + cstore_delete_path handle path + +module VC = Client.Vyconf_client_session + +let get_sockname = + "/var/run/vyconfd.sock" + +let vyconf_validate_path path = + let socket = get_sockname in + let token = VC.session_init socket in + match token with + | Error e -> Some e + | Ok token -> + let out = VC.session_validate_path socket token path in + let _ = VC.session_free socket token in + match out with + | Ok _ -> None + | Error e -> Some e + +open Vyos1x + +module CT = Config_tree +module CD = Config_diff + +module ValueSet = Set.Make(String) + +let add_value handle acc out v = + let acc = v :: acc in + out ^ (set_path_reversed handle acc (List.length acc)) + +let add_values handle acc out vs = + match vs with + | [] -> out ^ (set_path_reversed handle acc (List.length acc)) + | _ -> List.fold_left (add_value handle acc) out vs + +let rec add_path handle acc out (node : CT.t) = + let acc = (Vytree.name_of_node node) :: acc in + let children = Vytree.children_of_node node in + match children with + | [] -> let data = Vytree.data_of_node node in + let values = data.values in + add_values handle acc out values + | _ -> List.fold_left (add_path handle acc) out children + +let del_value handle acc out v = + let acc = v :: acc in + out ^ (delete_path_reversed handle acc (List.length acc)) + +let del_values handle acc out vs = + match vs with + | [] -> out ^ (delete_path_reversed handle acc (List.length acc)) + | _ -> List.fold_left (del_value handle acc) out vs + +let del_path handle path out = + out ^ (cstore_delete_path handle path) + +(* +let update_data (CD.Diff_cstore data) m = + CD.Diff_cstore { data with out = m; } +*) + +let cstore_diff ?recurse:_ (path : string list) (CD.Diff_cstore res) (m : CD.change) = + let handle = res.handle in + match m with + | Added -> let node = Vytree.get res.right path in + let acc = List.tl (List.rev path) in + CD.Diff_cstore { res with out = add_path handle acc res.out node } + | Subtracted -> CD.Diff_cstore { res with out = del_path handle path res.out } + | Unchanged -> CD.Diff_cstore (res) + | Updated v -> + let ov = CT.get_values res.left path in + let acc = List.rev path in + match ov, v with + | [x], [y] -> let out = del_value handle acc res.out x in + let out = add_value handle acc out y in + CD.Diff_cstore { res with out = out } + | _, _ -> let ov_set = ValueSet.of_list ov in + let v_set = ValueSet.of_list v in + let sub_vals = ValueSet.elements (ValueSet.diff ov_set v_set) in + let add_vals = ValueSet.elements (ValueSet.diff v_set ov_set) in + let out = del_values handle acc res.out sub_vals in + let out = add_values handle acc out add_vals in + CD.Diff_cstore { res with out = out } + +let load_config left right = + let h = cstore_handle_init () in + if not (cstore_in_config_session_handle h) then + (cstore_handle_free h; + let out = "not in config session\n" in + out) + else + let dcstore = CD.make_diff_cstore left right h in + let dcstore = CD.diff [] cstore_diff dcstore (Option.some left, Option.some right) in + let ret = CD.eval_result dcstore in + cstore_handle_free h; + ret.out diff --git a/src/adapter/vyos1x_adapter.mli b/src/adapter/vyos1x_adapter.mli new file mode 100644 index 0000000..cb40e2b --- /dev/null +++ b/src/adapter/vyos1x_adapter.mli @@ -0,0 +1,16 @@ +open Vyos1x + +val cstore_handle_init : unit -> int +val cstore_handle_free : int -> unit +val cstore_in_config_session_handle : int -> bool +val cstore_in_config_session : unit -> bool +val cstore_set_path : int -> string list -> string +val legacy_validate_path : int -> string list -> string +val legacy_set_path : int -> string list -> string +val cstore_delete_path : int -> string list -> string +val set_path_reversed : int -> string list -> int -> string +val delete_path_reversed : int -> string list -> int -> string + +val vyconf_validate_path : string list -> string option + +val load_config : Config_tree.t -> Config_tree.t -> string diff --git a/src/config_tree.ml b/src/config_tree.ml deleted file mode 100644 index 28cfcdd..0000000 --- a/src/config_tree.ml +++ /dev/null @@ -1,345 +0,0 @@ -type value_behaviour = AddValue | ReplaceValue - -exception Duplicate_value -exception Node_has_no_value -exception No_such_value -exception Useless_set - -type config_node_data = { - values: string list; - comment: string option; - inactive: bool; - ephemeral: bool; -} [@@deriving yojson] - -type t = config_node_data Vytree.t [@@deriving yojson] - -let default_data = { - values = []; - comment = None; - inactive = false; - ephemeral = false; -} - -let make name = Vytree.make default_data name - -let replace_value node path value = - let data = {default_data with values=[value]} in - Vytree.update node path data - -let add_value node path value = - let node' = Vytree.get node path in - let data = Vytree.data_of_node node' in - let values = data.values in - match (Vylist.find (fun x -> x = value) values) with - | Some _ -> raise Duplicate_value - | None -> - let values = values @ [value] in - Vytree.update node path ({data with values=values}) - -let delete_value node path value = - let data = Vytree.data_of_node @@ Vytree.get node path in - let values = Vylist.remove (fun x -> x = value) data.values in - Vytree.update node path {data with values=values} - -let set_value node path value behaviour = - match behaviour with - | AddValue -> add_value node path value - | ReplaceValue -> replace_value node path value - -let set node path value behaviour = - if (Vytree.exists node path) then - (match value with - | None -> raise Useless_set - | Some v -> set_value node path v behaviour) - else - let path_existing = Vytree.get_existent_path node path in - let path_remaining = Vylist.complement path path_existing in - let values = match value with None -> [] | Some v -> [v] in - Vytree.insert_multi_level default_data node path_existing path_remaining {default_data with values=values} - -let get_values node path = - let node' = Vytree.get node path in - let data = Vytree.data_of_node node' in - data.values - -let get_value node path = - let values = get_values node path in - match values with - | [] -> raise Node_has_no_value - | x :: _ -> x - -let delete node path value = - match value with - | Some v -> - (let values = get_values node path in - if Vylist.in_list values v then - (match values with - | [_] -> Vytree.delete node path - | _ -> delete_value node path v) - else raise No_such_value) - | None -> - Vytree.delete node path - -let set_comment node path comment = - let data = Vytree.get_data node path in - Vytree.update node path {data with comment=comment} - -let get_comment node path = - let data = Vytree.get_data node path in - data.comment - -let set_inactive node path inactive = - let data = Vytree.get_data node path in - Vytree.update node path {data with inactive=inactive} - -let is_inactive node path = - let data = Vytree.get_data node path in - data.inactive - -let set_ephemeral node path ephemeral = - let data = Vytree.get_data node path in - Vytree.update node path {data with ephemeral=ephemeral} - -let is_ephemeral node path = - let data = Vytree.get_data node path in - data.ephemeral - -module Renderer = -struct - (* TODO Replace use of Printf with Format *) - - module L = List - module S = String - module PF = Printf - module VT = Vytree - module RT = Reference_tree - - (* Nodes are ordered based on a comarison of their names *) - let compare cmp node1 node2 = - let name1 = VT.name_of_node node1 in - let name2 = VT.name_of_node node2 in - cmp name1 name2 - - let indentation indent level = S.make (level * indent) ' ' - - let render_inactive data = if data.inactive then "#INACTIVE " else "" - let render_ephemeral data = if data.ephemeral then "#EPHEMERAL " else "" - - let render_comment data indents = - match data.comment with - | None -> "" - (* Trailing indentation for the rest of the material on the next line *) - | Some c -> PF.sprintf "/*%s*/\n%s" c indents - - let render_tag = function - | None -> "" - | Some tag -> PF.sprintf "%s " tag - - let render_outer indents data name tag = - [render_comment data indents ; - render_inactive data; - render_ephemeral data; - render_tag tag; - name] - |> S.concat "" - - let render_values ?(valueless=false) values = - let quote_if_needed s = - try - let _ = Pcre.exec ~pat:"[\\s;{}#\\[\\]\"\']" s in - Printf.sprintf "\"%s\"" s - with Not_found -> s - in - match values with - | [] -> if valueless then ";" else "{ }" - | [v] -> PF.sprintf "%s;" (quote_if_needed v) - | _ as vs -> S.concat "; " (List.map quote_if_needed vs) |> PF.sprintf "[%s];" - - let render_inner_and_outer indents inner outer = - if inner = "" - (* Hidden or empty descendents yield empty nodes *) - then PF.sprintf "%s%s { }" indents outer - else PF.sprintf "%s%s %s" indents outer inner - - let render - ?(indent=4) - ?(reftree=None) - ?(cmp=BatString.numeric_compare) - ?(showephemeral=false) - ?(showinactive=false) - (config_tree:t) - = - let is_hidden data = - (not showephemeral && data.ephemeral) || - (not showinactive && data.inactive) - in - let rec render_node level ?tag node = - let data = VT.data_of_node node in - let name = VT.name_of_node node in - (* Hide inactive and ephemeral when necessary *) - if is_hidden data then "" - else - let indents = indentation indent level in - let outer = render_outer indents data name tag in - let inner = (* Children are ignored if the node has values *) - match data.values with - | [] -> VT.children_of_node node |> render_children level - | values -> render_values values - in - PF.sprintf "%s%s %s" indents outer inner - and render_children level = function - | [] -> "{ }" - | children -> - let indents = indentation indent level in - let render_child node = render_node (level + 1) node in - let rendered_children = L.map render_child children |> S.concat "\n" - in - if rendered_children = "" then "{ }" - else PF.sprintf "{\n%s\n%s}" rendered_children indents - in - (* Walks the reftree and config_tree side-by-side *) - let rec render_node_rt level tag rt node = - let data = VT.data_of_node node in - let name = VT.name_of_node node in - let rt_data = VT.data_of_node rt in - let rt_name = VT.name_of_node rt in - (* Hide inactive and ephemeral when necessary *) - if is_hidden data then "" - else - (* TODO refactor this ugly approach*) - let (outer_name, level', inner) = - let open RT in - let children = VT.children_of_node node in - let ordered = rt_data.keep_order in - match rt_data.node_type with - | Tag -> - ("", 0, render_children_rt level (Some name) ordered rt children) - | Other -> - (name, level, render_children_rt level None ordered rt children) - | Leaf -> - (name, level, render_values ~valueless:rt_data.valueless data.values) - in - let indents = indentation indent level' in - let outer = render_outer indents data outer_name tag in - (* Do not insert a space before ; for valueless nodes *) - if rt_data.valueless then PF.sprintf "%s%s%s" indents outer inner - else PF.sprintf "%s%s %s" indents outer inner - and render_children_rt level tag ordered rt = function - | [] -> "{ }" - | children -> - let is_tagged = BatOption.is_some tag in - let indents = indentation indent level in - let reorder nodes = - if ordered then nodes - else L.sort (compare cmp) nodes - in - let render_child node = - let level' = if is_tagged then level else level + 1 in - let node_reftree = VT.find rt (VT.name_of_node node) in - (* If there is no reftree for a node, default to stand-alone *) - match node_reftree with - | Some rt' -> render_node_rt level' tag rt' node - | None -> render_node level' ?tag node - in - let rendered_children = children - |> reorder - |> L.map render_child - |> S.concat "\n" - in - if rendered_children = "" then "{ }" - else if is_tagged - then rendered_children - else PF.sprintf "{\n%s\n%s}" rendered_children indents - in - match reftree with - | None -> render_node 0 config_tree - | Some rt -> render_node_rt 0 None rt config_tree - - - (* Rendering configs as set commands *) - let render_set_path path value = - let v = Printf.sprintf "\'%s\'" value in - List.append path [v] |> String.concat " " |> Printf.sprintf "set %s" - - let rec render_commands ?(reftree=None) ?(alwayssort=false) path ct = - let new_path = List.append path [Vytree.name_of_node ct] in - let new_path_str = String.concat " " new_path in - let data = Vytree.data_of_node ct in - (* Get the node comment, if any *) - let comment = BatOption.default "" data.comment in - let comment_cmd = (if comment = "" then "" else Printf.sprintf "comment %s \'%s\'" new_path_str comment) in - (* Sort child names, if required *) - let child_names = Vytree.list_children ct in - let child_names = - begin - match reftree with - | Some rt -> - if ((RT.get_keep_order rt path) && (not alwayssort)) then child_names - else (List.sort BatString.numeric_compare child_names) - | None -> - if alwayssort then (List.sort BatString.numeric_compare child_names) - else child_names - end - in - (* Now handle the different cases for nodes with and without children *) - match child_names with - | [] -> - (* This is a leaf node *) - let values = List.map String.escaped data.values in - let cmds = - begin - match values with - | [] -> - (* Valueless leaf node *) - String.concat " " new_path |> Printf.sprintf "set %s" - | [v] -> - (* Single value, just one command *) - render_set_path new_path v - | vs -> - (* A leaf node with multiple values *) - List.map (render_set_path new_path) vs |> String.concat "\n" - end - in - if comment_cmd = "" then cmds else Printf.sprintf "%s\n%s" cmds comment_cmd - | children -> - (* A node with children *) - let children = List.map (fun n -> Vytree.get ct [n]) child_names in - let rendered_children = List.map (render_commands ~reftree:reftree ~alwayssort:alwayssort new_path) children in - let cmds = String.concat "\n" rendered_children in - if comment_cmd = "" then cmds else Printf.sprintf "%s\n%s" cmds comment_cmd - - -end (* Renderer *) - -let render = Renderer.render - -let render_at_level - ?(indent=4) - ?(reftree=None) - ?(cmp=BatString.numeric_compare) - ?(showephemeral=false) - ?(showinactive=false) - node - path = - let node = - match path with - | [] -> node - | _ -> Vytree.get node path - in - let children = Vytree.children_of_node node in - let child_configs = List.map (render ~indent:indent ~reftree:reftree ~cmp:cmp ~showephemeral:showephemeral ~showinactive:showinactive) children in - String.concat "\n" child_configs - -let render_commands ?(reftree=None) ?(alwayssort=false) ?(sortchildren=false) node path = - let node = - match path with - | [] -> node - | _ -> Vytree.get node path - in - let children = - if sortchildren then Vytree.sorted_children_of_node (BatString.numeric_compare) node - else Vytree.children_of_node node - in - let commands = List.map (Renderer.render_commands ~reftree:reftree ~alwayssort:alwayssort path) children in - String.concat "\n" commands diff --git a/src/config_tree.mli b/src/config_tree.mli deleted file mode 100644 index 79426e3..0000000 --- a/src/config_tree.mli +++ /dev/null @@ -1,78 +0,0 @@ -type value_behaviour = AddValue | ReplaceValue - -exception Duplicate_value -exception Node_has_no_value -exception No_such_value -exception Useless_set - -type config_node_data = { - values : string list; - comment : string option; - inactive : bool; - ephemeral : bool; -} [@@deriving yojson] - -type t = config_node_data Vytree.t [@@deriving yojson] - -val default_data : config_node_data - -val make : string -> t - -val set : t -> string list -> string option -> value_behaviour -> t - -val delete : t -> string list -> string option -> t - -val get_values : t -> string list -> string list - -val get_value : t -> string list -> string - -val set_comment : t -> string list -> string option -> t - -val get_comment : t -> string list -> string option - -val set_inactive : t -> string list -> bool -> t - -val is_inactive : t -> string list -> bool - -val set_ephemeral : t -> string list -> bool -> t - -val is_ephemeral : t -> string list -> bool - -(** Interface to two rendering routines: - 1. The stand-alone routine, when [reftree] is not provided - 2. The reference-tree guided routine, when [reftree] is provided. - - If an {i incomplete} reftree is supplied, then the remaining portion of the - config tree will be rendered according to the stand-alone routine. - - If an {i incompatible} reftree is supplied (i.e., the name of the nodes of - the reftree do not match the name of the nodes in the config tree), then the - exception {! Config_tree.Renderer.Inapt_reftree} is raised. - - @param indent spaces by which each level of nesting should be indented - @param reftree optional reference tree used to instruct rendering - @param cmp function used to sort the order of children, overruled - if [reftree] specifies [keep_order] for a node - @param showephemeral boolean determining whether ephemeral nodes are shown - @param showinactive boolean determining whether inactive nodes are shown -*) -val render : - ?indent:int -> - ?reftree:(Reference_tree.t option)-> - ?cmp:(string -> string -> int) -> - ?showephemeral:bool -> - ?showinactive:bool -> - t -> - string - -val render_at_level : - ?indent:int -> - ?reftree:(Reference_tree.t option)-> - ?cmp:(string -> string -> int) -> - ?showephemeral:bool -> - ?showinactive:bool -> - t -> - string list -> - string - -val render_commands: ?reftree:(Reference_tree.t option) -> ?alwayssort:bool -> ?sortchildren:bool -> t -> string list -> string diff --git a/src/curly_lexer.mll b/src/curly_lexer.mll deleted file mode 100644 index 32e566a..0000000 --- a/src/curly_lexer.mll +++ /dev/null @@ -1,90 +0,0 @@ -{ - -open Curly_parser - -exception Error of string - -} - -rule token = parse -| [' ' '\t' '\r'] - { token lexbuf } -| '\n' - { Lexing.new_line lexbuf; token lexbuf } -| '"' - { read_string (Buffer.create 16) lexbuf } -| ''' - { read_single_quoted_string (Buffer.create 16) lexbuf } -| "//" [^ '\n']+ '\n' - { Lexing.new_line lexbuf ; token lexbuf } -| "/*" - { read_comment (Buffer.create 16) lexbuf } -| "#INACTIVE" - { INACTIVE } -| "#EPHEMERAL" - { EPHEMERAL } -| '{' - { LEFT_BRACE } -| '}' - { RIGHT_BRACE } -| '[' - { LEFT_BRACKET } -| ']' - { RIGHT_BRACKET } -| ';' - { SEMI } -| [^ ' ' '\t' '\n' '\r' '{' '}' '[' ']' ';' '#' '"' ''' ]+ as s - { IDENTIFIER s} -| eof - { EOF } -| _ -{ raise (Error (Printf.sprintf "At offset %d: unexpected character.\n" (Lexing.lexeme_start lexbuf))) } - -and read_string buf = - parse - | '"' { STRING (Buffer.contents buf) } - | '\\' '/' { Buffer.add_char buf '/'; read_string buf lexbuf } - | '\\' '\\' { Buffer.add_char buf '\\'; read_string buf lexbuf } - | '\\' 'b' { Buffer.add_char buf '\b'; read_string buf lexbuf } - | '\\' 'f' { Buffer.add_char buf '\012'; read_string buf lexbuf } - | '\\' 'n' { Buffer.add_char buf '\n'; read_string buf lexbuf } - | '\\' 'r' { Buffer.add_char buf '\r'; read_string buf lexbuf } - | '\\' 't' { Buffer.add_char buf '\t'; read_string buf lexbuf } - | '\\' '\'' { Buffer.add_char buf '\''; read_string buf lexbuf } - | '\\' '"' { Buffer.add_char buf '"'; read_string buf lexbuf } - | '\n' { Lexing.new_line lexbuf; Buffer.add_char buf '\n'; read_string buf lexbuf } - | [^ '"' '\\']+ - { Buffer.add_string buf (Lexing.lexeme lexbuf); - read_string buf lexbuf - } - | _ { raise (Error (Printf.sprintf "Illegal string character: %s" (Lexing.lexeme lexbuf))) } - | eof { raise (Error ("String is not terminated")) } - -and read_single_quoted_string buf = - parse - | ''' { STRING (Buffer.contents buf) } - | '\\' '/' { Buffer.add_char buf '/'; read_string buf lexbuf } - | '\\' '\\' { Buffer.add_char buf '\\'; read_string buf lexbuf } - | '\\' 'b' { Buffer.add_char buf '\b'; read_string buf lexbuf } - | '\\' 'f' { Buffer.add_char buf '\012'; read_string buf lexbuf } - | '\\' 'n' { Buffer.add_char buf '\n'; read_string buf lexbuf } - | '\\' 'r' { Buffer.add_char buf '\r'; read_string buf lexbuf } - | '\\' 't' { Buffer.add_char buf '\t'; read_string buf lexbuf } - | '\\' '\'' { Buffer.add_char buf '\''; read_string buf lexbuf } - | '\\' '"' { Buffer.add_char buf '"'; read_string buf lexbuf } - | '\n' { Lexing.new_line lexbuf; Buffer.add_char buf '\n'; read_string buf lexbuf } - | [^ ''' '\\']+ - { Buffer.add_string buf (Lexing.lexeme lexbuf); - read_single_quoted_string buf lexbuf - } - | _ { raise (Error (Printf.sprintf "Illegal string character: %s" (Lexing.lexeme lexbuf))) } - | eof { raise (Error ("String is not terminated")) } - -and read_comment buf = - parse - | "*/" - { COMMENT (Buffer.contents buf) } - | _ - { Buffer.add_string buf (Lexing.lexeme lexbuf); - read_comment buf lexbuf - } diff --git a/src/curly_parser.mly b/src/curly_parser.mly deleted file mode 100644 index be5aadc..0000000 --- a/src/curly_parser.mly +++ /dev/null @@ -1,114 +0,0 @@ -%{ - open Config_tree - - exception Duplicate_child of (string * string) - - (* Used for checking if after merging immediate children, - any of them have duplicate children inside, - e.g. "interfaces { ethernet eth0 {...} ethernet eth0 {...} }" *) - let find_duplicate_children n = - let rec aux xs = - let xs = List.sort compare xs in - match xs with - | [] | [_] -> () - | x :: x' :: xs -> - if x = x' then raise (Duplicate_child (Vytree.name_of_node n, x)) - else aux (x' :: xs) - in - aux @@ Vytree.list_children n - - (* When merging nodes with values, append values of subsequent nodes to the - first one *) - let merge_data l r = {l with values=(List.append l.values r.values)} -%} - -%token <string> IDENTIFIER -%token <string> STRING -%token <string> COMMENT -%token INACTIVE -%token EPHEMERAL -%token LEFT_BRACE -%token RIGHT_BRACE -%token LEFT_BRACKET -%token RIGHT_BRACKET -%token SEMI -%token EOF - -%start <Config_tree.t> config -%% - -opt_comment: - | (* empty *) { None } - | c = COMMENT { Some (String.trim c) } -; - -value: - | v = STRING - { v } - | v = IDENTIFIER - { v } -; - -values: - | v = value { [v] } - | LEFT_BRACKET; vs = separated_nonempty_list(SEMI, value); RIGHT_BRACKET - { (List.rev vs) } -; - -leaf_node: - | comment = opt_comment; inactive = boption(INACTIVE); ephemeral = boption(EPHEMERAL); - name = IDENTIFIER; values = values; SEMI - { Vytree.make_full {values=(List.rev values); comment=comment; inactive=inactive; ephemeral=ephemeral} name []} - | comment = opt_comment; inactive = boption(INACTIVE); ephemeral = boption(EPHEMERAL); - name = IDENTIFIER; SEMI (* valueless node *) - { Vytree.make_full {default_data with comment=comment; inactive=inactive; ephemeral=ephemeral} name [] } -; - -node: - | comment = opt_comment; inactive = boption(INACTIVE); ephemeral = boption(EPHEMERAL); - name = IDENTIFIER; LEFT_BRACE; children = list(node_content); RIGHT_BRACE - { - let node = - Vytree.make_full {default_data with comment=comment; inactive=inactive; ephemeral=ephemeral} name [] in - let node = List.fold_left Vytree.adopt node (List.rev children) |> Vytree.merge_children merge_data in - try - List.iter find_duplicate_children (Vytree.children_of_node node); - node - with - | Duplicate_child (child, dup) -> - failwith (Printf.sprintf "Node \"%s %s\" has two children named \"%s\"" name child dup) - } -; - -tag_node: - | comment = opt_comment; inactive = boption(INACTIVE); ephemeral = boption(EPHEMERAL); - name = IDENTIFIER; tag = IDENTIFIER; LEFT_BRACE; children = list(node_content); RIGHT_BRACE - { - let outer_node = Vytree.make_full default_data name [] in - let inner_node = - Vytree.make_full {default_data with comment=comment; inactive=inactive; ephemeral=ephemeral} tag [] in - let inner_node = List.fold_left Vytree.adopt inner_node (List.rev children) |> Vytree.merge_children merge_data in - let node = Vytree.adopt outer_node inner_node in - try - List.iter find_duplicate_children (Vytree.children_of_node inner_node); - node - with - | Duplicate_child (child, dup) -> - failwith (Printf.sprintf "Node \"%s %s %s\" has two children named \"%s\"" name tag child dup) - } - -node_content: n = node { n } | n = leaf_node { n } | n = tag_node { n }; - -%public config: - | ns = list(node); EOF - { - let root = make "root" in - let root = List.fold_left Vytree.adopt root (List.rev ns) |> Vytree.merge_children merge_data in - try - List.iter find_duplicate_children (Vytree.children_of_node root); - root - with - | Duplicate_child (child, dup) -> - failwith (Printf.sprintf "Node \"%s\" has two children named \"%s\"" child dup) - } -; diff --git a/src/defaults.ml b/src/defaults.ml index b6d0030..9ce36e5 100644 --- a/src/defaults.ml +++ b/src/defaults.ml @@ -7,7 +7,7 @@ type vyconf_defaults = { } let defaults = { - config_file = "/etc/vyconfd.conf"; + config_file = "/etc/vyos/vyconfd.conf"; pid_file = "/var/run/vyconfd.pid"; socket = "/var/run/vyconfd.sock"; log_template = "$(date) $(name)[$(pid)]: $(message)"; diff --git a/src/directories.ml b/src/directories.ml index 3b7156f..c28f055 100644 --- a/src/directories.ml +++ b/src/directories.ml @@ -33,12 +33,19 @@ let make basepath conf = We do not try to check if they are readable at this point, it's just to fail early if they don't even exist and we shouldn't bother trying *) + +let check_dir d = + if FU.test FU.Is_dir d then () + else raise (Failure (Printf.sprintf "%s does not exist or is not a directory" d)) + let test dirs = - let check_dir d = - if FU.test FU.Is_dir d then () - else raise (Failure (Printf.sprintf "%s does not exist or is not a directory" d)) in let l = [dirs.components; dirs.validators; dirs.migrators; dirs.component_definitions; dirs.interface_definitions] in try List.iter check_dir l; Ok () with Failure msg -> Error msg + +let test_validators_dir dirs = + try + check_dir dirs.validators; Ok () + with Failure msg -> Error msg diff --git a/src/directories.mli b/src/directories.mli index 9a7a376..fb01f16 100644 --- a/src/directories.mli +++ b/src/directories.mli @@ -9,3 +9,5 @@ type t = { val make : string -> Vyconf_config.t -> t val test : t -> (unit, string) result + +val test_validators_dir : t -> (unit, string) result diff --git a/src/dune b/src/dune new file mode 100644 index 0000000..2fef6cc --- /dev/null +++ b/src/dune @@ -0,0 +1,79 @@ +(include_subdirs unqualified) + +(library + (name vyconf_connect) + (public_name vyconf.vyconf-connect) + (modules vyconf_pbt message) + (libraries lwt lwt.unix lwt_log lwt_ppx ocaml-protoc fileutils ppx_deriving_yojson) + (preprocess (pps lwt_ppx ppx_deriving_yojson))) + +(library + (name vyconfd_config) + (modules vyconf_config session directories defaults) + (libraries vyos1x-config vyconf_connect toml sha ppx_deriving.show) + (preprocess (pps ppx_deriving.show ppx_deriving_yojson))) + +(library + (name client) + (public_name vyconf.vyconf-client) + (modules vyconf_client vyconf_client_session) + (libraries vyos1x-config vyconf_connect lwt lwt.unix lwt_log lwt_ppx ocaml-protoc toml sha + yojson ppx_deriving.show ppx_deriving_yojson) + (preprocess (pps lwt_ppx ppx_deriving.show ppx_deriving_yojson))) + +(executable + (name vyconfd) + (public_name vyconfd) + (modules vyconfd startup version) + (libraries vyos1x-config vyconfd_config vyconf_connect) + (preprocess (pps lwt_ppx))) + +(executable + (name vycli) + (public_name vycli) + (modules vycli) + (libraries client) + (preprocess (pps lwt_ppx))) + +(executable + (name validate) + (public_name validate) + (modules validate) + (libraries client)) + +(rule + (alias protoc) + (mode promote) + (targets vyconf_pbt.ml vyconf_pbt.mli) + (action + (chdir + %{project_root} + (progn + (run ocaml-protoc --ml_out src data/vyconf.proto) + (run mv src/vyconf.ml src/vyconf_pbt.ml) + (run mv src/vyconf.mli src/vyconf_pbt.mli))))) + +(library + (name vyos1x_adapter) + (public_name vyconf.vyos1x-adapter) + (libraries vyos1x-config vyconf.vyconf-client ctypes ctypes-foreign lwt lwt.unix lwt_log lwt_ppx) + (modules vyos1x_adapter) + (preprocess (pps lwt_ppx ppx_deriving_yojson))) + +(executable + (name vy_set) + (public_name vy_set) + (libraries vyos1x_adapter vyconf.vyconf-client) + (modules vy_set)) + +(executable + (name vy_delete) + (public_name vy_delete) + (libraries vyos1x_adapter vyconf.vyconf-client) + (modules vy_delete)) + +(executable + (name vy_load_config) + (public_name vy_load_config) + (libraries vyos1x_adapter vyos1x-config) + (modules vy_load_config)) diff --git a/src/message.ml b/src/message.ml index 3629f0d..d4cc374 100644 --- a/src/message.ml +++ b/src/message.ml @@ -3,6 +3,11 @@ Messages are preceded by a length header, four bytes in network order. *) +(** Makes a hex dump of a byte string *) +let hexdump b = + let dump = ref "" in + Bytes.iter (fun c -> dump := Char.code c |> Printf.sprintf "%s %02x" !dump) b; + !dump let read ic = let header = Bytes.create 4 in @@ -12,14 +17,14 @@ let read ic = if length < 0 then failwith (Printf.sprintf "Bad message length: %d" length) else let buffer = Bytes.create length in let%lwt () = Lwt_io.read_into_exactly ic buffer 0 length in - Lwt_log.debug (Util.hexdump buffer |> Printf.sprintf "Read mesage: %s") |> Lwt.ignore_result; + Lwt_log.debug (hexdump buffer |> Printf.sprintf "Read mesage: %s") |> Lwt.ignore_result; Lwt.return buffer let write oc msg = let length = Bytes.length msg in let length' = Int32.of_int length in Lwt_log.debug (Printf.sprintf "Write length: %d\n" length) |> Lwt.ignore_result; - Lwt_log.debug (Util.hexdump msg |> Printf.sprintf "Write message: %s") |> Lwt.ignore_result; + Lwt_log.debug (hexdump msg |> Printf.sprintf "Write message: %s") |> Lwt.ignore_result; if length' < 0l then failwith (Printf.sprintf "Bad message length: %d" length) else let header = Bytes.create 4 in let () = EndianBytes.BigEndian.set_int32 header 0 length' in diff --git a/src/reference_tree.ml b/src/reference_tree.ml deleted file mode 100644 index 45789eb..0000000 --- a/src/reference_tree.ml +++ /dev/null @@ -1,237 +0,0 @@ -type node_type = Leaf | Tag | Other - -type ref_node_data = { - node_type: node_type; - constraints: (Value_checker.value_constraint list); - help: string; - value_help: (string * string) list; - constraint_error_message: string; - multi: bool; - valueless: bool; - owner: string option; - keep_order: bool; - hidden: bool; - secret: bool; -} - -type t = ref_node_data Vytree.t - -exception Bad_interface_definition of string - -exception Validation_error of string - -let default_data = { - node_type = Other; - constraints = []; - help = "No help available"; - value_help = []; - constraint_error_message = "Invalid value"; - multi = false; - valueless = false; - owner = None; - keep_order = false; - hidden = false; - secret = false; -} - -let default = Vytree.make default_data "root" - -(* Loading from XML *) - -let node_type_of_string s = - match s with - | "node" -> Other - | "tagNode" -> Tag - | "leafNode" -> Leaf - | _ -> raise (Bad_interface_definition - (Printf.sprintf "node, tagNode, or leafNode expected, %s found" s)) - -let load_constraint_from_xml d c = - let aux d c = - match c with - | Xml.Element ("regex", _, [Xml.PCData s]) -> - let cs = (Value_checker.Regex s) :: d.constraints in - {d with constraints=cs} - | Xml.Element ("validator", [("name", n); ("argument", a)], _) -> - let cs = (Value_checker.External (n, Some a)) :: d.constraints in - {d with constraints=cs} - | Xml.Element ("validator", [("name", n)], _) -> - let cs = (Value_checker.External (n, None)) :: d.constraints in - {d with constraints=cs} - | _ -> raise (Bad_interface_definition "Malformed constraint") - in Xml.fold aux d c - -let data_from_xml d x = - let aux d x = - match x with - | Xml.Element ("help", _, [Xml.PCData s]) -> {d with help=s} - | Xml.Element ("valueHelp", _, - [Xml.Element ("format", _, [Xml.PCData fmt]); - Xml.Element ("description", _, [Xml.PCData descr])]) -> - let vhs = d.value_help in - let vhs' = (fmt, descr) :: vhs in - {d with value_help=vhs'} - | Xml.Element ("multi", _, _) -> {d with multi=true} - | Xml.Element ("valueless", _, _) -> {d with valueless=true} - | Xml.Element ("constraintErrorMessage", _, [Xml.PCData s]) -> - {d with constraint_error_message=s} - | Xml.Element ("constraint", _, _) -> load_constraint_from_xml d x - | Xml.Element ("hidden", _, _) -> {d with hidden=true} - | Xml.Element ("secret", _, _) -> {d with secret=true} - | Xml.Element ("keepChildOrder", _, _) -> {d with keep_order=true} - | _ -> raise (Bad_interface_definition "Malformed property tag") - in Xml.fold aux d x - -let rec insert_from_xml basepath reftree xml = - match xml with - | Xml.Element (tag, _, _) -> - let props = Util.find_xml_child "properties" xml in - let data = - (match props with - | None -> default_data - | Some p -> data_from_xml default_data p) - in - let node_type = node_type_of_string (Xml.tag xml) in - let node_owner = try let o = Xml.attrib xml "owner" in Some o - with _ -> None - in - let data = {data with node_type=node_type; owner=node_owner} in - let name = Xml.attrib xml "name" in - let path = basepath @ [name] in - let new_tree = Vytree.insert reftree path data in - (match node_type with - | Leaf -> new_tree - | _ -> - let children = Util.find_xml_child "children" xml in - (match children with - | None -> raise (Bad_interface_definition (Printf.sprintf "Node %s has no children" name)) - | Some c -> List.fold_left (insert_from_xml path) new_tree (Xml.children c))) - | _ -> raise (Bad_interface_definition "PCData not allowed here") - -let load_from_xml reftree file = - let xml_to_reftree xml reftree = - match xml with - | Xml.Element ("interfaceDefinition", attrs, children) -> - List.fold_left (insert_from_xml []) reftree children - | _ -> raise (Bad_interface_definition "Should start with <interfaceDefinition>") - in - try - let xml = Xml.parse_file file in - xml_to_reftree xml reftree - with - | Xml.File_not_found msg -> raise (Bad_interface_definition msg) - | Xml.Error e -> raise (Bad_interface_definition (Xml.error e)) - -(* Validation function *) - -let has_illegal_characters name = - (** Checks if string name has illegal characters in it. - All whitespace, curly braces, square brackets, and quotes - are disallowed due to their special significance to the curly config - format parser *) - try Some (Pcre.get_substring (Pcre.exec ~pat:"[\\s\\{\\}\\[\\]\"\'#]" name) 0) - with Not_found -> None - -(** Takes a list of string that represents a configuration path that may have - node value at the end, validates it, and splits it into path and value parts. - - A list of strings is a valid path that can be created in the config tree unless: - 1. It's a tag node without a child - 2. It's a non-valueless leaf node without a value - 3. It's a valueless node with a value - 4. It's a non-valueless leaf node with garbage after the value - 5. It's a non-leaf, non-tag node with a name that doesn't exist - in the reference tree - *) -let rec validate_path validators_dir node path = - let show_path p = Printf.sprintf "[%s]" @@ Util.string_of_list (List.rev p) in - let rec aux node path acc = - let data = Vytree.data_of_node node in - match data.node_type with - | Leaf -> - (match path with - | [] -> - if data.valueless then (List.rev acc, None) - else raise (Validation_error - (Printf.sprintf "Node %s requires a value" (show_path acc) )) - | [p] -> - if not data.valueless then - (if (Value_checker.validate_any validators_dir data.constraints p) then (List.rev acc, Some p) - else raise (Validation_error data.constraint_error_message)) - else raise (Validation_error - (Printf.sprintf "Node %s cannot have a value" (show_path acc))) - | p :: ps -> raise (Validation_error (Printf.sprintf "Path %s is too long" (show_path acc)))) - | Tag -> - (match path with - | p :: p' :: ps -> - (match (has_illegal_characters p) with - | Some c -> raise (Validation_error (Printf.sprintf "Illegal character \"%s\" in node name \"%s\"" c p)) - | None -> - if (Value_checker.validate_any validators_dir data.constraints p) then - let child = Vytree.find node p' in - (match child with - | Some c -> aux c ps (p' :: p :: acc) - | None -> raise (Validation_error (Printf.sprintf "Node %s has no child %s" (show_path acc) p'))) - else raise (Validation_error (Printf.sprintf "%s is not a valid child name for node %s" p (show_path acc)))) - | [p] -> if (Value_checker.validate_any validators_dir data.constraints p) then (List.rev acc, None) - else raise (Validation_error (Printf.sprintf "Node %s has no child %s" (show_path acc) p)) - | _ -> raise (Validation_error (Printf.sprintf "Path %s is incomplete" (show_path acc)))) - | Other -> - (match path with - | [] -> (List.rev acc, None) - | p :: ps -> - let child = Vytree.find node p in - (match child with - | Some c -> aux c ps (p :: acc) - | None -> raise (Validation_error ((Printf.sprintf "Path %s is incomplete" (show_path acc)))))) - in aux node path [] - -let is_multi reftree path = - let data = Vytree.get_data reftree path in - data.multi - -let is_hidden reftree path = - let data = Vytree.get_data reftree path in - data.hidden - -let is_secret reftree path = - let data = Vytree.get_data reftree path in - data.secret - -let is_tag reftree path = - let data = Vytree.get_data reftree path in - match data.node_type with - | Tag -> true - | _ -> false - -let is_leaf reftree path = - let data = Vytree.get_data reftree path in - match data.node_type with - | Leaf -> true - | _ -> false - -let is_valueless reftree path = - let data = Vytree.get_data reftree path in - data.valueless - -let get_keep_order reftree path = - let data = Vytree.get_data reftree path in - data.keep_order - -let get_owner reftree path = - let data = Vytree.get_data reftree path in - data.owner - -let get_help_string reftree path = - let data = Vytree.get_data reftree path in - data.help - -let get_value_help reftree path = - let data = Vytree.get_data reftree path in - data.value_help - -let get_completion_data reftree path = - let aux node = - let data = Vytree.data_of_node node in - (data.node_type, data.multi, data.help) - in List.map aux (Vytree.children_of_node @@ Vytree.get reftree path) diff --git a/src/reference_tree.mli b/src/reference_tree.mli deleted file mode 100644 index 33813d5..0000000 --- a/src/reference_tree.mli +++ /dev/null @@ -1,51 +0,0 @@ -type node_type = Leaf | Tag | Other - -type ref_node_data = { - node_type: node_type; - constraints: (Value_checker.value_constraint list); - help: string; - value_help: (string * string) list; - constraint_error_message: string; - multi: bool; - valueless: bool; - owner: string option; - keep_order: bool; - hidden: bool; - secret: bool; -} - -exception Bad_interface_definition of string - -exception Validation_error of string - -type t = ref_node_data Vytree.t - -val default_data : ref_node_data - -val default : t - -val load_from_xml : t -> string -> t - -val validate_path : string -> t -> string list -> string list * string option - -val is_multi : t -> string list -> bool - -val is_hidden : t -> string list -> bool - -val is_secret : t -> string list -> bool - -val is_tag : t -> string list -> bool - -val is_leaf : t -> string list -> bool - -val is_valueless : t -> string list -> bool - -val get_keep_order : t -> string list -> bool - -val get_owner : t -> string list -> string option - -val get_help_string : t -> string list -> string - -val get_value_help : t -> string list -> (string * string) list - -val get_completion_data : t -> string list -> (node_type * bool * string) list diff --git a/src/session.ml b/src/session.ml index 832bfe6..a8eccad 100644 --- a/src/session.ml +++ b/src/session.ml @@ -1,5 +1,6 @@ -module CT = Config_tree -module RT = Reference_tree +module CT = Vyos1x.Config_tree +module VT = Vyos1x.Vytree +module RT = Vyos1x.Reference_tree module D = Directories exception Session_error of string @@ -16,7 +17,7 @@ type world = { } type session_data = { - proposed_config : Config_tree.t; + proposed_config : CT.t; modified: bool; conf_mode: bool; changeset: cfg_op list; @@ -36,12 +37,12 @@ let make world client_app user = { let string_of_op op = match op with | CfgSet (path, value, _) -> - let path_str = Util.string_of_list path in + let path_str = Vyos1x.Util.string_of_list path in (match value with | None -> Printf.sprintf "set %s" path_str | Some v -> Printf.sprintf "set %s \"%s\"" path_str v) | CfgDelete (path, value) -> - let path_str = Util.string_of_list path in + let path_str = Vyos1x.Util.string_of_list path in (match value with | None -> Printf.sprintf "delete %s" path_str | Some v -> Printf.sprintf "delete %s \"%s\"" path_str v) @@ -63,52 +64,66 @@ let rec apply_changes changeset config = | [] -> config | c :: cs -> apply_changes cs (apply_cfg_op c config) +let validate w _s path = + try + RT.validate_path D.(w.dirs.validators) w.reference_tree path + with RT.Validation_error x -> raise (Session_error x) + +let split_path w _s path = + RT.split_path w.reference_tree path + let set w s path = - let path, value = RT.validate_path D.(w.dirs.validators) w.reference_tree path in - let value_behaviour = if RT.is_multi w.reference_tree path then CT.AddValue else CT.ReplaceValue in + let _ = validate w s path in + let path, value = split_path w s path in + let refpath = RT.refpath w.reference_tree path in + let value_behaviour = if RT.is_multi w.reference_tree refpath then CT.AddValue else CT.ReplaceValue in let op = CfgSet (path, value, value_behaviour) in let config = apply_cfg_op op s.proposed_config in {s with proposed_config=config; changeset=(op :: s.changeset)} let delete w s path = - let path, value = RT.validate_path D.(w.dirs.validators) w.reference_tree path in + let _ = validate w s path in + let path, value = split_path w s path in let op = CfgDelete (path, value) in let config = apply_cfg_op op s.proposed_config in {s with proposed_config=config; changeset=(op :: s.changeset)} let get_value w s path = - if not (Vytree.exists s.proposed_config path) then - raise (Session_error ("Path does not exist")) - else if not (RT.is_leaf w.reference_tree path) then + if not (VT.exists s.proposed_config path) then + raise (Session_error ("Config path does not exist")) + else let refpath = RT.refpath w.reference_tree path in + if not (RT.is_leaf w.reference_tree refpath) then raise (Session_error "Cannot get a value of a non-leaf node") - else if (RT.is_multi w.reference_tree path) then + else if (RT.is_multi w.reference_tree refpath) then raise (Session_error "This node can have more than one value") - else if (RT.is_valueless w.reference_tree path) then + else if (RT.is_valueless w.reference_tree refpath) then raise (Session_error "This node can have more than one value") else CT.get_value s.proposed_config path let get_values w s path = - if not (Vytree.exists s.proposed_config path) then - raise (Session_error ("Path does not exist")) - else if not (RT.is_leaf w.reference_tree path) then + if not (VT.exists s.proposed_config path) then + raise (Session_error ("Config path does not exist")) + else let refpath = RT.refpath w.reference_tree path in + if not (RT.is_leaf w.reference_tree refpath) then raise (Session_error "Cannot get a value of a non-leaf node") - else if not (RT.is_multi w.reference_tree path) then + else if not (RT.is_multi w.reference_tree refpath) then raise (Session_error "This node can have only one value") - else CT.get_values s.proposed_config path + else CT.get_values s.proposed_config path let list_children w s path = - if not (Vytree.exists s.proposed_config path) then - raise (Session_error ("Path does not exist")) - else if (RT.is_leaf w.reference_tree path) then + if not (VT.exists s.proposed_config path) then + raise (Session_error ("Config path does not exist")) + else let refpath = RT.refpath w.reference_tree path in + if (RT.is_leaf w.reference_tree refpath) then raise (Session_error "Cannot list children of a leaf node") - else Vytree.children_of_path s.proposed_config path + else VT.children_of_path s.proposed_config path -let exists w s path = - Vytree.exists s.proposed_config path +let exists _w s path = + VT.exists s.proposed_config path -let show_config w s path fmt = - let open Vyconf_types in - if (path <> []) && not (Vytree.exists s.proposed_config path) then +let show_config _w s path fmt = + let open Vyconf_connect.Vyconf_pbt in + if (path <> []) && not (VT.exists s.proposed_config path) then raise (Session_error ("Path does not exist")) else let node = s.proposed_config in @@ -117,5 +132,5 @@ let show_config w s path fmt = | Json -> let node = (match path with [] -> s.proposed_config | - _ as ps -> Vytree.get s.proposed_config ps) in + _ as ps -> VT.get s.proposed_config ps) in CT.to_yojson node |> Yojson.Safe.pretty_to_string diff --git a/src/session.mli b/src/session.mli index 299f2ca..16d8e35 100644 --- a/src/session.mli +++ b/src/session.mli @@ -1,16 +1,16 @@ type cfg_op = - | CfgSet of string list * string option * Config_tree.value_behaviour + | CfgSet of string list * string option * Vyos1x.Config_tree.value_behaviour | CfgDelete of string list * string option type world = { - running_config: Config_tree.t; - reference_tree: Reference_tree.t; + running_config: Vyos1x.Config_tree.t; + reference_tree: Vyos1x.Reference_tree.t; vyconf_config: Vyconf_config.t; dirs: Directories.t } type session_data = { - proposed_config : Config_tree.t; + proposed_config : Vyos1x.Config_tree.t; modified: bool; conf_mode: bool; changeset: cfg_op list; @@ -22,6 +22,12 @@ exception Session_error of string val make : world -> string -> string -> session_data +val set_modified : session_data -> session_data + +val apply_changes : cfg_op list -> Vyos1x.Config_tree.t -> Vyos1x.Config_tree.t + +val validate : world -> session_data -> string list -> unit + val set : world -> session_data -> string list -> session_data val delete : world -> session_data -> string list -> session_data @@ -36,4 +42,4 @@ val list_children : world -> session_data -> string list -> string list val string_of_op : cfg_op -> string -val show_config : world -> session_data -> string list -> Vyconf_types.request_config_format -> string +val show_config : world -> session_data -> string list -> Vyconf_connect.Vyconf_pbt.request_config_format -> string diff --git a/src/startup.ml b/src/startup.ml index cea5f02..db0d719 100644 --- a/src/startup.ml +++ b/src/startup.ml @@ -33,7 +33,7 @@ let setup_logger daemonize log_file template = (** Load the config file or panic if it fails *) let load_daemon_config path = - let result = Vyconf_config.load path in + let result = Vyconfd_config.Vyconf_config.load path in match result with | Ok cfg -> cfg | Error err -> @@ -41,7 +41,13 @@ let load_daemon_config path = (** Check if appliance directories exist and panic if they don't *) let check_dirs dirs = - let res = Directories.test dirs in + let res = Vyconfd_config.Directories.test dirs in + match res with + | Ok _ -> () + | Error err -> panic err + +let check_validators_dir dirs = + let res = Vyconfd_config.Directories.test_validators_dir dirs in match res with | Ok _ -> () | Error err -> panic err @@ -61,6 +67,7 @@ let create_socket sockfile = let backlog = 10 in let%lwt sock = socket PF_UNIX SOCK_STREAM 0 |> Lwt.return in let%lwt () = Lwt_unix.bind sock @@ ADDR_UNIX(sockfile) in + let%lwt () = Lwt_unix.chmod sockfile 0o775 in listen sock backlog; Lwt.return sock @@ -75,11 +82,21 @@ let create_server accept_connection sock = let load_config file = try let chan = open_in file in - let config = Curly_parser.config Curly_lexer.token (Lexing.from_channel chan) in + let s = really_input_string chan (in_channel_length chan) in + let config = Vyos1x.Parser.from_string s in Ok config with | Sys_error msg -> Error msg - | Curly_parser.Error -> Error "Parse error" + | Vyos1x.Util.Syntax_error (opt, msg) -> + begin + match opt with + | None -> + let out = Printf.sprintf "Parse error: %s\n" msg + in Error out + | Some (line, pos) -> + let out = Printf.sprintf "Parse error: %s line %d pos %d\n" msg line pos + in Error out + end (** Load the appliance configuration file or the fallback config *) let load_config_failsafe main fallback = @@ -99,10 +116,10 @@ let load_config_failsafe main fallback = (* Load interface definitions from a directory into a reference tree *) let load_interface_definitions dir = - let open Reference_tree in + let open Vyos1x.Reference_tree in let relative_paths = FileUtil.ls dir in let absolute_paths = - try Ok (List.map Util.absolute_path relative_paths) + try Ok (List.map Vyos1x.Util.absolute_path relative_paths) with Sys_error no_dir_msg -> Error no_dir_msg in let load_aux tree file = @@ -114,3 +131,10 @@ let load_interface_definitions dir = | Error msg -> Error msg end with Bad_interface_definition msg -> Error msg +module I = Vyos1x.Internal.Make(Vyos1x.Reference_tree) + +let read_reference_tree file = + try + let reftree = I.read_internal file in + Ok reftree + with Sys_error msg -> Error msg diff --git a/src/startup.mli b/src/startup.mli index c32ddea..84fb99e 100644 --- a/src/startup.mli +++ b/src/startup.mli @@ -2,9 +2,11 @@ val panic : string -> 'a val setup_logger : bool -> string option -> Lwt_log.template -> unit Lwt.t -val load_daemon_config : string -> Vyconf_config.t +val load_daemon_config : string -> Vyconfd_config.Vyconf_config.t -val check_dirs : Directories.t -> unit +val check_dirs : Vyconfd_config.Directories.t -> unit + +val check_validators_dir : Vyconfd_config.Directories.t -> unit val create_socket : string -> Lwt_unix.file_descr Lwt.t @@ -12,8 +14,10 @@ val create_server : (Lwt_unix.file_descr * Lwt_unix.sockaddr -> unit Lwt.t) -> Lwt_unix.file_descr -> unit -> 'a Lwt.t -val load_config : string -> (Config_tree.t, string) result +val load_config : string -> (Vyos1x.Config_tree.t, string) result + +val load_config_failsafe : string -> string -> Vyos1x.Config_tree.t -val load_config_failsafe : string -> string -> Config_tree.t +val load_interface_definitions : string -> (Vyos1x.Reference_tree.t, string) result -val load_interface_definitions : string -> (Reference_tree.t, string) result +val read_reference_tree : string -> (Vyos1x.Reference_tree.t, string) result diff --git a/src/util.ml b/src/util.ml deleted file mode 100644 index c4bbd96..0000000 --- a/src/util.ml +++ /dev/null @@ -1,38 +0,0 @@ -(** The unavoidable module for functions that don't fit anywhere else *) - -(** Find a child node in xml-lite *) -let find_xml_child name xml = - let find_aux e = - match e with - | Xml.Element (name', _, _) when name' = name -> true - | _ -> false - in - match xml with - | Xml.Element (_, _, children) -> Vylist.find find_aux children - | Xml.PCData _ -> None - -(** Convert a list of strings to a string of unquoted, space separated words *) -let string_of_list ss = - let rec aux xs acc = - match xs with - | [] -> acc - | x :: xs' -> aux xs' (Printf.sprintf "%s %s" acc x) - in - match ss with - | [] -> "" - | x :: xs -> Printf.sprintf "%s%s" x (aux xs "") - -(** Convert a list of strings to JSON *) -let json_of_list ss = - let ss = List.map (fun x -> `String x) ss in - Yojson.Safe.to_string (`List ss) - -(** Convert a relative path to an absolute path based on the current working directory *) -let absolute_path relative_path = - FilePath.make_absolute (Sys.getcwd ()) relative_path - -(** Makes a hex dump of a byte string *) -let hexdump b = - let dump = ref "" in - Bytes.iter (fun c -> dump := Char.code c |> Printf.sprintf "%s %02x" !dump) b; - !dump diff --git a/src/util.mli b/src/util.mli deleted file mode 100644 index 4c11d9e..0000000 --- a/src/util.mli +++ /dev/null @@ -1,9 +0,0 @@ -val find_xml_child : string -> Xml.xml -> Xml.xml option - -val string_of_list : string list -> string - -val json_of_list : string list -> string - -val absolute_path : FilePath.filename -> FilePath.filename - -val hexdump : bytes -> string diff --git a/src/validate.ml b/src/validate.ml new file mode 100644 index 0000000..7b3b596 --- /dev/null +++ b/src/validate.ml @@ -0,0 +1,32 @@ +open Client.Vyconf_client_session + +let path_opt = ref "" + +let usage = "Usage: " ^ Sys.argv.(0) ^ " [options]" + +let args = [ + ("--path", Arg.String (fun s -> path_opt := s), "<string> Configuration path"); + ] + +let get_sockname = + "/var/run/vyconfd.sock" + +let main socket path_list = + let token = session_init socket in + match token with + | Error e -> "Failed to initialize session: " ^ e + | Ok token -> + let out = session_validate_path socket token path_list + in + let _ = session_free socket token in + match out with + | Error e -> "Failed to validate path: " ^ e + | Ok _ -> "No error" + +let _ = + let () = Arg.parse args (fun _ -> ()) usage in + let path_list = Vyos1x.Util.list_of_path !path_opt in + let socket = get_sockname in + let result = main socket path_list in + let () = print_endline result in + exit 0 diff --git a/src/value_checker.ml b/src/value_checker.ml deleted file mode 100644 index aa88f7b..0000000 --- a/src/value_checker.ml +++ /dev/null @@ -1,39 +0,0 @@ -module F = Filename - -type value_constraint = Regex of string | External of string * string option - -exception Bad_validator of string - -let validate_value dir value_constraint value = - match value_constraint with - | Regex s -> - (try - let _ = Pcre.exec ~pat:s value in true - with Not_found -> false) - | External (v, c) -> - (* XXX: Using Unix.system is a bad idea on multiple levels, - especially when the input comes directly from the user... - We should do something about it. - *) - let validator = F.concat dir v in - let arg = BatOption.default "" c in - let safe_arg = Printf.sprintf "'%s'" (Pcre.qreplace ~pat:"\"" ~templ:"\\\"" arg) in - let result = Unix.system (Printf.sprintf "%s %s %s" validator safe_arg value) in - match result with - | Unix.WEXITED 0 -> true - | Unix.WEXITED 127 -> raise (Bad_validator (Printf.sprintf "Could not execute validator %s" validator)) - | _ -> false - -(* If no constraints given, consider it valid. - Otherwise consider it valid if it satisfies at least - one constraint *) -let validate_any validators constraints value = - let rec aux validators constraints value = - match constraints with - | [] -> false - | c :: cs -> if validate_value validators c value then true - else aux validators cs value - in - match constraints with - | [] -> true - | _ -> aux validators constraints value diff --git a/src/value_checker.mli b/src/value_checker.mli deleted file mode 100644 index d786f5e..0000000 --- a/src/value_checker.mli +++ /dev/null @@ -1,7 +0,0 @@ -type value_constraint = Regex of string | External of string * string option - -exception Bad_validator of string - -val validate_value : string -> value_constraint -> string -> bool - -val validate_any : string -> value_constraint list -> string -> bool diff --git a/src/vycli.ml b/src/vycli.ml index e00a4e3..1430a5a 100644 --- a/src/vycli.ml +++ b/src/vycli.ml @@ -1,5 +1,5 @@ -open Vyconf_client -open Vyconf_types +open Client.Vyconf_client +open Vyconf_connect.Vyconf_pbt type op_t = | OpStatus @@ -10,6 +10,7 @@ type op_t = | OpGetValue | OpGetValues | OpListChildren + | OpValidate let token : string option ref = ref None let conf_format_opt = ref "curly" @@ -34,6 +35,7 @@ let args = [ ("--list-children", Arg.Unit (fun () -> op := Some OpListChildren), "List children of the node at the specified path"); ("--show-config", Arg.Unit (fun () -> op := Some OpShowConfig), "Show the configuration at the specified path"); ("--status", Arg.Unit (fun () -> op := Some OpStatus), "Send a status/keepalive message"); + ("--validate", Arg.Unit (fun () -> op := Some OpValidate), "Validate path"); ] let config_format_of_string s = @@ -49,7 +51,7 @@ let output_format_of_string s = | _ -> failwith (Printf.sprintf "Unknown output format %s, should be plain or json" s) let main socket op path out_format config_format = - let%lwt client = Vyconf_client.create ~token:!token socket out_format config_format in + let%lwt client = Client.Vyconf_client.create ~token:!token socket out_format config_format in let%lwt result = match op with | None -> Error "Operation required" |> Lwt.return | Some o -> @@ -60,7 +62,7 @@ let main socket op path out_format config_format = begin match resp.status with | Success -> Ok "" |> Lwt.return - | _ -> Error (BatOption.default "" resp.error) |> Lwt.return + | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return end | OpSetupSession -> let%lwt resp = setup_session client "vycli" in @@ -74,6 +76,7 @@ let main socket op path out_format config_format = | OpGetValues -> get_values client path | OpListChildren -> list_children client path | OpShowConfig -> show_config client path + | OpValidate -> validate client path | _ -> Error "Unimplemented" |> Lwt.return end in match result with @@ -81,8 +84,8 @@ let main socket op path out_format config_format = | Error e -> let%lwt () = Lwt_io.write Lwt_io.stderr (Printf.sprintf "%s\n" e) in Lwt.return 1 let _ = - let () = Arg.parse args (fun f -> ()) usage in - let path = String.trim !path_opt |> Pcre.split ~pat:"\\s+" in + let () = Arg.parse args (fun _ -> ()) usage in + let path = Vyos1x.Util.list_of_path !path_opt in let out_format = output_format_of_string !out_format_opt in let config_format = config_format_of_string !conf_format_opt in let result = Lwt_main.run (main !socket !op path out_format config_format) in exit result diff --git a/src/vyconf_client.ml b/src/vyconf_client.ml index db7d9c1..94348b2 100644 --- a/src/vyconf_client.ml +++ b/src/vyconf_client.ml @@ -1,5 +1,4 @@ -include Vyconf_pb -include Vyconf_types +include Vyconf_connect.Vyconf_pbt type t = { sock: Lwt_unix.file_descr; @@ -22,8 +21,8 @@ let create ?(token=None) sockfile out_format conf_format = let open Lwt_unix in let sock = socket PF_UNIX SOCK_STREAM 0 in let%lwt () = connect sock (ADDR_UNIX sockfile) in - let ic = Lwt_io.of_fd Lwt_io.Input sock in - let oc = Lwt_io.of_fd Lwt_io.Output sock in + let ic = Lwt_io.of_fd ~mode:Lwt_io.Input sock in + let oc = Lwt_io.of_fd ~mode:Lwt_io.Output sock in Lwt.return { sock=sock; ic=ic; oc=oc; enc=(Pbrt.Encoder.create ()); closed=false; @@ -43,11 +42,11 @@ let shutdown client = let do_request client req = let enc = Pbrt.Encoder.create () in - let () = encode_request_envelope {token=client.session; request=req} enc in + let () = encode_pb_request_envelope {token=client.session; request=req} enc in let msg = Pbrt.Encoder.to_bytes enc in - let%lwt () = Message.write client.oc msg in - let%lwt resp = Message.read client.ic in - decode_response (Pbrt.Decoder.of_bytes resp) |> Lwt.return + let%lwt () = Vyconf_connect.Message.write client.oc msg in + let%lwt resp = Vyconf_connect.Message.read client.ic in + decode_pb_response (Pbrt.Decoder.of_bytes resp) |> Lwt.return let get_status client = let req = Status in @@ -55,7 +54,7 @@ let get_status client = Lwt.return resp let setup_session ?(on_behalf_of=None) client client_app = - if BatOption.is_some client.session then Lwt.return (Error "Client is already associated with a session") else + if Option.is_some client.session then Lwt.return (Error "Client is already associated with a session") else 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 @@ -64,7 +63,16 @@ let setup_session ?(on_behalf_of=None) client client_app = (match resp.output with | Some token -> Ok {client with session=(Some token)} | None -> Error "setup_session did not return a session token!") |> Lwt.return - | _ -> Error (BatOption.default "Unknown error" resp.error) |> Lwt.return + | _ -> Error (Option.value resp.error ~default:"Unknown error") |> Lwt.return + +let teardown_session ?(on_behalf_of=None) client = + let id = on_behalf_of |> (function None -> None | Some x -> (Some (Int32.of_int x))) in + let req = Teardown {on_behalf_of=id} in + let%lwt resp = do_request client req in + match resp.status with + | Success -> Ok "" |> Lwt.return + | Fail -> Error (Option.value resp.error ~default:"") |> Lwt.return + | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return let exists client path = let req = Exists {path=path} in @@ -72,33 +80,40 @@ let exists client path = match resp.status with | Success -> Lwt.return (Ok "") | Fail -> Lwt.return (Error "") - | _ -> Error (BatOption.default "" resp.error) |> Lwt.return + | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return let get_value client path = let req = Get_value {path=path; output_format=(Some client.out_format)} in let%lwt resp = do_request client req in match resp.status with | Success -> unwrap resp.output |> Lwt.return - | _ -> Error (BatOption.default ""resp.error) |> Lwt.return + | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return let get_values client path = let req = Get_values {path=path; output_format=(Some client.out_format)} in let%lwt resp = do_request client req in match resp.status with | Success -> unwrap resp.output |> Lwt.return - | _ -> Error (BatOption.default "" resp.error) |> Lwt.return + | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return let list_children client path = let req = List_children {path=path; output_format=(Some client.out_format)} in let%lwt resp = do_request client req in match resp.status with | Success -> unwrap resp.output |> Lwt.return - | _ -> Error (BatOption.default "" resp.error) |> Lwt.return + | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return let show_config client path = let req = Show_config {path=path; format=(Some client.conf_format)} in let%lwt resp = do_request client req in match resp.status with | Success -> unwrap resp.output |> Lwt.return - | _ -> Error (BatOption.default "" resp.error) |> Lwt.return + | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return +let validate client path = + let req = Validate {path=path; output_format=(Some client.out_format)} in + let%lwt resp = do_request client req in + match resp.status with + | Success -> Lwt.return (Ok "") + | Fail -> Error (Option.value resp.error ~default:"") |> Lwt.return + | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return diff --git a/src/vyconf_client.mli b/src/vyconf_client.mli index 8eaada8..0feb063 100644 --- a/src/vyconf_client.mli +++ b/src/vyconf_client.mli @@ -19,7 +19,7 @@ type response = { } -val create : ?token:(string option) -> string -> Vyconf_types.request_output_format -> Vyconf_types.request_config_format -> t Lwt.t +val create : ?token:(string option) -> string -> Vyconf_connect.Vyconf_pbt.request_output_format -> Vyconf_connect.Vyconf_pbt.request_config_format -> t Lwt.t val get_token : t -> (string, string) result Lwt.t @@ -29,6 +29,8 @@ val get_status : t -> response Lwt.t val setup_session : ?on_behalf_of:(int option) -> t -> string -> (t, string) result Lwt.t +val teardown_session : ?on_behalf_of:(int option) -> t -> (string, string) result Lwt.t + val exists : t -> string list -> (string, string) result Lwt.t val get_value : t -> string list -> (string, string) result Lwt.t @@ -38,3 +40,5 @@ val get_values : t -> string list -> (string, string) result Lwt.t val list_children : t -> string list -> (string, string) result Lwt.t val show_config : t -> string list -> (string, string) result Lwt.t + +val validate : t -> string list -> (string, string) result Lwt.t diff --git a/src/vyconf_client_session.ml b/src/vyconf_client_session.ml new file mode 100644 index 0000000..70a2a13 --- /dev/null +++ b/src/vyconf_client_session.ml @@ -0,0 +1,64 @@ +open Vyconf_connect.Vyconf_pbt + +type op_t = + | OpSetupSession + | OpExists + | OpTeardownSession + | OpShowConfig + | OpValidate + +let config_format_of_string s = + match s with + | "curly" -> Curly + | "json" -> Json + | _ -> failwith (Printf.sprintf "Unknown config format %s, should be curly or json" s) + +let output_format_of_string s = + match s with + | "plain" -> Out_plain + | "json" -> Out_json + | _ -> failwith (Printf.sprintf "Unknown output format %s, should be plain or json" s) + +let call_op ?(out_format="plain") ?(config_format="curly") socket token op path = + let config_format = config_format_of_string config_format in + let out_format = output_format_of_string out_format in + let run = + let%lwt client = + Vyconf_client.create ~token:token socket out_format config_format + in + let%lwt result = match op with + | None -> Error "Operation required" |> Lwt.return + | Some o -> + begin + match o with + | OpSetupSession -> + let%lwt resp = Vyconf_client.setup_session client "vyconf_client_session" in + begin + match resp with + | Ok c -> Vyconf_client.get_token c + | Error e -> Error e |> Lwt.return + end + | OpExists -> Vyconf_client.exists client path + | OpTeardownSession -> Vyconf_client.teardown_session client + | OpShowConfig -> Vyconf_client.show_config client path + | OpValidate -> Vyconf_client.validate client path + end + in + Lwt.return result + in + Lwt_main.run run + +let session_init ?(out_format="plain") ?(config_format="curly") socket = + call_op ~out_format:out_format ~config_format:config_format socket None (Some OpSetupSession) [] + +let session_free socket token = + call_op socket (Some token) (Some OpTeardownSession) [] + +let session_validate_path socket token path = + call_op socket (Some token) (Some OpValidate) path + +let session_show_config socket token path = + call_op socket (Some token) (Some OpShowConfig) path + +let session_path_exists socket token path = + call_op socket (Some token) (Some OpExists) path diff --git a/src/vyconf_client_session.mli b/src/vyconf_client_session.mli new file mode 100644 index 0000000..98fa3c2 --- /dev/null +++ b/src/vyconf_client_session.mli @@ -0,0 +1,16 @@ +type op_t = + | OpSetupSession + | OpExists + | OpTeardownSession + | OpShowConfig + | OpValidate + +val session_init : ?out_format:string -> ?config_format:string -> string -> (string, string) result + +val session_free : string -> string -> (string, string) result + +val session_validate_path : string -> string -> string list -> (string, string) result + +val session_show_config : string -> string -> string list -> (string, string) result + +val session_path_exists : string -> string -> string list -> (string, string) result diff --git a/src/vyconf_config.ml b/src/vyconf_config.ml index 7a87c1a..2640c9b 100644 --- a/src/vyconf_config.ml +++ b/src/vyconf_config.ml @@ -7,6 +7,7 @@ type t = { config_dir: string; primary_config: string; fallback_config: string; + reference_tree: string; socket: string; pid_file: string; log_file: string option; @@ -23,6 +24,7 @@ let empty_config = { config_dir = ""; primary_config = ""; fallback_config = ""; + reference_tree = ""; socket = ""; pid_file = ""; log_file = None; @@ -37,7 +39,7 @@ let get_field conf tbl_name field_name = (* NB: TomlLenses module uses "table" and "field" names for function names, hence tbl_name and field_name *) - TomlLenses.(get conf (key tbl_name |-- table |-- key field_name |-- string)) + Toml.Lenses.(get conf (key tbl_name |-- table |-- key field_name |-- string)) let mandatory_field conf table field = let value = get_field conf table field in @@ -47,7 +49,7 @@ let mandatory_field conf table field = let optional_field default conf table field = let value = get_field conf table field in - BatOption.default default value + Option.value value ~default:default let load filename = try @@ -61,6 +63,7 @@ let load filename = let conf = {conf with program_dir = mandatory_field conf_toml "appliance" "program_dir"} in let conf = {conf with primary_config = mandatory_field conf_toml "appliance" "primary_config"} in let conf = {conf with fallback_config = mandatory_field conf_toml "appliance" "fallback_config"} in + let conf = {conf with reference_tree = mandatory_field conf_toml "appliance" "reference_tree"} in (* Optional fields *) let conf = {conf with pid_file = optional_field defaults.pid_file conf_toml "vyconf" "pid_file"} in let conf = {conf with socket = optional_field defaults.socket conf_toml "vyconf" "socket"} in diff --git a/src/vyconf_config.mli b/src/vyconf_config.mli index ed30b35..1cfeffa 100644 --- a/src/vyconf_config.mli +++ b/src/vyconf_config.mli @@ -5,6 +5,7 @@ type t = { config_dir: string; primary_config: string; fallback_config: string; + reference_tree: string; socket: string; pid_file: string; log_file: string option; diff --git a/src/vyconf_pb.ml b/src/vyconf_pb.ml deleted file mode 100644 index 4dced0f..0000000 --- a/src/vyconf_pb.ml +++ /dev/null @@ -1,1121 +0,0 @@ -[@@@ocaml.warning "-27-30-39"] - -type request_setup_session_mutable = { - mutable client_application : string option; - mutable on_behalf_of : int32 option; -} - -let default_request_setup_session_mutable () : request_setup_session_mutable = { - client_application = None; - on_behalf_of = None; -} - -type request_set_mutable = { - mutable path : string list; - mutable ephemeral : bool option; -} - -let default_request_set_mutable () : request_set_mutable = { - path = []; - ephemeral = None; -} - -type request_delete_mutable = { - mutable path : string list; -} - -let default_request_delete_mutable () : request_delete_mutable = { - path = []; -} - -type request_rename_mutable = { - mutable edit_level : string list; - mutable from : string; - mutable to_ : string; -} - -let default_request_rename_mutable () : request_rename_mutable = { - edit_level = []; - from = ""; - to_ = ""; -} - -type request_copy_mutable = { - mutable edit_level : string list; - mutable from : string; - mutable to_ : string; -} - -let default_request_copy_mutable () : request_copy_mutable = { - edit_level = []; - from = ""; - to_ = ""; -} - -type request_comment_mutable = { - mutable path : string list; - mutable comment : string; -} - -let default_request_comment_mutable () : request_comment_mutable = { - path = []; - comment = ""; -} - -type request_commit_mutable = { - mutable confirm : bool option; - mutable confirm_timeout : int32 option; - mutable comment : string option; -} - -let default_request_commit_mutable () : request_commit_mutable = { - confirm = None; - confirm_timeout = None; - comment = None; -} - -type request_rollback_mutable = { - mutable revision : int32; -} - -let default_request_rollback_mutable () : request_rollback_mutable = { - revision = 0l; -} - -type request_load_mutable = { - mutable location : string; - mutable format : Vyconf_types.request_config_format option; -} - -let default_request_load_mutable () : request_load_mutable = { - location = ""; - format = None; -} - -type request_merge_mutable = { - mutable location : string; - mutable format : Vyconf_types.request_config_format option; -} - -let default_request_merge_mutable () : request_merge_mutable = { - location = ""; - format = None; -} - -type request_save_mutable = { - mutable location : string; - mutable format : Vyconf_types.request_config_format option; -} - -let default_request_save_mutable () : request_save_mutable = { - location = ""; - format = None; -} - -type request_show_config_mutable = { - mutable path : string list; - mutable format : Vyconf_types.request_config_format option; -} - -let default_request_show_config_mutable () : request_show_config_mutable = { - path = []; - format = None; -} - -type request_exists_mutable = { - mutable path : string list; -} - -let default_request_exists_mutable () : request_exists_mutable = { - path = []; -} - -type request_get_value_mutable = { - mutable path : string list; - mutable output_format : Vyconf_types.request_output_format option; -} - -let default_request_get_value_mutable () : request_get_value_mutable = { - path = []; - output_format = None; -} - -type request_get_values_mutable = { - mutable path : string list; - mutable output_format : Vyconf_types.request_output_format option; -} - -let default_request_get_values_mutable () : request_get_values_mutable = { - path = []; - output_format = None; -} - -type request_list_children_mutable = { - mutable path : string list; - mutable output_format : Vyconf_types.request_output_format option; -} - -let default_request_list_children_mutable () : request_list_children_mutable = { - path = []; - output_format = None; -} - -type request_run_op_mode_mutable = { - mutable path : string list; - mutable output_format : Vyconf_types.request_output_format option; -} - -let default_request_run_op_mode_mutable () : request_run_op_mode_mutable = { - path = []; - output_format = None; -} - -type request_enter_configuration_mode_mutable = { - mutable exclusive : bool; - mutable override_exclusive : bool; -} - -let default_request_enter_configuration_mode_mutable () : request_enter_configuration_mode_mutable = { - exclusive = false; - override_exclusive = false; -} - -type request_envelope_mutable = { - mutable token : string option; - mutable request : Vyconf_types.request; -} - -let default_request_envelope_mutable () : request_envelope_mutable = { - token = None; - request = Vyconf_types.default_request (); -} - -type response_mutable = { - mutable status : Vyconf_types.status; - mutable output : string option; - mutable error : string option; - mutable warning : string option; -} - -let default_response_mutable () : response_mutable = { - status = Vyconf_types.default_status (); - output = None; - error = None; - warning = None; -} - - -let rec decode_request_config_format d = - match Pbrt.Decoder.int_as_varint d with - | 0 -> (Vyconf_types.Curly:Vyconf_types.request_config_format) - | 1 -> (Vyconf_types.Json:Vyconf_types.request_config_format) - | _ -> Pbrt.Decoder.malformed_variant "request_config_format" - -let rec decode_request_output_format d = - match Pbrt.Decoder.int_as_varint d with - | 0 -> (Vyconf_types.Out_plain:Vyconf_types.request_output_format) - | 1 -> (Vyconf_types.Out_json:Vyconf_types.request_output_format) - | _ -> Pbrt.Decoder.malformed_variant "request_output_format" - -let rec decode_request_setup_session d = - let v = default_request_setup_session_mutable () in - let continue__= ref true in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - ); continue__ := false - | Some (1, Pbrt.Bytes) -> begin - v.client_application <- Some (Pbrt.Decoder.string d); - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_setup_session), field(1)" pk - | Some (2, Pbrt.Varint) -> begin - v.on_behalf_of <- Some (Pbrt.Decoder.int32_as_varint d); - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_setup_session), field(2)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - ({ - Vyconf_types.client_application = v.client_application; - Vyconf_types.on_behalf_of = v.on_behalf_of; - } : Vyconf_types.request_setup_session) - -let rec decode_request_set d = - let v = default_request_set_mutable () in - let continue__= ref true in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - v.path <- List.rev v.path; - ); continue__ := false - | Some (1, Pbrt.Bytes) -> begin - v.path <- (Pbrt.Decoder.string d) :: v.path; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_set), field(1)" pk - | Some (3, Pbrt.Varint) -> begin - v.ephemeral <- Some (Pbrt.Decoder.bool d); - end - | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_set), field(3)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - ({ - Vyconf_types.path = v.path; - Vyconf_types.ephemeral = v.ephemeral; - } : Vyconf_types.request_set) - -let rec decode_request_delete d = - let v = default_request_delete_mutable () in - let continue__= ref true in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - v.path <- List.rev v.path; - ); continue__ := false - | Some (1, Pbrt.Bytes) -> begin - v.path <- (Pbrt.Decoder.string d) :: v.path; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_delete), field(1)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - ({ - Vyconf_types.path = v.path; - } : Vyconf_types.request_delete) - -let rec decode_request_rename d = - let v = default_request_rename_mutable () in - let continue__= ref true in - let to__is_set = ref false in - let from_is_set = ref false in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - v.edit_level <- List.rev v.edit_level; - ); continue__ := false - | Some (1, Pbrt.Bytes) -> begin - v.edit_level <- (Pbrt.Decoder.string d) :: v.edit_level; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_rename), field(1)" pk - | Some (2, Pbrt.Bytes) -> begin - v.from <- Pbrt.Decoder.string d; from_is_set := true; - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_rename), field(2)" pk - | Some (3, Pbrt.Bytes) -> begin - v.to_ <- Pbrt.Decoder.string d; to__is_set := true; - end - | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_rename), field(3)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - begin if not !to__is_set then Pbrt.Decoder.missing_field "to_" end; - begin if not !from_is_set then Pbrt.Decoder.missing_field "from" end; - ({ - Vyconf_types.edit_level = v.edit_level; - Vyconf_types.from = v.from; - Vyconf_types.to_ = v.to_; - } : Vyconf_types.request_rename) - -let rec decode_request_copy d = - let v = default_request_copy_mutable () in - let continue__= ref true in - let to__is_set = ref false in - let from_is_set = ref false in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - v.edit_level <- List.rev v.edit_level; - ); continue__ := false - | Some (1, Pbrt.Bytes) -> begin - v.edit_level <- (Pbrt.Decoder.string d) :: v.edit_level; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_copy), field(1)" pk - | Some (2, Pbrt.Bytes) -> begin - v.from <- Pbrt.Decoder.string d; from_is_set := true; - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_copy), field(2)" pk - | Some (3, Pbrt.Bytes) -> begin - v.to_ <- Pbrt.Decoder.string d; to__is_set := true; - end - | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_copy), field(3)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - begin if not !to__is_set then Pbrt.Decoder.missing_field "to_" end; - begin if not !from_is_set then Pbrt.Decoder.missing_field "from" end; - ({ - Vyconf_types.edit_level = v.edit_level; - Vyconf_types.from = v.from; - Vyconf_types.to_ = v.to_; - } : Vyconf_types.request_copy) - -let rec decode_request_comment d = - let v = default_request_comment_mutable () in - let continue__= ref true in - let comment_is_set = ref false in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - v.path <- List.rev v.path; - ); continue__ := false - | Some (1, Pbrt.Bytes) -> begin - v.path <- (Pbrt.Decoder.string d) :: v.path; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_comment), field(1)" pk - | Some (2, Pbrt.Bytes) -> begin - v.comment <- Pbrt.Decoder.string d; comment_is_set := true; - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_comment), field(2)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - begin if not !comment_is_set then Pbrt.Decoder.missing_field "comment" end; - ({ - Vyconf_types.path = v.path; - Vyconf_types.comment = v.comment; - } : Vyconf_types.request_comment) - -let rec decode_request_commit d = - let v = default_request_commit_mutable () in - let continue__= ref true in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - ); continue__ := false - | Some (1, Pbrt.Varint) -> begin - v.confirm <- Some (Pbrt.Decoder.bool d); - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_commit), field(1)" pk - | Some (2, Pbrt.Varint) -> begin - v.confirm_timeout <- Some (Pbrt.Decoder.int32_as_varint d); - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_commit), field(2)" pk - | Some (3, Pbrt.Bytes) -> begin - v.comment <- Some (Pbrt.Decoder.string d); - end - | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_commit), field(3)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - ({ - Vyconf_types.confirm = v.confirm; - Vyconf_types.confirm_timeout = v.confirm_timeout; - Vyconf_types.comment = v.comment; - } : Vyconf_types.request_commit) - -let rec decode_request_rollback d = - let v = default_request_rollback_mutable () in - let continue__= ref true in - let revision_is_set = ref false in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - ); continue__ := false - | Some (1, Pbrt.Varint) -> begin - v.revision <- Pbrt.Decoder.int32_as_varint d; revision_is_set := true; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_rollback), field(1)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - begin if not !revision_is_set then Pbrt.Decoder.missing_field "revision" end; - ({ - Vyconf_types.revision = v.revision; - } : Vyconf_types.request_rollback) - -let rec decode_request_load d = - let v = default_request_load_mutable () in - let continue__= ref true in - let location_is_set = ref false in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - ); continue__ := false - | Some (1, Pbrt.Bytes) -> begin - v.location <- Pbrt.Decoder.string d; location_is_set := true; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_load), field(1)" pk - | Some (2, Pbrt.Varint) -> begin - v.format <- Some (decode_request_config_format d); - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_load), field(2)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - begin if not !location_is_set then Pbrt.Decoder.missing_field "location" end; - ({ - Vyconf_types.location = v.location; - Vyconf_types.format = v.format; - } : Vyconf_types.request_load) - -let rec decode_request_merge d = - let v = default_request_merge_mutable () in - let continue__= ref true in - let location_is_set = ref false in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - ); continue__ := false - | Some (1, Pbrt.Bytes) -> begin - v.location <- Pbrt.Decoder.string d; location_is_set := true; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_merge), field(1)" pk - | Some (2, Pbrt.Varint) -> begin - v.format <- Some (decode_request_config_format d); - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_merge), field(2)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - begin if not !location_is_set then Pbrt.Decoder.missing_field "location" end; - ({ - Vyconf_types.location = v.location; - Vyconf_types.format = v.format; - } : Vyconf_types.request_merge) - -let rec decode_request_save d = - let v = default_request_save_mutable () in - let continue__= ref true in - let location_is_set = ref false in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - ); continue__ := false - | Some (1, Pbrt.Bytes) -> begin - v.location <- Pbrt.Decoder.string d; location_is_set := true; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_save), field(1)" pk - | Some (2, Pbrt.Varint) -> begin - v.format <- Some (decode_request_config_format d); - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_save), field(2)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - begin if not !location_is_set then Pbrt.Decoder.missing_field "location" end; - ({ - Vyconf_types.location = v.location; - Vyconf_types.format = v.format; - } : Vyconf_types.request_save) - -let rec decode_request_show_config d = - let v = default_request_show_config_mutable () in - let continue__= ref true in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - v.path <- List.rev v.path; - ); continue__ := false - | Some (1, Pbrt.Bytes) -> begin - v.path <- (Pbrt.Decoder.string d) :: v.path; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_show_config), field(1)" pk - | Some (2, Pbrt.Varint) -> begin - v.format <- Some (decode_request_config_format d); - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_show_config), field(2)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - ({ - Vyconf_types.path = v.path; - Vyconf_types.format = v.format; - } : Vyconf_types.request_show_config) - -let rec decode_request_exists d = - let v = default_request_exists_mutable () in - let continue__= ref true in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - v.path <- List.rev v.path; - ); continue__ := false - | Some (1, Pbrt.Bytes) -> begin - v.path <- (Pbrt.Decoder.string d) :: v.path; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_exists), field(1)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - ({ - Vyconf_types.path = v.path; - } : Vyconf_types.request_exists) - -let rec decode_request_get_value d = - let v = default_request_get_value_mutable () in - let continue__= ref true in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - v.path <- List.rev v.path; - ); continue__ := false - | Some (1, Pbrt.Bytes) -> begin - v.path <- (Pbrt.Decoder.string d) :: v.path; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_get_value), field(1)" pk - | Some (2, Pbrt.Varint) -> begin - v.output_format <- Some (decode_request_output_format d); - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_get_value), field(2)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - ({ - Vyconf_types.path = v.path; - Vyconf_types.output_format = v.output_format; - } : Vyconf_types.request_get_value) - -let rec decode_request_get_values d = - let v = default_request_get_values_mutable () in - let continue__= ref true in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - v.path <- List.rev v.path; - ); continue__ := false - | Some (1, Pbrt.Bytes) -> begin - v.path <- (Pbrt.Decoder.string d) :: v.path; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_get_values), field(1)" pk - | Some (2, Pbrt.Varint) -> begin - v.output_format <- Some (decode_request_output_format d); - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_get_values), field(2)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - ({ - Vyconf_types.path = v.path; - Vyconf_types.output_format = v.output_format; - } : Vyconf_types.request_get_values) - -let rec decode_request_list_children d = - let v = default_request_list_children_mutable () in - let continue__= ref true in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - v.path <- List.rev v.path; - ); continue__ := false - | Some (1, Pbrt.Bytes) -> begin - v.path <- (Pbrt.Decoder.string d) :: v.path; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_list_children), field(1)" pk - | Some (2, Pbrt.Varint) -> begin - v.output_format <- Some (decode_request_output_format d); - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_list_children), field(2)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - ({ - Vyconf_types.path = v.path; - Vyconf_types.output_format = v.output_format; - } : Vyconf_types.request_list_children) - -let rec decode_request_run_op_mode d = - let v = default_request_run_op_mode_mutable () in - let continue__= ref true in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - v.path <- List.rev v.path; - ); continue__ := false - | Some (1, Pbrt.Bytes) -> begin - v.path <- (Pbrt.Decoder.string d) :: v.path; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_run_op_mode), field(1)" pk - | Some (2, Pbrt.Varint) -> begin - v.output_format <- Some (decode_request_output_format d); - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_run_op_mode), field(2)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - ({ - Vyconf_types.path = v.path; - Vyconf_types.output_format = v.output_format; - } : Vyconf_types.request_run_op_mode) - -let rec decode_request_enter_configuration_mode d = - let v = default_request_enter_configuration_mode_mutable () in - let continue__= ref true in - let override_exclusive_is_set = ref false in - let exclusive_is_set = ref false in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - ); continue__ := false - | Some (1, Pbrt.Varint) -> begin - v.exclusive <- Pbrt.Decoder.bool d; exclusive_is_set := true; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_enter_configuration_mode), field(1)" pk - | Some (2, Pbrt.Varint) -> begin - v.override_exclusive <- Pbrt.Decoder.bool d; override_exclusive_is_set := true; - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_enter_configuration_mode), field(2)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - begin if not !override_exclusive_is_set then Pbrt.Decoder.missing_field "override_exclusive" end; - begin if not !exclusive_is_set then Pbrt.Decoder.missing_field "exclusive" end; - ({ - Vyconf_types.exclusive = v.exclusive; - Vyconf_types.override_exclusive = v.override_exclusive; - } : Vyconf_types.request_enter_configuration_mode) - -let rec decode_request d = - let rec loop () = - let ret:Vyconf_types.request = match Pbrt.Decoder.key d with - | None -> Pbrt.Decoder.malformed_variant "request" - | Some (1, _) -> (Pbrt.Decoder.empty_nested d ; Vyconf_types.Status) - | Some (2, _) -> Vyconf_types.Setup_session (decode_request_setup_session (Pbrt.Decoder.nested d)) - | Some (3, _) -> Vyconf_types.Set (decode_request_set (Pbrt.Decoder.nested d)) - | Some (4, _) -> Vyconf_types.Delete (decode_request_delete (Pbrt.Decoder.nested d)) - | Some (5, _) -> Vyconf_types.Rename (decode_request_rename (Pbrt.Decoder.nested d)) - | Some (6, _) -> Vyconf_types.Copy (decode_request_copy (Pbrt.Decoder.nested d)) - | Some (7, _) -> Vyconf_types.Comment (decode_request_comment (Pbrt.Decoder.nested d)) - | Some (8, _) -> Vyconf_types.Commit (decode_request_commit (Pbrt.Decoder.nested d)) - | Some (9, _) -> Vyconf_types.Rollback (decode_request_rollback (Pbrt.Decoder.nested d)) - | Some (10, _) -> Vyconf_types.Merge (decode_request_merge (Pbrt.Decoder.nested d)) - | Some (11, _) -> Vyconf_types.Save (decode_request_save (Pbrt.Decoder.nested d)) - | Some (12, _) -> Vyconf_types.Show_config (decode_request_show_config (Pbrt.Decoder.nested d)) - | Some (13, _) -> Vyconf_types.Exists (decode_request_exists (Pbrt.Decoder.nested d)) - | Some (14, _) -> Vyconf_types.Get_value (decode_request_get_value (Pbrt.Decoder.nested d)) - | Some (15, _) -> Vyconf_types.Get_values (decode_request_get_values (Pbrt.Decoder.nested d)) - | Some (16, _) -> Vyconf_types.List_children (decode_request_list_children (Pbrt.Decoder.nested d)) - | Some (17, _) -> Vyconf_types.Run_op_mode (decode_request_run_op_mode (Pbrt.Decoder.nested d)) - | Some (18, _) -> (Pbrt.Decoder.empty_nested d ; Vyconf_types.Confirm) - | Some (19, _) -> Vyconf_types.Configure (decode_request_enter_configuration_mode (Pbrt.Decoder.nested d)) - | Some (20, _) -> (Pbrt.Decoder.empty_nested d ; Vyconf_types.Exit_configure) - | Some (21, _) -> Vyconf_types.Teardown (Pbrt.Decoder.string d) - | Some (n, payload_kind) -> ( - Pbrt.Decoder.skip d payload_kind; - loop () - ) - in - ret - in - loop () - -let rec decode_request_envelope d = - let v = default_request_envelope_mutable () in - let continue__= ref true in - let request_is_set = ref false in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - ); continue__ := false - | Some (1, Pbrt.Bytes) -> begin - v.token <- Some (Pbrt.Decoder.string d); - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_envelope), field(1)" pk - | Some (2, Pbrt.Bytes) -> begin - v.request <- decode_request (Pbrt.Decoder.nested d); request_is_set := true; - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(request_envelope), field(2)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - begin if not !request_is_set then Pbrt.Decoder.missing_field "request" end; - ({ - Vyconf_types.token = v.token; - Vyconf_types.request = v.request; - } : Vyconf_types.request_envelope) - -let rec decode_status d = - match Pbrt.Decoder.int_as_varint d with - | 0 -> (Vyconf_types.Success:Vyconf_types.status) - | 1 -> (Vyconf_types.Fail:Vyconf_types.status) - | 2 -> (Vyconf_types.Invalid_path:Vyconf_types.status) - | 3 -> (Vyconf_types.Invalid_value:Vyconf_types.status) - | 4 -> (Vyconf_types.Commit_in_progress:Vyconf_types.status) - | 5 -> (Vyconf_types.Configuration_locked:Vyconf_types.status) - | 6 -> (Vyconf_types.Internal_error:Vyconf_types.status) - | 7 -> (Vyconf_types.Permission_denied:Vyconf_types.status) - | 8 -> (Vyconf_types.Path_already_exists:Vyconf_types.status) - | _ -> Pbrt.Decoder.malformed_variant "status" - -let rec decode_response d = - let v = default_response_mutable () in - let continue__= ref true in - let status_is_set = ref false in - while !continue__ do - match Pbrt.Decoder.key d with - | None -> ( - ); continue__ := false - | Some (1, Pbrt.Varint) -> begin - v.status <- decode_status d; status_is_set := true; - end - | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(response), field(1)" pk - | Some (2, Pbrt.Bytes) -> begin - v.output <- Some (Pbrt.Decoder.string d); - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(response), field(2)" pk - | Some (3, Pbrt.Bytes) -> begin - v.error <- Some (Pbrt.Decoder.string d); - end - | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(response), field(3)" pk - | Some (4, Pbrt.Bytes) -> begin - v.warning <- Some (Pbrt.Decoder.string d); - end - | Some (4, pk) -> - Pbrt.Decoder.unexpected_payload "Message(response), field(4)" pk - | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind - done; - begin if not !status_is_set then Pbrt.Decoder.missing_field "status" end; - ({ - Vyconf_types.status = v.status; - Vyconf_types.output = v.output; - Vyconf_types.error = v.error; - Vyconf_types.warning = v.warning; - } : Vyconf_types.response) - -let rec encode_request_config_format (v:Vyconf_types.request_config_format) encoder = - match v with - | Vyconf_types.Curly -> Pbrt.Encoder.int_as_varint (0) encoder - | Vyconf_types.Json -> Pbrt.Encoder.int_as_varint 1 encoder - -let rec encode_request_output_format (v:Vyconf_types.request_output_format) encoder = - match v with - | Vyconf_types.Out_plain -> Pbrt.Encoder.int_as_varint (0) encoder - | Vyconf_types.Out_json -> Pbrt.Encoder.int_as_varint 1 encoder - -let rec encode_request_setup_session (v:Vyconf_types.request_setup_session) encoder = - begin match v.Vyconf_types.client_application with - | Some x -> - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - | None -> (); - end; - begin match v.Vyconf_types.on_behalf_of with - | Some x -> - Pbrt.Encoder.key (2, Pbrt.Varint) encoder; - Pbrt.Encoder.int32_as_varint x encoder; - | None -> (); - end; - () - -let rec encode_request_set (v:Vyconf_types.request_set) encoder = - List.iter (fun x -> - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - ) v.Vyconf_types.path; - begin match v.Vyconf_types.ephemeral with - | Some x -> - Pbrt.Encoder.key (3, Pbrt.Varint) encoder; - Pbrt.Encoder.bool x encoder; - | None -> (); - end; - () - -let rec encode_request_delete (v:Vyconf_types.request_delete) encoder = - List.iter (fun x -> - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - ) v.Vyconf_types.path; - () - -let rec encode_request_rename (v:Vyconf_types.request_rename) encoder = - List.iter (fun x -> - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - ) v.Vyconf_types.edit_level; - Pbrt.Encoder.key (2, Pbrt.Bytes) encoder; - Pbrt.Encoder.string v.Vyconf_types.from encoder; - Pbrt.Encoder.key (3, Pbrt.Bytes) encoder; - Pbrt.Encoder.string v.Vyconf_types.to_ encoder; - () - -let rec encode_request_copy (v:Vyconf_types.request_copy) encoder = - List.iter (fun x -> - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - ) v.Vyconf_types.edit_level; - Pbrt.Encoder.key (2, Pbrt.Bytes) encoder; - Pbrt.Encoder.string v.Vyconf_types.from encoder; - Pbrt.Encoder.key (3, Pbrt.Bytes) encoder; - Pbrt.Encoder.string v.Vyconf_types.to_ encoder; - () - -let rec encode_request_comment (v:Vyconf_types.request_comment) encoder = - List.iter (fun x -> - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - ) v.Vyconf_types.path; - Pbrt.Encoder.key (2, Pbrt.Bytes) encoder; - Pbrt.Encoder.string v.Vyconf_types.comment encoder; - () - -let rec encode_request_commit (v:Vyconf_types.request_commit) encoder = - begin match v.Vyconf_types.confirm with - | Some x -> - Pbrt.Encoder.key (1, Pbrt.Varint) encoder; - Pbrt.Encoder.bool x encoder; - | None -> (); - end; - begin match v.Vyconf_types.confirm_timeout with - | Some x -> - Pbrt.Encoder.key (2, Pbrt.Varint) encoder; - Pbrt.Encoder.int32_as_varint x encoder; - | None -> (); - end; - begin match v.Vyconf_types.comment with - | Some x -> - Pbrt.Encoder.key (3, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - | None -> (); - end; - () - -let rec encode_request_rollback (v:Vyconf_types.request_rollback) encoder = - Pbrt.Encoder.key (1, Pbrt.Varint) encoder; - Pbrt.Encoder.int32_as_varint v.Vyconf_types.revision encoder; - () - -let rec encode_request_load (v:Vyconf_types.request_load) encoder = - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.string v.Vyconf_types.location encoder; - begin match v.Vyconf_types.format with - | Some x -> - Pbrt.Encoder.key (2, Pbrt.Varint) encoder; - encode_request_config_format x encoder; - | None -> (); - end; - () - -let rec encode_request_merge (v:Vyconf_types.request_merge) encoder = - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.string v.Vyconf_types.location encoder; - begin match v.Vyconf_types.format with - | Some x -> - Pbrt.Encoder.key (2, Pbrt.Varint) encoder; - encode_request_config_format x encoder; - | None -> (); - end; - () - -let rec encode_request_save (v:Vyconf_types.request_save) encoder = - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.string v.Vyconf_types.location encoder; - begin match v.Vyconf_types.format with - | Some x -> - Pbrt.Encoder.key (2, Pbrt.Varint) encoder; - encode_request_config_format x encoder; - | None -> (); - end; - () - -let rec encode_request_show_config (v:Vyconf_types.request_show_config) encoder = - List.iter (fun x -> - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - ) v.Vyconf_types.path; - begin match v.Vyconf_types.format with - | Some x -> - Pbrt.Encoder.key (2, Pbrt.Varint) encoder; - encode_request_config_format x encoder; - | None -> (); - end; - () - -let rec encode_request_exists (v:Vyconf_types.request_exists) encoder = - List.iter (fun x -> - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - ) v.Vyconf_types.path; - () - -let rec encode_request_get_value (v:Vyconf_types.request_get_value) encoder = - List.iter (fun x -> - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - ) v.Vyconf_types.path; - begin match v.Vyconf_types.output_format with - | Some x -> - Pbrt.Encoder.key (2, Pbrt.Varint) encoder; - encode_request_output_format x encoder; - | None -> (); - end; - () - -let rec encode_request_get_values (v:Vyconf_types.request_get_values) encoder = - List.iter (fun x -> - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - ) v.Vyconf_types.path; - begin match v.Vyconf_types.output_format with - | Some x -> - Pbrt.Encoder.key (2, Pbrt.Varint) encoder; - encode_request_output_format x encoder; - | None -> (); - end; - () - -let rec encode_request_list_children (v:Vyconf_types.request_list_children) encoder = - List.iter (fun x -> - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - ) v.Vyconf_types.path; - begin match v.Vyconf_types.output_format with - | Some x -> - Pbrt.Encoder.key (2, Pbrt.Varint) encoder; - encode_request_output_format x encoder; - | None -> (); - end; - () - -let rec encode_request_run_op_mode (v:Vyconf_types.request_run_op_mode) encoder = - List.iter (fun x -> - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - ) v.Vyconf_types.path; - begin match v.Vyconf_types.output_format with - | Some x -> - Pbrt.Encoder.key (2, Pbrt.Varint) encoder; - encode_request_output_format x encoder; - | None -> (); - end; - () - -let rec encode_request_enter_configuration_mode (v:Vyconf_types.request_enter_configuration_mode) encoder = - Pbrt.Encoder.key (1, Pbrt.Varint) encoder; - Pbrt.Encoder.bool v.Vyconf_types.exclusive encoder; - Pbrt.Encoder.key (2, Pbrt.Varint) encoder; - Pbrt.Encoder.bool v.Vyconf_types.override_exclusive encoder; - () - -let rec encode_request (v:Vyconf_types.request) encoder = - begin match v with - | Vyconf_types.Status -> - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.empty_nested encoder - | Vyconf_types.Setup_session x -> - Pbrt.Encoder.key (2, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_setup_session x) encoder; - | Vyconf_types.Set x -> - Pbrt.Encoder.key (3, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_set x) encoder; - | Vyconf_types.Delete x -> - Pbrt.Encoder.key (4, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_delete x) encoder; - | Vyconf_types.Rename x -> - Pbrt.Encoder.key (5, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_rename x) encoder; - | Vyconf_types.Copy x -> - Pbrt.Encoder.key (6, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_copy x) encoder; - | Vyconf_types.Comment x -> - Pbrt.Encoder.key (7, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_comment x) encoder; - | Vyconf_types.Commit x -> - Pbrt.Encoder.key (8, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_commit x) encoder; - | Vyconf_types.Rollback x -> - Pbrt.Encoder.key (9, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_rollback x) encoder; - | Vyconf_types.Merge x -> - Pbrt.Encoder.key (10, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_merge x) encoder; - | Vyconf_types.Save x -> - Pbrt.Encoder.key (11, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_save x) encoder; - | Vyconf_types.Show_config x -> - Pbrt.Encoder.key (12, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_show_config x) encoder; - | Vyconf_types.Exists x -> - Pbrt.Encoder.key (13, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_exists x) encoder; - | Vyconf_types.Get_value x -> - Pbrt.Encoder.key (14, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_get_value x) encoder; - | Vyconf_types.Get_values x -> - Pbrt.Encoder.key (15, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_get_values x) encoder; - | Vyconf_types.List_children x -> - Pbrt.Encoder.key (16, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_list_children x) encoder; - | Vyconf_types.Run_op_mode x -> - Pbrt.Encoder.key (17, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_run_op_mode x) encoder; - | Vyconf_types.Confirm -> - Pbrt.Encoder.key (18, Pbrt.Bytes) encoder; - Pbrt.Encoder.empty_nested encoder - | Vyconf_types.Configure x -> - Pbrt.Encoder.key (19, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request_enter_configuration_mode x) encoder; - | Vyconf_types.Exit_configure -> - Pbrt.Encoder.key (20, Pbrt.Bytes) encoder; - Pbrt.Encoder.empty_nested encoder - | Vyconf_types.Teardown x -> - Pbrt.Encoder.key (21, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - end - -let rec encode_request_envelope (v:Vyconf_types.request_envelope) encoder = - begin match v.Vyconf_types.token with - | Some x -> - Pbrt.Encoder.key (1, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - | None -> (); - end; - Pbrt.Encoder.key (2, Pbrt.Bytes) encoder; - Pbrt.Encoder.nested (encode_request v.Vyconf_types.request) encoder; - () - -let rec encode_status (v:Vyconf_types.status) encoder = - match v with - | Vyconf_types.Success -> Pbrt.Encoder.int_as_varint (0) encoder - | Vyconf_types.Fail -> Pbrt.Encoder.int_as_varint 1 encoder - | Vyconf_types.Invalid_path -> Pbrt.Encoder.int_as_varint 2 encoder - | Vyconf_types.Invalid_value -> Pbrt.Encoder.int_as_varint 3 encoder - | Vyconf_types.Commit_in_progress -> Pbrt.Encoder.int_as_varint 4 encoder - | Vyconf_types.Configuration_locked -> Pbrt.Encoder.int_as_varint 5 encoder - | Vyconf_types.Internal_error -> Pbrt.Encoder.int_as_varint 6 encoder - | Vyconf_types.Permission_denied -> Pbrt.Encoder.int_as_varint 7 encoder - | Vyconf_types.Path_already_exists -> Pbrt.Encoder.int_as_varint 8 encoder - -let rec encode_response (v:Vyconf_types.response) encoder = - Pbrt.Encoder.key (1, Pbrt.Varint) encoder; - encode_status v.Vyconf_types.status encoder; - begin match v.Vyconf_types.output with - | Some x -> - Pbrt.Encoder.key (2, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - | None -> (); - end; - begin match v.Vyconf_types.error with - | Some x -> - Pbrt.Encoder.key (3, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - | None -> (); - end; - begin match v.Vyconf_types.warning with - | Some x -> - Pbrt.Encoder.key (4, Pbrt.Bytes) encoder; - Pbrt.Encoder.string x encoder; - | None -> (); - end; - () diff --git a/src/vyconf_pb.mli b/src/vyconf_pb.mli deleted file mode 100644 index 8a1249c..0000000 --- a/src/vyconf_pb.mli +++ /dev/null @@ -1,151 +0,0 @@ -(** vyconf.proto Binary Encoding *) - - -(** {2 Protobuf Encoding} *) - -val encode_request_config_format : Vyconf_types.request_config_format -> Pbrt.Encoder.t -> unit -(** [encode_request_config_format v encoder] encodes [v] with the given [encoder] *) - -val encode_request_output_format : Vyconf_types.request_output_format -> Pbrt.Encoder.t -> unit -(** [encode_request_output_format v encoder] encodes [v] with the given [encoder] *) - -val encode_request_setup_session : Vyconf_types.request_setup_session -> Pbrt.Encoder.t -> unit -(** [encode_request_setup_session v encoder] encodes [v] with the given [encoder] *) - -val encode_request_set : Vyconf_types.request_set -> Pbrt.Encoder.t -> unit -(** [encode_request_set v encoder] encodes [v] with the given [encoder] *) - -val encode_request_delete : Vyconf_types.request_delete -> Pbrt.Encoder.t -> unit -(** [encode_request_delete v encoder] encodes [v] with the given [encoder] *) - -val encode_request_rename : Vyconf_types.request_rename -> Pbrt.Encoder.t -> unit -(** [encode_request_rename v encoder] encodes [v] with the given [encoder] *) - -val encode_request_copy : Vyconf_types.request_copy -> Pbrt.Encoder.t -> unit -(** [encode_request_copy v encoder] encodes [v] with the given [encoder] *) - -val encode_request_comment : Vyconf_types.request_comment -> Pbrt.Encoder.t -> unit -(** [encode_request_comment v encoder] encodes [v] with the given [encoder] *) - -val encode_request_commit : Vyconf_types.request_commit -> Pbrt.Encoder.t -> unit -(** [encode_request_commit v encoder] encodes [v] with the given [encoder] *) - -val encode_request_rollback : Vyconf_types.request_rollback -> Pbrt.Encoder.t -> unit -(** [encode_request_rollback v encoder] encodes [v] with the given [encoder] *) - -val encode_request_load : Vyconf_types.request_load -> Pbrt.Encoder.t -> unit -(** [encode_request_load v encoder] encodes [v] with the given [encoder] *) - -val encode_request_merge : Vyconf_types.request_merge -> Pbrt.Encoder.t -> unit -(** [encode_request_merge v encoder] encodes [v] with the given [encoder] *) - -val encode_request_save : Vyconf_types.request_save -> Pbrt.Encoder.t -> unit -(** [encode_request_save v encoder] encodes [v] with the given [encoder] *) - -val encode_request_show_config : Vyconf_types.request_show_config -> Pbrt.Encoder.t -> unit -(** [encode_request_show_config v encoder] encodes [v] with the given [encoder] *) - -val encode_request_exists : Vyconf_types.request_exists -> Pbrt.Encoder.t -> unit -(** [encode_request_exists v encoder] encodes [v] with the given [encoder] *) - -val encode_request_get_value : Vyconf_types.request_get_value -> Pbrt.Encoder.t -> unit -(** [encode_request_get_value v encoder] encodes [v] with the given [encoder] *) - -val encode_request_get_values : Vyconf_types.request_get_values -> Pbrt.Encoder.t -> unit -(** [encode_request_get_values v encoder] encodes [v] with the given [encoder] *) - -val encode_request_list_children : Vyconf_types.request_list_children -> Pbrt.Encoder.t -> unit -(** [encode_request_list_children v encoder] encodes [v] with the given [encoder] *) - -val encode_request_run_op_mode : Vyconf_types.request_run_op_mode -> Pbrt.Encoder.t -> unit -(** [encode_request_run_op_mode v encoder] encodes [v] with the given [encoder] *) - -val encode_request_enter_configuration_mode : Vyconf_types.request_enter_configuration_mode -> Pbrt.Encoder.t -> unit -(** [encode_request_enter_configuration_mode v encoder] encodes [v] with the given [encoder] *) - -val encode_request : Vyconf_types.request -> Pbrt.Encoder.t -> unit -(** [encode_request v encoder] encodes [v] with the given [encoder] *) - -val encode_request_envelope : Vyconf_types.request_envelope -> Pbrt.Encoder.t -> unit -(** [encode_request_envelope v encoder] encodes [v] with the given [encoder] *) - -val encode_status : Vyconf_types.status -> Pbrt.Encoder.t -> unit -(** [encode_status v encoder] encodes [v] with the given [encoder] *) - -val encode_response : Vyconf_types.response -> Pbrt.Encoder.t -> unit -(** [encode_response v encoder] encodes [v] with the given [encoder] *) - - -(** {2 Protobuf Decoding} *) - -val decode_request_config_format : Pbrt.Decoder.t -> Vyconf_types.request_config_format -(** [decode_request_config_format decoder] decodes a [request_config_format] value from [decoder] *) - -val decode_request_output_format : Pbrt.Decoder.t -> Vyconf_types.request_output_format -(** [decode_request_output_format decoder] decodes a [request_output_format] value from [decoder] *) - -val decode_request_setup_session : Pbrt.Decoder.t -> Vyconf_types.request_setup_session -(** [decode_request_setup_session decoder] decodes a [request_setup_session] value from [decoder] *) - -val decode_request_set : Pbrt.Decoder.t -> Vyconf_types.request_set -(** [decode_request_set decoder] decodes a [request_set] value from [decoder] *) - -val decode_request_delete : Pbrt.Decoder.t -> Vyconf_types.request_delete -(** [decode_request_delete decoder] decodes a [request_delete] value from [decoder] *) - -val decode_request_rename : Pbrt.Decoder.t -> Vyconf_types.request_rename -(** [decode_request_rename decoder] decodes a [request_rename] value from [decoder] *) - -val decode_request_copy : Pbrt.Decoder.t -> Vyconf_types.request_copy -(** [decode_request_copy decoder] decodes a [request_copy] value from [decoder] *) - -val decode_request_comment : Pbrt.Decoder.t -> Vyconf_types.request_comment -(** [decode_request_comment decoder] decodes a [request_comment] value from [decoder] *) - -val decode_request_commit : Pbrt.Decoder.t -> Vyconf_types.request_commit -(** [decode_request_commit decoder] decodes a [request_commit] value from [decoder] *) - -val decode_request_rollback : Pbrt.Decoder.t -> Vyconf_types.request_rollback -(** [decode_request_rollback decoder] decodes a [request_rollback] value from [decoder] *) - -val decode_request_load : Pbrt.Decoder.t -> Vyconf_types.request_load -(** [decode_request_load decoder] decodes a [request_load] value from [decoder] *) - -val decode_request_merge : Pbrt.Decoder.t -> Vyconf_types.request_merge -(** [decode_request_merge decoder] decodes a [request_merge] value from [decoder] *) - -val decode_request_save : Pbrt.Decoder.t -> Vyconf_types.request_save -(** [decode_request_save decoder] decodes a [request_save] value from [decoder] *) - -val decode_request_show_config : Pbrt.Decoder.t -> Vyconf_types.request_show_config -(** [decode_request_show_config decoder] decodes a [request_show_config] value from [decoder] *) - -val decode_request_exists : Pbrt.Decoder.t -> Vyconf_types.request_exists -(** [decode_request_exists decoder] decodes a [request_exists] value from [decoder] *) - -val decode_request_get_value : Pbrt.Decoder.t -> Vyconf_types.request_get_value -(** [decode_request_get_value decoder] decodes a [request_get_value] value from [decoder] *) - -val decode_request_get_values : Pbrt.Decoder.t -> Vyconf_types.request_get_values -(** [decode_request_get_values decoder] decodes a [request_get_values] value from [decoder] *) - -val decode_request_list_children : Pbrt.Decoder.t -> Vyconf_types.request_list_children -(** [decode_request_list_children decoder] decodes a [request_list_children] value from [decoder] *) - -val decode_request_run_op_mode : Pbrt.Decoder.t -> Vyconf_types.request_run_op_mode -(** [decode_request_run_op_mode decoder] decodes a [request_run_op_mode] value from [decoder] *) - -val decode_request_enter_configuration_mode : Pbrt.Decoder.t -> Vyconf_types.request_enter_configuration_mode -(** [decode_request_enter_configuration_mode decoder] decodes a [request_enter_configuration_mode] value from [decoder] *) - -val decode_request : Pbrt.Decoder.t -> Vyconf_types.request -(** [decode_request decoder] decodes a [request] value from [decoder] *) - -val decode_request_envelope : Pbrt.Decoder.t -> Vyconf_types.request_envelope -(** [decode_request_envelope decoder] decodes a [request_envelope] value from [decoder] *) - -val decode_status : Pbrt.Decoder.t -> Vyconf_types.status -(** [decode_status decoder] decodes a [status] value from [decoder] *) - -val decode_response : Pbrt.Decoder.t -> Vyconf_types.response -(** [decode_response decoder] decodes a [response] value from [decoder] *) diff --git a/src/vyconf_pbt.ml b/src/vyconf_pbt.ml new file mode 100644 index 0000000..4c7fcc6 --- /dev/null +++ b/src/vyconf_pbt.ml @@ -0,0 +1,1827 @@ +[@@@ocaml.warning "-27-30-39-44"] + +type request_config_format = + | Curly + | Json + +type request_output_format = + | Out_plain + | Out_json + +type request_status = unit + +type request_setup_session = { + client_application : string option; + on_behalf_of : int32 option; +} + +type request_teardown = { + on_behalf_of : int32 option; +} + +type request_validate = { + path : string list; + output_format : request_output_format option; +} + +type request_set = { + path : string list; + ephemeral : bool option; +} + +type request_delete = { + path : string list; +} + +type request_rename = { + edit_level : string list; + from : string; + to_ : string; +} + +type request_copy = { + edit_level : string list; + from : string; + to_ : string; +} + +type request_comment = { + path : string list; + comment : string; +} + +type request_commit = { + confirm : bool option; + confirm_timeout : int32 option; + comment : string option; +} + +type request_rollback = { + revision : int32; +} + +type request_load = { + location : string; + format : request_config_format option; +} + +type request_merge = { + location : string; + format : request_config_format option; +} + +type request_save = { + location : string; + format : request_config_format option; +} + +type request_show_config = { + path : string list; + format : request_config_format option; +} + +type request_exists = { + path : string list; +} + +type request_get_value = { + path : string list; + output_format : request_output_format option; +} + +type request_get_values = { + path : string list; + output_format : request_output_format option; +} + +type request_list_children = { + path : string list; + output_format : request_output_format option; +} + +type request_run_op_mode = { + path : string list; + output_format : request_output_format option; +} + +type request_confirm = unit + +type request_enter_configuration_mode = { + exclusive : bool; + override_exclusive : bool; +} + +type request_exit_configuration_mode = unit + +type request = + | Status + | Setup_session of request_setup_session + | Set of request_set + | Delete of request_delete + | Rename of request_rename + | Copy of request_copy + | Comment of request_comment + | Commit of request_commit + | Rollback of request_rollback + | Merge of request_merge + | Save of request_save + | Show_config of request_show_config + | Exists of request_exists + | Get_value of request_get_value + | Get_values of request_get_values + | List_children of request_list_children + | Run_op_mode of request_run_op_mode + | Confirm + | Configure of request_enter_configuration_mode + | Exit_configure + | Validate of request_validate + | Teardown of request_teardown + +type request_envelope = { + token : string option; + request : request; +} + +type status = + | Success + | Fail + | Invalid_path + | Invalid_value + | Commit_in_progress + | Configuration_locked + | Internal_error + | Permission_denied + | Path_already_exists + +type response = { + status : status; + output : string option; + error : string option; + warning : string option; +} + +let rec default_request_config_format () = (Curly:request_config_format) + +let rec default_request_output_format () = (Out_plain:request_output_format) + +let rec default_request_status = () + +let rec default_request_setup_session + ?client_application:((client_application:string option) = None) + ?on_behalf_of:((on_behalf_of:int32 option) = None) + () : request_setup_session = { + client_application; + on_behalf_of; +} + +let rec default_request_teardown + ?on_behalf_of:((on_behalf_of:int32 option) = None) + () : request_teardown = { + on_behalf_of; +} + +let rec default_request_validate + ?path:((path:string list) = []) + ?output_format:((output_format:request_output_format option) = None) + () : request_validate = { + path; + output_format; +} + +let rec default_request_set + ?path:((path:string list) = []) + ?ephemeral:((ephemeral:bool option) = None) + () : request_set = { + path; + ephemeral; +} + +let rec default_request_delete + ?path:((path:string list) = []) + () : request_delete = { + path; +} + +let rec default_request_rename + ?edit_level:((edit_level:string list) = []) + ?from:((from:string) = "") + ?to_:((to_:string) = "") + () : request_rename = { + edit_level; + from; + to_; +} + +let rec default_request_copy + ?edit_level:((edit_level:string list) = []) + ?from:((from:string) = "") + ?to_:((to_:string) = "") + () : request_copy = { + edit_level; + from; + to_; +} + +let rec default_request_comment + ?path:((path:string list) = []) + ?comment:((comment:string) = "") + () : request_comment = { + path; + comment; +} + +let rec default_request_commit + ?confirm:((confirm:bool option) = None) + ?confirm_timeout:((confirm_timeout:int32 option) = None) + ?comment:((comment:string option) = None) + () : request_commit = { + confirm; + confirm_timeout; + comment; +} + +let rec default_request_rollback + ?revision:((revision:int32) = 0l) + () : request_rollback = { + revision; +} + +let rec default_request_load + ?location:((location:string) = "") + ?format:((format:request_config_format option) = None) + () : request_load = { + location; + format; +} + +let rec default_request_merge + ?location:((location:string) = "") + ?format:((format:request_config_format option) = None) + () : request_merge = { + location; + format; +} + +let rec default_request_save + ?location:((location:string) = "") + ?format:((format:request_config_format option) = None) + () : request_save = { + location; + format; +} + +let rec default_request_show_config + ?path:((path:string list) = []) + ?format:((format:request_config_format option) = None) + () : request_show_config = { + path; + format; +} + +let rec default_request_exists + ?path:((path:string list) = []) + () : request_exists = { + path; +} + +let rec default_request_get_value + ?path:((path:string list) = []) + ?output_format:((output_format:request_output_format option) = None) + () : request_get_value = { + path; + output_format; +} + +let rec default_request_get_values + ?path:((path:string list) = []) + ?output_format:((output_format:request_output_format option) = None) + () : request_get_values = { + path; + output_format; +} + +let rec default_request_list_children + ?path:((path:string list) = []) + ?output_format:((output_format:request_output_format option) = None) + () : request_list_children = { + path; + output_format; +} + +let rec default_request_run_op_mode + ?path:((path:string list) = []) + ?output_format:((output_format:request_output_format option) = None) + () : request_run_op_mode = { + path; + output_format; +} + +let rec default_request_confirm = () + +let rec default_request_enter_configuration_mode + ?exclusive:((exclusive:bool) = false) + ?override_exclusive:((override_exclusive:bool) = false) + () : request_enter_configuration_mode = { + exclusive; + override_exclusive; +} + +let rec default_request_exit_configuration_mode = () + +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; +} + +let rec default_status () = (Success:status) + +let rec default_response + ?status:((status:status) = default_status ()) + ?output:((output:string option) = None) + ?error:((error:string option) = None) + ?warning:((warning:string option) = None) + () : response = { + status; + output; + error; + warning; +} + +type request_setup_session_mutable = { + mutable client_application : string option; + mutable on_behalf_of : int32 option; +} + +let default_request_setup_session_mutable () : request_setup_session_mutable = { + client_application = None; + on_behalf_of = None; +} + +type request_teardown_mutable = { + mutable on_behalf_of : int32 option; +} + +let default_request_teardown_mutable () : request_teardown_mutable = { + on_behalf_of = None; +} + +type request_validate_mutable = { + mutable path : string list; + mutable output_format : request_output_format option; +} + +let default_request_validate_mutable () : request_validate_mutable = { + path = []; + output_format = None; +} + +type request_set_mutable = { + mutable path : string list; + mutable ephemeral : bool option; +} + +let default_request_set_mutable () : request_set_mutable = { + path = []; + ephemeral = None; +} + +type request_delete_mutable = { + mutable path : string list; +} + +let default_request_delete_mutable () : request_delete_mutable = { + path = []; +} + +type request_rename_mutable = { + mutable edit_level : string list; + mutable from : string; + mutable to_ : string; +} + +let default_request_rename_mutable () : request_rename_mutable = { + edit_level = []; + from = ""; + to_ = ""; +} + +type request_copy_mutable = { + mutable edit_level : string list; + mutable from : string; + mutable to_ : string; +} + +let default_request_copy_mutable () : request_copy_mutable = { + edit_level = []; + from = ""; + to_ = ""; +} + +type request_comment_mutable = { + mutable path : string list; + mutable comment : string; +} + +let default_request_comment_mutable () : request_comment_mutable = { + path = []; + comment = ""; +} + +type request_commit_mutable = { + mutable confirm : bool option; + mutable confirm_timeout : int32 option; + mutable comment : string option; +} + +let default_request_commit_mutable () : request_commit_mutable = { + confirm = None; + confirm_timeout = None; + comment = None; +} + +type request_rollback_mutable = { + mutable revision : int32; +} + +let default_request_rollback_mutable () : request_rollback_mutable = { + revision = 0l; +} + +type request_load_mutable = { + mutable location : string; + mutable format : request_config_format option; +} + +let default_request_load_mutable () : request_load_mutable = { + location = ""; + format = None; +} + +type request_merge_mutable = { + mutable location : string; + mutable format : request_config_format option; +} + +let default_request_merge_mutable () : request_merge_mutable = { + location = ""; + format = None; +} + +type request_save_mutable = { + mutable location : string; + mutable format : request_config_format option; +} + +let default_request_save_mutable () : request_save_mutable = { + location = ""; + format = None; +} + +type request_show_config_mutable = { + mutable path : string list; + mutable format : request_config_format option; +} + +let default_request_show_config_mutable () : request_show_config_mutable = { + path = []; + format = None; +} + +type request_exists_mutable = { + mutable path : string list; +} + +let default_request_exists_mutable () : request_exists_mutable = { + path = []; +} + +type request_get_value_mutable = { + mutable path : string list; + mutable output_format : request_output_format option; +} + +let default_request_get_value_mutable () : request_get_value_mutable = { + path = []; + output_format = None; +} + +type request_get_values_mutable = { + mutable path : string list; + mutable output_format : request_output_format option; +} + +let default_request_get_values_mutable () : request_get_values_mutable = { + path = []; + output_format = None; +} + +type request_list_children_mutable = { + mutable path : string list; + mutable output_format : request_output_format option; +} + +let default_request_list_children_mutable () : request_list_children_mutable = { + path = []; + output_format = None; +} + +type request_run_op_mode_mutable = { + mutable path : string list; + mutable output_format : request_output_format option; +} + +let default_request_run_op_mode_mutable () : request_run_op_mode_mutable = { + path = []; + output_format = None; +} + +type request_enter_configuration_mode_mutable = { + mutable exclusive : bool; + mutable override_exclusive : bool; +} + +let default_request_enter_configuration_mode_mutable () : request_enter_configuration_mode_mutable = { + exclusive = false; + override_exclusive = false; +} + +type request_envelope_mutable = { + mutable token : string option; + mutable request : request; +} + +let default_request_envelope_mutable () : request_envelope_mutable = { + token = None; + request = default_request (); +} + +type response_mutable = { + mutable status : status; + mutable output : string option; + mutable error : string option; + mutable warning : string option; +} + +let default_response_mutable () : response_mutable = { + status = default_status (); + output = None; + error = None; + warning = None; +} + +[@@@ocaml.warning "-27-30-39"] + +(** {2 Formatters} *) + +let rec pp_request_config_format fmt (v:request_config_format) = + match v with + | Curly -> Format.fprintf fmt "Curly" + | Json -> Format.fprintf fmt "Json" + +let rec pp_request_output_format fmt (v:request_output_format) = + match v with + | Out_plain -> Format.fprintf fmt "Out_plain" + | Out_json -> Format.fprintf fmt "Out_json" + +let rec pp_request_status fmt (v:request_status) = + let pp_i fmt () = + Pbrt.Pp.pp_unit fmt () + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_setup_session fmt (v:request_setup_session) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "client_application" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.client_application; + Pbrt.Pp.pp_record_field ~first:false "on_behalf_of" (Pbrt.Pp.pp_option Pbrt.Pp.pp_int32) fmt v.on_behalf_of; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_teardown fmt (v:request_teardown) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "on_behalf_of" (Pbrt.Pp.pp_option Pbrt.Pp.pp_int32) fmt v.on_behalf_of; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_validate fmt (v:request_validate) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "path" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.path; + Pbrt.Pp.pp_record_field ~first:false "output_format" (Pbrt.Pp.pp_option pp_request_output_format) fmt v.output_format; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_set fmt (v:request_set) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "path" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.path; + Pbrt.Pp.pp_record_field ~first:false "ephemeral" (Pbrt.Pp.pp_option Pbrt.Pp.pp_bool) fmt v.ephemeral; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_delete fmt (v:request_delete) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "path" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.path; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_rename fmt (v:request_rename) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "edit_level" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.edit_level; + Pbrt.Pp.pp_record_field ~first:false "from" Pbrt.Pp.pp_string fmt v.from; + Pbrt.Pp.pp_record_field ~first:false "to_" Pbrt.Pp.pp_string fmt v.to_; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_copy fmt (v:request_copy) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "edit_level" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.edit_level; + Pbrt.Pp.pp_record_field ~first:false "from" Pbrt.Pp.pp_string fmt v.from; + Pbrt.Pp.pp_record_field ~first:false "to_" Pbrt.Pp.pp_string fmt v.to_; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_comment fmt (v:request_comment) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "path" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.path; + Pbrt.Pp.pp_record_field ~first:false "comment" Pbrt.Pp.pp_string fmt v.comment; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_commit fmt (v:request_commit) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "confirm" (Pbrt.Pp.pp_option Pbrt.Pp.pp_bool) fmt v.confirm; + Pbrt.Pp.pp_record_field ~first:false "confirm_timeout" (Pbrt.Pp.pp_option Pbrt.Pp.pp_int32) fmt v.confirm_timeout; + Pbrt.Pp.pp_record_field ~first:false "comment" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.comment; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_rollback fmt (v:request_rollback) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "revision" Pbrt.Pp.pp_int32 fmt v.revision; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_load fmt (v:request_load) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "location" Pbrt.Pp.pp_string fmt v.location; + Pbrt.Pp.pp_record_field ~first:false "format" (Pbrt.Pp.pp_option pp_request_config_format) fmt v.format; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_merge fmt (v:request_merge) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "location" Pbrt.Pp.pp_string fmt v.location; + Pbrt.Pp.pp_record_field ~first:false "format" (Pbrt.Pp.pp_option pp_request_config_format) fmt v.format; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_save fmt (v:request_save) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "location" Pbrt.Pp.pp_string fmt v.location; + Pbrt.Pp.pp_record_field ~first:false "format" (Pbrt.Pp.pp_option pp_request_config_format) fmt v.format; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_show_config fmt (v:request_show_config) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "path" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.path; + Pbrt.Pp.pp_record_field ~first:false "format" (Pbrt.Pp.pp_option pp_request_config_format) fmt v.format; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_exists fmt (v:request_exists) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "path" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.path; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_get_value fmt (v:request_get_value) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "path" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.path; + Pbrt.Pp.pp_record_field ~first:false "output_format" (Pbrt.Pp.pp_option pp_request_output_format) fmt v.output_format; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_get_values fmt (v:request_get_values) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "path" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.path; + Pbrt.Pp.pp_record_field ~first:false "output_format" (Pbrt.Pp.pp_option pp_request_output_format) fmt v.output_format; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_list_children fmt (v:request_list_children) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "path" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.path; + Pbrt.Pp.pp_record_field ~first:false "output_format" (Pbrt.Pp.pp_option pp_request_output_format) fmt v.output_format; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_run_op_mode fmt (v:request_run_op_mode) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "path" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.path; + Pbrt.Pp.pp_record_field ~first:false "output_format" (Pbrt.Pp.pp_option pp_request_output_format) fmt v.output_format; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_confirm fmt (v:request_confirm) = + let pp_i fmt () = + Pbrt.Pp.pp_unit fmt () + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_enter_configuration_mode fmt (v:request_enter_configuration_mode) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "exclusive" Pbrt.Pp.pp_bool fmt v.exclusive; + Pbrt.Pp.pp_record_field ~first:false "override_exclusive" Pbrt.Pp.pp_bool fmt v.override_exclusive; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request_exit_configuration_mode fmt (v:request_exit_configuration_mode) = + let pp_i fmt () = + Pbrt.Pp.pp_unit fmt () + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_request fmt (v:request) = + match v with + | Status -> Format.fprintf fmt "Status" + | Setup_session x -> Format.fprintf fmt "@[<hv2>Setup_session(@,%a)@]" pp_request_setup_session x + | Set x -> Format.fprintf fmt "@[<hv2>Set(@,%a)@]" pp_request_set x + | Delete x -> Format.fprintf fmt "@[<hv2>Delete(@,%a)@]" pp_request_delete x + | Rename x -> Format.fprintf fmt "@[<hv2>Rename(@,%a)@]" pp_request_rename x + | Copy x -> Format.fprintf fmt "@[<hv2>Copy(@,%a)@]" pp_request_copy x + | Comment x -> Format.fprintf fmt "@[<hv2>Comment(@,%a)@]" pp_request_comment x + | Commit x -> Format.fprintf fmt "@[<hv2>Commit(@,%a)@]" pp_request_commit x + | Rollback x -> Format.fprintf fmt "@[<hv2>Rollback(@,%a)@]" pp_request_rollback x + | Merge x -> Format.fprintf fmt "@[<hv2>Merge(@,%a)@]" pp_request_merge x + | Save x -> Format.fprintf fmt "@[<hv2>Save(@,%a)@]" pp_request_save x + | Show_config x -> Format.fprintf fmt "@[<hv2>Show_config(@,%a)@]" pp_request_show_config x + | Exists x -> Format.fprintf fmt "@[<hv2>Exists(@,%a)@]" pp_request_exists x + | Get_value x -> Format.fprintf fmt "@[<hv2>Get_value(@,%a)@]" pp_request_get_value x + | Get_values x -> Format.fprintf fmt "@[<hv2>Get_values(@,%a)@]" pp_request_get_values x + | List_children x -> Format.fprintf fmt "@[<hv2>List_children(@,%a)@]" pp_request_list_children x + | Run_op_mode x -> Format.fprintf fmt "@[<hv2>Run_op_mode(@,%a)@]" pp_request_run_op_mode x + | Confirm -> Format.fprintf fmt "Confirm" + | Configure x -> Format.fprintf fmt "@[<hv2>Configure(@,%a)@]" pp_request_enter_configuration_mode x + | Exit_configure -> Format.fprintf fmt "Exit_configure" + | Validate x -> Format.fprintf fmt "@[<hv2>Validate(@,%a)@]" pp_request_validate x + | Teardown x -> Format.fprintf fmt "@[<hv2>Teardown(@,%a)@]" pp_request_teardown x + +let rec pp_request_envelope fmt (v:request_envelope) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "token" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.token; + Pbrt.Pp.pp_record_field ~first:false "request" pp_request fmt v.request; + in + Pbrt.Pp.pp_brk pp_i fmt () + +let rec pp_status fmt (v:status) = + match v with + | Success -> Format.fprintf fmt "Success" + | Fail -> Format.fprintf fmt "Fail" + | Invalid_path -> Format.fprintf fmt "Invalid_path" + | Invalid_value -> Format.fprintf fmt "Invalid_value" + | Commit_in_progress -> Format.fprintf fmt "Commit_in_progress" + | Configuration_locked -> Format.fprintf fmt "Configuration_locked" + | Internal_error -> Format.fprintf fmt "Internal_error" + | Permission_denied -> Format.fprintf fmt "Permission_denied" + | Path_already_exists -> Format.fprintf fmt "Path_already_exists" + +let rec pp_response fmt (v:response) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~first:true "status" pp_status fmt v.status; + Pbrt.Pp.pp_record_field ~first:false "output" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.output; + Pbrt.Pp.pp_record_field ~first:false "error" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.error; + Pbrt.Pp.pp_record_field ~first:false "warning" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.warning; + in + Pbrt.Pp.pp_brk pp_i fmt () + +[@@@ocaml.warning "-27-30-39"] + +(** {2 Protobuf Encoding} *) + +let rec encode_pb_request_config_format (v:request_config_format) encoder = + match v with + | Curly -> Pbrt.Encoder.int_as_varint (0) encoder + | Json -> Pbrt.Encoder.int_as_varint 1 encoder + +let rec encode_pb_request_output_format (v:request_output_format) encoder = + match v with + | Out_plain -> Pbrt.Encoder.int_as_varint (0) encoder + | Out_json -> Pbrt.Encoder.int_as_varint 1 encoder + +let rec encode_pb_request_status (v:request_status) encoder = +() + +let rec encode_pb_request_setup_session (v:request_setup_session) encoder = + begin match v.client_application with + | Some x -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + | None -> (); + end; + begin match v.on_behalf_of with + | Some x -> + Pbrt.Encoder.int32_as_varint x encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + | None -> (); + end; + () + +let rec encode_pb_request_teardown (v:request_teardown) encoder = + begin match v.on_behalf_of with + | Some x -> + Pbrt.Encoder.int32_as_varint x encoder; + Pbrt.Encoder.key 1 Pbrt.Varint encoder; + | None -> (); + end; + () + +let rec encode_pb_request_validate (v:request_validate) encoder = + Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ) v.path encoder; + begin match v.output_format with + | Some x -> + encode_pb_request_output_format x encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + | None -> (); + end; + () + +let rec encode_pb_request_set (v:request_set) encoder = + Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ) v.path encoder; + begin match v.ephemeral with + | Some x -> + Pbrt.Encoder.bool x encoder; + Pbrt.Encoder.key 3 Pbrt.Varint encoder; + | None -> (); + end; + () + +let rec encode_pb_request_delete (v:request_delete) encoder = + Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ) v.path encoder; + () + +let rec encode_pb_request_rename (v:request_rename) encoder = + Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ) v.edit_level encoder; + Pbrt.Encoder.string v.from encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + Pbrt.Encoder.string v.to_ encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + () + +let rec encode_pb_request_copy (v:request_copy) encoder = + Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ) v.edit_level encoder; + Pbrt.Encoder.string v.from encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + Pbrt.Encoder.string v.to_ encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + () + +let rec encode_pb_request_comment (v:request_comment) encoder = + Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ) v.path encoder; + Pbrt.Encoder.string v.comment encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + () + +let rec encode_pb_request_commit (v:request_commit) encoder = + begin match v.confirm with + | Some x -> + Pbrt.Encoder.bool x encoder; + Pbrt.Encoder.key 1 Pbrt.Varint encoder; + | None -> (); + end; + begin match v.confirm_timeout with + | Some x -> + Pbrt.Encoder.int32_as_varint x encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + | None -> (); + end; + begin match v.comment with + | Some x -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + | None -> (); + end; + () + +let rec encode_pb_request_rollback (v:request_rollback) encoder = + Pbrt.Encoder.int32_as_varint v.revision encoder; + Pbrt.Encoder.key 1 Pbrt.Varint encoder; + () + +let rec encode_pb_request_load (v:request_load) encoder = + Pbrt.Encoder.string v.location encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + begin match v.format with + | Some x -> + encode_pb_request_config_format x encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + | None -> (); + end; + () + +let rec encode_pb_request_merge (v:request_merge) encoder = + Pbrt.Encoder.string v.location encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + begin match v.format with + | Some x -> + encode_pb_request_config_format x encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + | None -> (); + end; + () + +let rec encode_pb_request_save (v:request_save) encoder = + Pbrt.Encoder.string v.location encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + begin match v.format with + | Some x -> + encode_pb_request_config_format x encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + | None -> (); + end; + () + +let rec encode_pb_request_show_config (v:request_show_config) encoder = + Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ) v.path encoder; + begin match v.format with + | Some x -> + encode_pb_request_config_format x encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + | None -> (); + end; + () + +let rec encode_pb_request_exists (v:request_exists) encoder = + Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ) v.path encoder; + () + +let rec encode_pb_request_get_value (v:request_get_value) encoder = + Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ) v.path encoder; + begin match v.output_format with + | Some x -> + encode_pb_request_output_format x encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + | None -> (); + end; + () + +let rec encode_pb_request_get_values (v:request_get_values) encoder = + Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ) v.path encoder; + begin match v.output_format with + | Some x -> + encode_pb_request_output_format x encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + | None -> (); + end; + () + +let rec encode_pb_request_list_children (v:request_list_children) encoder = + Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ) v.path encoder; + begin match v.output_format with + | Some x -> + encode_pb_request_output_format x encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + | None -> (); + end; + () + +let rec encode_pb_request_run_op_mode (v:request_run_op_mode) encoder = + Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ) v.path encoder; + begin match v.output_format with + | Some x -> + encode_pb_request_output_format x encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + | None -> (); + end; + () + +let rec encode_pb_request_confirm (v:request_confirm) encoder = +() + +let rec encode_pb_request_enter_configuration_mode (v:request_enter_configuration_mode) encoder = + Pbrt.Encoder.bool v.exclusive encoder; + Pbrt.Encoder.key 1 Pbrt.Varint encoder; + Pbrt.Encoder.bool v.override_exclusive encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + () + +let rec encode_pb_request_exit_configuration_mode (v:request_exit_configuration_mode) encoder = +() + +let rec encode_pb_request (v:request) encoder = + begin match v with + | Status -> + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + Pbrt.Encoder.empty_nested encoder + | Setup_session x -> + Pbrt.Encoder.nested encode_pb_request_setup_session x encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + | Set x -> + Pbrt.Encoder.nested encode_pb_request_set x encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + | Delete x -> + Pbrt.Encoder.nested encode_pb_request_delete x encoder; + Pbrt.Encoder.key 4 Pbrt.Bytes encoder; + | Rename x -> + Pbrt.Encoder.nested encode_pb_request_rename x encoder; + Pbrt.Encoder.key 5 Pbrt.Bytes encoder; + | Copy x -> + Pbrt.Encoder.nested encode_pb_request_copy x encoder; + Pbrt.Encoder.key 6 Pbrt.Bytes encoder; + | Comment x -> + Pbrt.Encoder.nested encode_pb_request_comment x encoder; + Pbrt.Encoder.key 7 Pbrt.Bytes encoder; + | Commit x -> + Pbrt.Encoder.nested encode_pb_request_commit x encoder; + Pbrt.Encoder.key 8 Pbrt.Bytes encoder; + | Rollback x -> + Pbrt.Encoder.nested encode_pb_request_rollback x encoder; + Pbrt.Encoder.key 9 Pbrt.Bytes encoder; + | Merge x -> + Pbrt.Encoder.nested encode_pb_request_merge x encoder; + Pbrt.Encoder.key 10 Pbrt.Bytes encoder; + | Save x -> + Pbrt.Encoder.nested encode_pb_request_save x encoder; + Pbrt.Encoder.key 11 Pbrt.Bytes encoder; + | Show_config x -> + Pbrt.Encoder.nested encode_pb_request_show_config x encoder; + Pbrt.Encoder.key 12 Pbrt.Bytes encoder; + | Exists x -> + Pbrt.Encoder.nested encode_pb_request_exists x encoder; + Pbrt.Encoder.key 13 Pbrt.Bytes encoder; + | Get_value x -> + Pbrt.Encoder.nested encode_pb_request_get_value x encoder; + Pbrt.Encoder.key 14 Pbrt.Bytes encoder; + | Get_values x -> + Pbrt.Encoder.nested encode_pb_request_get_values x encoder; + Pbrt.Encoder.key 15 Pbrt.Bytes encoder; + | List_children x -> + Pbrt.Encoder.nested encode_pb_request_list_children x encoder; + Pbrt.Encoder.key 16 Pbrt.Bytes encoder; + | Run_op_mode x -> + Pbrt.Encoder.nested encode_pb_request_run_op_mode x encoder; + Pbrt.Encoder.key 17 Pbrt.Bytes encoder; + | Confirm -> + Pbrt.Encoder.key 18 Pbrt.Bytes encoder; + Pbrt.Encoder.empty_nested encoder + | Configure x -> + Pbrt.Encoder.nested encode_pb_request_enter_configuration_mode x encoder; + Pbrt.Encoder.key 19 Pbrt.Bytes encoder; + | Exit_configure -> + Pbrt.Encoder.key 20 Pbrt.Bytes encoder; + Pbrt.Encoder.empty_nested encoder + | Validate x -> + Pbrt.Encoder.nested encode_pb_request_validate x encoder; + Pbrt.Encoder.key 21 Pbrt.Bytes encoder; + | Teardown x -> + Pbrt.Encoder.nested encode_pb_request_teardown x encoder; + Pbrt.Encoder.key 22 Pbrt.Bytes encoder; + end + +let rec encode_pb_request_envelope (v:request_envelope) encoder = + begin match v.token with + | Some x -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + | None -> (); + end; + Pbrt.Encoder.nested encode_pb_request v.request encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + () + +let rec encode_pb_status (v:status) encoder = + match v with + | Success -> Pbrt.Encoder.int_as_varint (0) encoder + | Fail -> Pbrt.Encoder.int_as_varint 1 encoder + | Invalid_path -> Pbrt.Encoder.int_as_varint 2 encoder + | Invalid_value -> Pbrt.Encoder.int_as_varint 3 encoder + | Commit_in_progress -> Pbrt.Encoder.int_as_varint 4 encoder + | Configuration_locked -> Pbrt.Encoder.int_as_varint 5 encoder + | Internal_error -> Pbrt.Encoder.int_as_varint 6 encoder + | Permission_denied -> Pbrt.Encoder.int_as_varint 7 encoder + | Path_already_exists -> Pbrt.Encoder.int_as_varint 8 encoder + +let rec encode_pb_response (v:response) encoder = + encode_pb_status v.status encoder; + Pbrt.Encoder.key 1 Pbrt.Varint encoder; + begin match v.output with + | Some x -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + | None -> (); + end; + begin match v.error with + | Some x -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + | None -> (); + end; + begin match v.warning with + | Some x -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 4 Pbrt.Bytes encoder; + | None -> (); + end; + () + +[@@@ocaml.warning "-27-30-39"] + +(** {2 Protobuf Decoding} *) + +let rec decode_pb_request_config_format d = + match Pbrt.Decoder.int_as_varint d with + | 0 -> (Curly:request_config_format) + | 1 -> (Json:request_config_format) + | _ -> Pbrt.Decoder.malformed_variant "request_config_format" + +let rec decode_pb_request_output_format d = + match Pbrt.Decoder.int_as_varint d with + | 0 -> (Out_plain:request_output_format) + | 1 -> (Out_json:request_output_format) + | _ -> Pbrt.Decoder.malformed_variant "request_output_format" + +let rec decode_pb_request_status d = + match Pbrt.Decoder.key d with + | None -> (); + | Some (_, pk) -> + Pbrt.Decoder.unexpected_payload "Unexpected fields in empty message(request_status)" pk + +let rec decode_pb_request_setup_session d = + let v = default_request_setup_session_mutable () in + let continue__= ref true in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.client_application <- Some (Pbrt.Decoder.string d); + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_setup_session), field(1)" pk + | Some (2, Pbrt.Varint) -> begin + v.on_behalf_of <- Some (Pbrt.Decoder.int32_as_varint d); + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_setup_session), field(2)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + ({ + client_application = v.client_application; + on_behalf_of = v.on_behalf_of; + } : request_setup_session) + +let rec decode_pb_request_teardown d = + let v = default_request_teardown_mutable () in + let continue__= ref true in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + ); continue__ := false + | Some (1, Pbrt.Varint) -> begin + v.on_behalf_of <- Some (Pbrt.Decoder.int32_as_varint d); + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_teardown), field(1)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + ({ + on_behalf_of = v.on_behalf_of; + } : request_teardown) + +let rec decode_pb_request_validate d = + let v = default_request_validate_mutable () in + let continue__= ref true in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + v.path <- List.rev v.path; + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.path <- (Pbrt.Decoder.string d) :: v.path; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_validate), field(1)" pk + | Some (2, Pbrt.Varint) -> begin + v.output_format <- Some (decode_pb_request_output_format d); + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_validate), field(2)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + ({ + path = v.path; + output_format = v.output_format; + } : request_validate) + +let rec decode_pb_request_set d = + let v = default_request_set_mutable () in + let continue__= ref true in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + v.path <- List.rev v.path; + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.path <- (Pbrt.Decoder.string d) :: v.path; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_set), field(1)" pk + | Some (3, Pbrt.Varint) -> begin + v.ephemeral <- Some (Pbrt.Decoder.bool d); + end + | Some (3, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_set), field(3)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + ({ + path = v.path; + ephemeral = v.ephemeral; + } : request_set) + +let rec decode_pb_request_delete d = + let v = default_request_delete_mutable () in + let continue__= ref true in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + v.path <- List.rev v.path; + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.path <- (Pbrt.Decoder.string d) :: v.path; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_delete), field(1)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + ({ + path = v.path; + } : request_delete) + +let rec decode_pb_request_rename d = + let v = default_request_rename_mutable () in + let continue__= ref true in + let to__is_set = ref false in + let from_is_set = ref false in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + v.edit_level <- List.rev v.edit_level; + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.edit_level <- (Pbrt.Decoder.string d) :: v.edit_level; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_rename), field(1)" pk + | Some (2, Pbrt.Bytes) -> begin + v.from <- Pbrt.Decoder.string d; from_is_set := true; + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_rename), field(2)" pk + | Some (3, Pbrt.Bytes) -> begin + v.to_ <- Pbrt.Decoder.string d; to__is_set := true; + end + | Some (3, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_rename), field(3)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + begin if not !to__is_set then Pbrt.Decoder.missing_field "to_" end; + begin if not !from_is_set then Pbrt.Decoder.missing_field "from" end; + ({ + edit_level = v.edit_level; + from = v.from; + to_ = v.to_; + } : request_rename) + +let rec decode_pb_request_copy d = + let v = default_request_copy_mutable () in + let continue__= ref true in + let to__is_set = ref false in + let from_is_set = ref false in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + v.edit_level <- List.rev v.edit_level; + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.edit_level <- (Pbrt.Decoder.string d) :: v.edit_level; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_copy), field(1)" pk + | Some (2, Pbrt.Bytes) -> begin + v.from <- Pbrt.Decoder.string d; from_is_set := true; + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_copy), field(2)" pk + | Some (3, Pbrt.Bytes) -> begin + v.to_ <- Pbrt.Decoder.string d; to__is_set := true; + end + | Some (3, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_copy), field(3)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + begin if not !to__is_set then Pbrt.Decoder.missing_field "to_" end; + begin if not !from_is_set then Pbrt.Decoder.missing_field "from" end; + ({ + edit_level = v.edit_level; + from = v.from; + to_ = v.to_; + } : request_copy) + +let rec decode_pb_request_comment d = + let v = default_request_comment_mutable () in + let continue__= ref true in + let comment_is_set = ref false in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + v.path <- List.rev v.path; + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.path <- (Pbrt.Decoder.string d) :: v.path; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_comment), field(1)" pk + | Some (2, Pbrt.Bytes) -> begin + v.comment <- Pbrt.Decoder.string d; comment_is_set := true; + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_comment), field(2)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + begin if not !comment_is_set then Pbrt.Decoder.missing_field "comment" end; + ({ + path = v.path; + comment = v.comment; + } : request_comment) + +let rec decode_pb_request_commit d = + let v = default_request_commit_mutable () in + let continue__= ref true in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + ); continue__ := false + | Some (1, Pbrt.Varint) -> begin + v.confirm <- Some (Pbrt.Decoder.bool d); + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_commit), field(1)" pk + | Some (2, Pbrt.Varint) -> begin + v.confirm_timeout <- Some (Pbrt.Decoder.int32_as_varint d); + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_commit), field(2)" pk + | Some (3, Pbrt.Bytes) -> begin + v.comment <- Some (Pbrt.Decoder.string d); + end + | Some (3, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_commit), field(3)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + ({ + confirm = v.confirm; + confirm_timeout = v.confirm_timeout; + comment = v.comment; + } : request_commit) + +let rec decode_pb_request_rollback d = + let v = default_request_rollback_mutable () in + let continue__= ref true in + let revision_is_set = ref false in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + ); continue__ := false + | Some (1, Pbrt.Varint) -> begin + v.revision <- Pbrt.Decoder.int32_as_varint d; revision_is_set := true; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_rollback), field(1)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + begin if not !revision_is_set then Pbrt.Decoder.missing_field "revision" end; + ({ + revision = v.revision; + } : request_rollback) + +let rec decode_pb_request_load d = + let v = default_request_load_mutable () in + let continue__= ref true in + let location_is_set = ref false in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.location <- Pbrt.Decoder.string d; location_is_set := true; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_load), field(1)" pk + | Some (2, Pbrt.Varint) -> begin + v.format <- Some (decode_pb_request_config_format d); + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_load), field(2)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + begin if not !location_is_set then Pbrt.Decoder.missing_field "location" end; + ({ + location = v.location; + format = v.format; + } : request_load) + +let rec decode_pb_request_merge d = + let v = default_request_merge_mutable () in + let continue__= ref true in + let location_is_set = ref false in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.location <- Pbrt.Decoder.string d; location_is_set := true; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_merge), field(1)" pk + | Some (2, Pbrt.Varint) -> begin + v.format <- Some (decode_pb_request_config_format d); + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_merge), field(2)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + begin if not !location_is_set then Pbrt.Decoder.missing_field "location" end; + ({ + location = v.location; + format = v.format; + } : request_merge) + +let rec decode_pb_request_save d = + let v = default_request_save_mutable () in + let continue__= ref true in + let location_is_set = ref false in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.location <- Pbrt.Decoder.string d; location_is_set := true; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_save), field(1)" pk + | Some (2, Pbrt.Varint) -> begin + v.format <- Some (decode_pb_request_config_format d); + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_save), field(2)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + begin if not !location_is_set then Pbrt.Decoder.missing_field "location" end; + ({ + location = v.location; + format = v.format; + } : request_save) + +let rec decode_pb_request_show_config d = + let v = default_request_show_config_mutable () in + let continue__= ref true in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + v.path <- List.rev v.path; + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.path <- (Pbrt.Decoder.string d) :: v.path; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_show_config), field(1)" pk + | Some (2, Pbrt.Varint) -> begin + v.format <- Some (decode_pb_request_config_format d); + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_show_config), field(2)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + ({ + path = v.path; + format = v.format; + } : request_show_config) + +let rec decode_pb_request_exists d = + let v = default_request_exists_mutable () in + let continue__= ref true in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + v.path <- List.rev v.path; + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.path <- (Pbrt.Decoder.string d) :: v.path; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_exists), field(1)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + ({ + path = v.path; + } : request_exists) + +let rec decode_pb_request_get_value d = + let v = default_request_get_value_mutable () in + let continue__= ref true in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + v.path <- List.rev v.path; + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.path <- (Pbrt.Decoder.string d) :: v.path; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_get_value), field(1)" pk + | Some (2, Pbrt.Varint) -> begin + v.output_format <- Some (decode_pb_request_output_format d); + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_get_value), field(2)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + ({ + path = v.path; + output_format = v.output_format; + } : request_get_value) + +let rec decode_pb_request_get_values d = + let v = default_request_get_values_mutable () in + let continue__= ref true in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + v.path <- List.rev v.path; + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.path <- (Pbrt.Decoder.string d) :: v.path; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_get_values), field(1)" pk + | Some (2, Pbrt.Varint) -> begin + v.output_format <- Some (decode_pb_request_output_format d); + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_get_values), field(2)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + ({ + path = v.path; + output_format = v.output_format; + } : request_get_values) + +let rec decode_pb_request_list_children d = + let v = default_request_list_children_mutable () in + let continue__= ref true in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + v.path <- List.rev v.path; + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.path <- (Pbrt.Decoder.string d) :: v.path; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_list_children), field(1)" pk + | Some (2, Pbrt.Varint) -> begin + v.output_format <- Some (decode_pb_request_output_format d); + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_list_children), field(2)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + ({ + path = v.path; + output_format = v.output_format; + } : request_list_children) + +let rec decode_pb_request_run_op_mode d = + let v = default_request_run_op_mode_mutable () in + let continue__= ref true in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + v.path <- List.rev v.path; + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.path <- (Pbrt.Decoder.string d) :: v.path; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_run_op_mode), field(1)" pk + | Some (2, Pbrt.Varint) -> begin + v.output_format <- Some (decode_pb_request_output_format d); + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_run_op_mode), field(2)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + ({ + path = v.path; + output_format = v.output_format; + } : request_run_op_mode) + +let rec decode_pb_request_confirm d = + match Pbrt.Decoder.key d with + | None -> (); + | Some (_, pk) -> + Pbrt.Decoder.unexpected_payload "Unexpected fields in empty message(request_confirm)" pk + +let rec decode_pb_request_enter_configuration_mode d = + let v = default_request_enter_configuration_mode_mutable () in + let continue__= ref true in + let override_exclusive_is_set = ref false in + let exclusive_is_set = ref false in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + ); continue__ := false + | Some (1, Pbrt.Varint) -> begin + v.exclusive <- Pbrt.Decoder.bool d; exclusive_is_set := true; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_enter_configuration_mode), field(1)" pk + | Some (2, Pbrt.Varint) -> begin + v.override_exclusive <- Pbrt.Decoder.bool d; override_exclusive_is_set := true; + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_enter_configuration_mode), field(2)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + begin if not !override_exclusive_is_set then Pbrt.Decoder.missing_field "override_exclusive" end; + begin if not !exclusive_is_set then Pbrt.Decoder.missing_field "exclusive" end; + ({ + exclusive = v.exclusive; + override_exclusive = v.override_exclusive; + } : request_enter_configuration_mode) + +let rec decode_pb_request_exit_configuration_mode d = + match Pbrt.Decoder.key d with + | None -> (); + | Some (_, pk) -> + Pbrt.Decoder.unexpected_payload "Unexpected fields in empty message(request_exit_configuration_mode)" pk + +let rec decode_pb_request d = + let rec loop () = + let ret:request = match Pbrt.Decoder.key d with + | None -> Pbrt.Decoder.malformed_variant "request" + | Some (1, _) -> begin + Pbrt.Decoder.empty_nested d ; + (Status : request) + end + | Some (2, _) -> (Setup_session (decode_pb_request_setup_session (Pbrt.Decoder.nested d)) : request) + | Some (3, _) -> (Set (decode_pb_request_set (Pbrt.Decoder.nested d)) : request) + | Some (4, _) -> (Delete (decode_pb_request_delete (Pbrt.Decoder.nested d)) : request) + | Some (5, _) -> (Rename (decode_pb_request_rename (Pbrt.Decoder.nested d)) : request) + | Some (6, _) -> (Copy (decode_pb_request_copy (Pbrt.Decoder.nested d)) : request) + | Some (7, _) -> (Comment (decode_pb_request_comment (Pbrt.Decoder.nested d)) : request) + | Some (8, _) -> (Commit (decode_pb_request_commit (Pbrt.Decoder.nested d)) : request) + | Some (9, _) -> (Rollback (decode_pb_request_rollback (Pbrt.Decoder.nested d)) : request) + | Some (10, _) -> (Merge (decode_pb_request_merge (Pbrt.Decoder.nested d)) : request) + | Some (11, _) -> (Save (decode_pb_request_save (Pbrt.Decoder.nested d)) : request) + | Some (12, _) -> (Show_config (decode_pb_request_show_config (Pbrt.Decoder.nested d)) : request) + | Some (13, _) -> (Exists (decode_pb_request_exists (Pbrt.Decoder.nested d)) : request) + | Some (14, _) -> (Get_value (decode_pb_request_get_value (Pbrt.Decoder.nested d)) : request) + | Some (15, _) -> (Get_values (decode_pb_request_get_values (Pbrt.Decoder.nested d)) : request) + | Some (16, _) -> (List_children (decode_pb_request_list_children (Pbrt.Decoder.nested d)) : request) + | Some (17, _) -> (Run_op_mode (decode_pb_request_run_op_mode (Pbrt.Decoder.nested d)) : request) + | Some (18, _) -> begin + Pbrt.Decoder.empty_nested d ; + (Confirm : request) + end + | Some (19, _) -> (Configure (decode_pb_request_enter_configuration_mode (Pbrt.Decoder.nested d)) : request) + | Some (20, _) -> begin + Pbrt.Decoder.empty_nested d ; + (Exit_configure : request) + end + | Some (21, _) -> (Validate (decode_pb_request_validate (Pbrt.Decoder.nested d)) : request) + | Some (22, _) -> (Teardown (decode_pb_request_teardown (Pbrt.Decoder.nested d)) : request) + | Some (n, payload_kind) -> ( + Pbrt.Decoder.skip d payload_kind; + loop () + ) + in + ret + in + loop () + +let rec decode_pb_request_envelope d = + let v = default_request_envelope_mutable () in + let continue__= ref true in + let request_is_set = ref false in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + v.token <- Some (Pbrt.Decoder.string d); + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_envelope), field(1)" pk + | Some (2, Pbrt.Bytes) -> begin + v.request <- decode_pb_request (Pbrt.Decoder.nested d); request_is_set := true; + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(request_envelope), field(2)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + begin if not !request_is_set then Pbrt.Decoder.missing_field "request" end; + ({ + token = v.token; + request = v.request; + } : request_envelope) + +let rec decode_pb_status d = + match Pbrt.Decoder.int_as_varint d with + | 0 -> (Success:status) + | 1 -> (Fail:status) + | 2 -> (Invalid_path:status) + | 3 -> (Invalid_value:status) + | 4 -> (Commit_in_progress:status) + | 5 -> (Configuration_locked:status) + | 6 -> (Internal_error:status) + | 7 -> (Permission_denied:status) + | 8 -> (Path_already_exists:status) + | _ -> Pbrt.Decoder.malformed_variant "status" + +let rec decode_pb_response d = + let v = default_response_mutable () in + let continue__= ref true in + let status_is_set = ref false in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + ); continue__ := false + | Some (1, Pbrt.Varint) -> begin + v.status <- decode_pb_status d; status_is_set := true; + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload "Message(response), field(1)" pk + | Some (2, Pbrt.Bytes) -> begin + v.output <- Some (Pbrt.Decoder.string d); + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload "Message(response), field(2)" pk + | Some (3, Pbrt.Bytes) -> begin + v.error <- Some (Pbrt.Decoder.string d); + end + | Some (3, pk) -> + Pbrt.Decoder.unexpected_payload "Message(response), field(3)" pk + | Some (4, Pbrt.Bytes) -> begin + v.warning <- Some (Pbrt.Decoder.string d); + end + | Some (4, pk) -> + Pbrt.Decoder.unexpected_payload "Message(response), field(4)" pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + begin if not !status_is_set then Pbrt.Decoder.missing_field "status" end; + ({ + status = v.status; + output = v.output; + error = v.error; + warning = v.warning; + } : response) diff --git a/src/vyconf_pbt.mli b/src/vyconf_pbt.mli new file mode 100644 index 0000000..da94655 --- /dev/null +++ b/src/vyconf_pbt.mli @@ -0,0 +1,617 @@ + +(** Code for vyconf.proto *) + +(* generated from "data/vyconf.proto", do not edit *) + + + +(** {2 Types} *) + +type request_config_format = + | Curly + | Json + +type request_output_format = + | Out_plain + | Out_json + +type request_status = unit + +type request_setup_session = { + client_application : string option; + on_behalf_of : int32 option; +} + +type request_teardown = { + on_behalf_of : int32 option; +} + +type request_validate = { + path : string list; + output_format : request_output_format option; +} + +type request_set = { + path : string list; + ephemeral : bool option; +} + +type request_delete = { + path : string list; +} + +type request_rename = { + edit_level : string list; + from : string; + to_ : string; +} + +type request_copy = { + edit_level : string list; + from : string; + to_ : string; +} + +type request_comment = { + path : string list; + comment : string; +} + +type request_commit = { + confirm : bool option; + confirm_timeout : int32 option; + comment : string option; +} + +type request_rollback = { + revision : int32; +} + +type request_load = { + location : string; + format : request_config_format option; +} + +type request_merge = { + location : string; + format : request_config_format option; +} + +type request_save = { + location : string; + format : request_config_format option; +} + +type request_show_config = { + path : string list; + format : request_config_format option; +} + +type request_exists = { + path : string list; +} + +type request_get_value = { + path : string list; + output_format : request_output_format option; +} + +type request_get_values = { + path : string list; + output_format : request_output_format option; +} + +type request_list_children = { + path : string list; + output_format : request_output_format option; +} + +type request_run_op_mode = { + path : string list; + output_format : request_output_format option; +} + +type request_confirm = unit + +type request_enter_configuration_mode = { + exclusive : bool; + override_exclusive : bool; +} + +type request_exit_configuration_mode = unit + +type request = + | Status + | Setup_session of request_setup_session + | Set of request_set + | Delete of request_delete + | Rename of request_rename + | Copy of request_copy + | Comment of request_comment + | Commit of request_commit + | Rollback of request_rollback + | Merge of request_merge + | Save of request_save + | Show_config of request_show_config + | Exists of request_exists + | Get_value of request_get_value + | Get_values of request_get_values + | List_children of request_list_children + | Run_op_mode of request_run_op_mode + | Confirm + | Configure of request_enter_configuration_mode + | Exit_configure + | Validate of request_validate + | Teardown of request_teardown + +type request_envelope = { + token : string option; + request : request; +} + +type status = + | Success + | Fail + | Invalid_path + | Invalid_value + | Commit_in_progress + | Configuration_locked + | Internal_error + | Permission_denied + | Path_already_exists + +type response = { + status : status; + output : string option; + error : string option; + warning : string option; +} + + +(** {2 Basic values} *) + +val default_request_config_format : unit -> request_config_format +(** [default_request_config_format ()] is the default value for type [request_config_format] *) + +val default_request_output_format : unit -> request_output_format +(** [default_request_output_format ()] is the default value for type [request_output_format] *) + +val default_request_status : unit +(** [default_request_status ()] is the default value for type [request_status] *) + +val default_request_setup_session : + ?client_application:string option -> + ?on_behalf_of:int32 option -> + unit -> + request_setup_session +(** [default_request_setup_session ()] is the default value for type [request_setup_session] *) + +val default_request_teardown : + ?on_behalf_of:int32 option -> + unit -> + request_teardown +(** [default_request_teardown ()] is the default value for type [request_teardown] *) + +val default_request_validate : + ?path:string list -> + ?output_format:request_output_format option -> + unit -> + request_validate +(** [default_request_validate ()] is the default value for type [request_validate] *) + +val default_request_set : + ?path:string list -> + ?ephemeral:bool option -> + unit -> + request_set +(** [default_request_set ()] is the default value for type [request_set] *) + +val default_request_delete : + ?path:string list -> + unit -> + request_delete +(** [default_request_delete ()] is the default value for type [request_delete] *) + +val default_request_rename : + ?edit_level:string list -> + ?from:string -> + ?to_:string -> + unit -> + request_rename +(** [default_request_rename ()] is the default value for type [request_rename] *) + +val default_request_copy : + ?edit_level:string list -> + ?from:string -> + ?to_:string -> + unit -> + request_copy +(** [default_request_copy ()] is the default value for type [request_copy] *) + +val default_request_comment : + ?path:string list -> + ?comment:string -> + unit -> + request_comment +(** [default_request_comment ()] is the default value for type [request_comment] *) + +val default_request_commit : + ?confirm:bool option -> + ?confirm_timeout:int32 option -> + ?comment:string option -> + unit -> + request_commit +(** [default_request_commit ()] is the default value for type [request_commit] *) + +val default_request_rollback : + ?revision:int32 -> + unit -> + request_rollback +(** [default_request_rollback ()] is the default value for type [request_rollback] *) + +val default_request_load : + ?location:string -> + ?format:request_config_format option -> + unit -> + request_load +(** [default_request_load ()] is the default value for type [request_load] *) + +val default_request_merge : + ?location:string -> + ?format:request_config_format option -> + unit -> + request_merge +(** [default_request_merge ()] is the default value for type [request_merge] *) + +val default_request_save : + ?location:string -> + ?format:request_config_format option -> + unit -> + request_save +(** [default_request_save ()] is the default value for type [request_save] *) + +val default_request_show_config : + ?path:string list -> + ?format:request_config_format option -> + unit -> + request_show_config +(** [default_request_show_config ()] is the default value for type [request_show_config] *) + +val default_request_exists : + ?path:string list -> + unit -> + request_exists +(** [default_request_exists ()] is the default value for type [request_exists] *) + +val default_request_get_value : + ?path:string list -> + ?output_format:request_output_format option -> + unit -> + request_get_value +(** [default_request_get_value ()] is the default value for type [request_get_value] *) + +val default_request_get_values : + ?path:string list -> + ?output_format:request_output_format option -> + unit -> + request_get_values +(** [default_request_get_values ()] is the default value for type [request_get_values] *) + +val default_request_list_children : + ?path:string list -> + ?output_format:request_output_format option -> + unit -> + request_list_children +(** [default_request_list_children ()] is the default value for type [request_list_children] *) + +val default_request_run_op_mode : + ?path:string list -> + ?output_format:request_output_format option -> + unit -> + request_run_op_mode +(** [default_request_run_op_mode ()] is the default value for type [request_run_op_mode] *) + +val default_request_confirm : unit +(** [default_request_confirm ()] is the default value for type [request_confirm] *) + +val default_request_enter_configuration_mode : + ?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] *) + +val default_request_exit_configuration_mode : unit +(** [default_request_exit_configuration_mode ()] is the default value for type [request_exit_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] *) + +val default_response : + ?status:status -> + ?output:string option -> + ?error:string option -> + ?warning:string option -> + unit -> + response +(** [default_response ()] is the default value for type [response] *) + + +(** {2 Formatters} *) + +val pp_request_config_format : Format.formatter -> request_config_format -> unit +(** [pp_request_config_format v] formats v *) + +val pp_request_output_format : Format.formatter -> request_output_format -> unit +(** [pp_request_output_format v] formats v *) + +val pp_request_status : Format.formatter -> request_status -> unit +(** [pp_request_status v] formats v *) + +val pp_request_setup_session : Format.formatter -> request_setup_session -> unit +(** [pp_request_setup_session v] formats v *) + +val pp_request_teardown : Format.formatter -> request_teardown -> unit +(** [pp_request_teardown v] formats v *) + +val pp_request_validate : Format.formatter -> request_validate -> unit +(** [pp_request_validate v] formats v *) + +val pp_request_set : Format.formatter -> request_set -> unit +(** [pp_request_set v] formats v *) + +val pp_request_delete : Format.formatter -> request_delete -> unit +(** [pp_request_delete v] formats v *) + +val pp_request_rename : Format.formatter -> request_rename -> unit +(** [pp_request_rename v] formats v *) + +val pp_request_copy : Format.formatter -> request_copy -> unit +(** [pp_request_copy v] formats v *) + +val pp_request_comment : Format.formatter -> request_comment -> unit +(** [pp_request_comment v] formats v *) + +val pp_request_commit : Format.formatter -> request_commit -> unit +(** [pp_request_commit v] formats v *) + +val pp_request_rollback : Format.formatter -> request_rollback -> unit +(** [pp_request_rollback v] formats v *) + +val pp_request_load : Format.formatter -> request_load -> unit +(** [pp_request_load v] formats v *) + +val pp_request_merge : Format.formatter -> request_merge -> unit +(** [pp_request_merge v] formats v *) + +val pp_request_save : Format.formatter -> request_save -> unit +(** [pp_request_save v] formats v *) + +val pp_request_show_config : Format.formatter -> request_show_config -> unit +(** [pp_request_show_config v] formats v *) + +val pp_request_exists : Format.formatter -> request_exists -> unit +(** [pp_request_exists v] formats v *) + +val pp_request_get_value : Format.formatter -> request_get_value -> unit +(** [pp_request_get_value v] formats v *) + +val pp_request_get_values : Format.formatter -> request_get_values -> unit +(** [pp_request_get_values v] formats v *) + +val pp_request_list_children : Format.formatter -> request_list_children -> unit +(** [pp_request_list_children v] formats v *) + +val pp_request_run_op_mode : Format.formatter -> request_run_op_mode -> unit +(** [pp_request_run_op_mode v] formats v *) + +val pp_request_confirm : Format.formatter -> request_confirm -> unit +(** [pp_request_confirm v] formats v *) + +val pp_request_enter_configuration_mode : Format.formatter -> request_enter_configuration_mode -> unit +(** [pp_request_enter_configuration_mode v] formats v *) + +val pp_request_exit_configuration_mode : Format.formatter -> request_exit_configuration_mode -> unit +(** [pp_request_exit_configuration_mode v] formats v *) + +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 *) + +val pp_response : Format.formatter -> response -> unit +(** [pp_response v] formats v *) + + +(** {2 Protobuf Encoding} *) + +val encode_pb_request_config_format : request_config_format -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_config_format v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_output_format : request_output_format -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_output_format v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_status : request_status -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_status v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_setup_session : request_setup_session -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_setup_session v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_teardown : request_teardown -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_teardown v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_validate : request_validate -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_validate v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_set : request_set -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_set v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_delete : request_delete -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_delete v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_rename : request_rename -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_rename v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_copy : request_copy -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_copy v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_comment : request_comment -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_comment v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_commit : request_commit -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_commit v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_rollback : request_rollback -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_rollback v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_load : request_load -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_load v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_merge : request_merge -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_merge v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_save : request_save -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_save v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_show_config : request_show_config -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_show_config v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_exists : request_exists -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_exists v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_get_value : request_get_value -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_get_value v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_get_values : request_get_values -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_get_values v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_list_children : request_list_children -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_list_children v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_run_op_mode : request_run_op_mode -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_run_op_mode v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_confirm : request_confirm -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_confirm v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_enter_configuration_mode : request_enter_configuration_mode -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_enter_configuration_mode v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_exit_configuration_mode : request_exit_configuration_mode -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_exit_configuration_mode v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request : request -> Pbrt.Encoder.t -> unit +(** [encode_pb_request v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_request_envelope : request_envelope -> Pbrt.Encoder.t -> unit +(** [encode_pb_request_envelope v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_status : status -> Pbrt.Encoder.t -> unit +(** [encode_pb_status v encoder] encodes [v] with the given [encoder] *) + +val encode_pb_response : response -> Pbrt.Encoder.t -> unit +(** [encode_pb_response v encoder] encodes [v] with the given [encoder] *) + + +(** {2 Protobuf Decoding} *) + +val decode_pb_request_config_format : Pbrt.Decoder.t -> request_config_format +(** [decode_pb_request_config_format decoder] decodes a [request_config_format] binary value from [decoder] *) + +val decode_pb_request_output_format : Pbrt.Decoder.t -> request_output_format +(** [decode_pb_request_output_format decoder] decodes a [request_output_format] binary value from [decoder] *) + +val decode_pb_request_status : Pbrt.Decoder.t -> request_status +(** [decode_pb_request_status decoder] decodes a [request_status] binary value from [decoder] *) + +val decode_pb_request_setup_session : Pbrt.Decoder.t -> request_setup_session +(** [decode_pb_request_setup_session decoder] decodes a [request_setup_session] binary value from [decoder] *) + +val decode_pb_request_teardown : Pbrt.Decoder.t -> request_teardown +(** [decode_pb_request_teardown decoder] decodes a [request_teardown] binary value from [decoder] *) + +val decode_pb_request_validate : Pbrt.Decoder.t -> request_validate +(** [decode_pb_request_validate decoder] decodes a [request_validate] binary value from [decoder] *) + +val decode_pb_request_set : Pbrt.Decoder.t -> request_set +(** [decode_pb_request_set decoder] decodes a [request_set] binary value from [decoder] *) + +val decode_pb_request_delete : Pbrt.Decoder.t -> request_delete +(** [decode_pb_request_delete decoder] decodes a [request_delete] binary value from [decoder] *) + +val decode_pb_request_rename : Pbrt.Decoder.t -> request_rename +(** [decode_pb_request_rename decoder] decodes a [request_rename] binary value from [decoder] *) + +val decode_pb_request_copy : Pbrt.Decoder.t -> request_copy +(** [decode_pb_request_copy decoder] decodes a [request_copy] binary value from [decoder] *) + +val decode_pb_request_comment : Pbrt.Decoder.t -> request_comment +(** [decode_pb_request_comment decoder] decodes a [request_comment] binary value from [decoder] *) + +val decode_pb_request_commit : Pbrt.Decoder.t -> request_commit +(** [decode_pb_request_commit decoder] decodes a [request_commit] binary value from [decoder] *) + +val decode_pb_request_rollback : Pbrt.Decoder.t -> request_rollback +(** [decode_pb_request_rollback decoder] decodes a [request_rollback] binary value from [decoder] *) + +val decode_pb_request_load : Pbrt.Decoder.t -> request_load +(** [decode_pb_request_load decoder] decodes a [request_load] binary value from [decoder] *) + +val decode_pb_request_merge : Pbrt.Decoder.t -> request_merge +(** [decode_pb_request_merge decoder] decodes a [request_merge] binary value from [decoder] *) + +val decode_pb_request_save : Pbrt.Decoder.t -> request_save +(** [decode_pb_request_save decoder] decodes a [request_save] binary value from [decoder] *) + +val decode_pb_request_show_config : Pbrt.Decoder.t -> request_show_config +(** [decode_pb_request_show_config decoder] decodes a [request_show_config] binary value from [decoder] *) + +val decode_pb_request_exists : Pbrt.Decoder.t -> request_exists +(** [decode_pb_request_exists decoder] decodes a [request_exists] binary value from [decoder] *) + +val decode_pb_request_get_value : Pbrt.Decoder.t -> request_get_value +(** [decode_pb_request_get_value decoder] decodes a [request_get_value] binary value from [decoder] *) + +val decode_pb_request_get_values : Pbrt.Decoder.t -> request_get_values +(** [decode_pb_request_get_values decoder] decodes a [request_get_values] binary value from [decoder] *) + +val decode_pb_request_list_children : Pbrt.Decoder.t -> request_list_children +(** [decode_pb_request_list_children decoder] decodes a [request_list_children] binary value from [decoder] *) + +val decode_pb_request_run_op_mode : Pbrt.Decoder.t -> request_run_op_mode +(** [decode_pb_request_run_op_mode decoder] decodes a [request_run_op_mode] binary value from [decoder] *) + +val decode_pb_request_confirm : Pbrt.Decoder.t -> request_confirm +(** [decode_pb_request_confirm decoder] decodes a [request_confirm] binary value from [decoder] *) + +val decode_pb_request_enter_configuration_mode : Pbrt.Decoder.t -> request_enter_configuration_mode +(** [decode_pb_request_enter_configuration_mode decoder] decodes a [request_enter_configuration_mode] binary value from [decoder] *) + +val decode_pb_request_exit_configuration_mode : Pbrt.Decoder.t -> request_exit_configuration_mode +(** [decode_pb_request_exit_configuration_mode decoder] decodes a [request_exit_configuration_mode] binary value from [decoder] *) + +val decode_pb_request : Pbrt.Decoder.t -> request +(** [decode_pb_request decoder] decodes a [request] binary value from [decoder] *) + +val decode_pb_request_envelope : Pbrt.Decoder.t -> request_envelope +(** [decode_pb_request_envelope decoder] decodes a [request_envelope] binary value from [decoder] *) + +val decode_pb_status : Pbrt.Decoder.t -> status +(** [decode_pb_status decoder] decodes a [status] binary value from [decoder] *) + +val decode_pb_response : Pbrt.Decoder.t -> response +(** [decode_pb_response decoder] decodes a [response] binary value from [decoder] *) diff --git a/src/vyconf_types.ml b/src/vyconf_types.ml deleted file mode 100644 index f7e5d50..0000000 --- a/src/vyconf_types.ml +++ /dev/null @@ -1,318 +0,0 @@ -[@@@ocaml.warning "-27-30-39"] - - -type request_config_format = - | Curly - | Json - -type request_output_format = - | Out_plain - | Out_json - -type request_setup_session = { - client_application : string option; - on_behalf_of : int32 option; -} - -type request_set = { - path : string list; - ephemeral : bool option; -} - -type request_delete = { - path : string list; -} - -type request_rename = { - edit_level : string list; - from : string; - to_ : string; -} - -type request_copy = { - edit_level : string list; - from : string; - to_ : string; -} - -type request_comment = { - path : string list; - comment : string; -} - -type request_commit = { - confirm : bool option; - confirm_timeout : int32 option; - comment : string option; -} - -type request_rollback = { - revision : int32; -} - -type request_load = { - location : string; - format : request_config_format option; -} - -type request_merge = { - location : string; - format : request_config_format option; -} - -type request_save = { - location : string; - format : request_config_format option; -} - -type request_show_config = { - path : string list; - format : request_config_format option; -} - -type request_exists = { - path : string list; -} - -type request_get_value = { - path : string list; - output_format : request_output_format option; -} - -type request_get_values = { - path : string list; - output_format : request_output_format option; -} - -type request_list_children = { - path : string list; - output_format : request_output_format option; -} - -type request_run_op_mode = { - path : string list; - output_format : request_output_format option; -} - -type request_enter_configuration_mode = { - exclusive : bool; - override_exclusive : bool; -} - -type request = - | Status - | Setup_session of request_setup_session - | Set of request_set - | Delete of request_delete - | Rename of request_rename - | Copy of request_copy - | Comment of request_comment - | Commit of request_commit - | Rollback of request_rollback - | Merge of request_merge - | Save of request_save - | Show_config of request_show_config - | Exists of request_exists - | Get_value of request_get_value - | Get_values of request_get_values - | List_children of request_list_children - | 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 - | Fail - | Invalid_path - | Invalid_value - | Commit_in_progress - | Configuration_locked - | Internal_error - | Permission_denied - | Path_already_exists - -type response = { - status : status; - output : string option; - error : string option; - warning : string option; -} - -let rec default_request_config_format () = (Curly:request_config_format) - -let rec default_request_output_format () = (Out_plain:request_output_format) - -let rec default_request_setup_session - ?client_application:((client_application:string option) = None) - ?on_behalf_of:((on_behalf_of:int32 option) = None) - () : request_setup_session = { - client_application; - on_behalf_of; -} - -let rec default_request_set - ?path:((path:string list) = []) - ?ephemeral:((ephemeral:bool option) = None) - () : request_set = { - path; - ephemeral; -} - -let rec default_request_delete - ?path:((path:string list) = []) - () : request_delete = { - path; -} - -let rec default_request_rename - ?edit_level:((edit_level:string list) = []) - ?from:((from:string) = "") - ?to_:((to_:string) = "") - () : request_rename = { - edit_level; - from; - to_; -} - -let rec default_request_copy - ?edit_level:((edit_level:string list) = []) - ?from:((from:string) = "") - ?to_:((to_:string) = "") - () : request_copy = { - edit_level; - from; - to_; -} - -let rec default_request_comment - ?path:((path:string list) = []) - ?comment:((comment:string) = "") - () : request_comment = { - path; - comment; -} - -let rec default_request_commit - ?confirm:((confirm:bool option) = None) - ?confirm_timeout:((confirm_timeout:int32 option) = None) - ?comment:((comment:string option) = None) - () : request_commit = { - confirm; - confirm_timeout; - comment; -} - -let rec default_request_rollback - ?revision:((revision:int32) = 0l) - () : request_rollback = { - revision; -} - -let rec default_request_load - ?location:((location:string) = "") - ?format:((format:request_config_format option) = None) - () : request_load = { - location; - format; -} - -let rec default_request_merge - ?location:((location:string) = "") - ?format:((format:request_config_format option) = None) - () : request_merge = { - location; - format; -} - -let rec default_request_save - ?location:((location:string) = "") - ?format:((format:request_config_format option) = None) - () : request_save = { - location; - format; -} - -let rec default_request_show_config - ?path:((path:string list) = []) - ?format:((format:request_config_format option) = None) - () : request_show_config = { - path; - format; -} - -let rec default_request_exists - ?path:((path:string list) = []) - () : request_exists = { - path; -} - -let rec default_request_get_value - ?path:((path:string list) = []) - ?output_format:((output_format:request_output_format option) = None) - () : request_get_value = { - path; - output_format; -} - -let rec default_request_get_values - ?path:((path:string list) = []) - ?output_format:((output_format:request_output_format option) = None) - () : request_get_values = { - path; - output_format; -} - -let rec default_request_list_children - ?path:((path:string list) = []) - ?output_format:((output_format:request_output_format option) = None) - () : request_list_children = { - path; - output_format; -} - -let rec default_request_run_op_mode - ?path:((path:string list) = []) - ?output_format:((output_format:request_output_format option) = None) - () : request_run_op_mode = { - path; - output_format; -} - -let rec default_request_enter_configuration_mode - ?exclusive:((exclusive:bool) = false) - ?override_exclusive:((override_exclusive:bool) = false) - () : request_enter_configuration_mode = { - exclusive; - override_exclusive; -} - -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; -} - -let rec default_status () = (Success:status) - -let rec default_response - ?status:((status:status) = default_status ()) - ?output:((output:string option) = None) - ?error:((error:string option) = None) - ?warning:((warning:string option) = None) - () : response = { - status; - output; - error; - warning; -} diff --git a/src/vyconf_types.mli b/src/vyconf_types.mli deleted file mode 100644 index 194d66c..0000000 --- a/src/vyconf_types.mli +++ /dev/null @@ -1,306 +0,0 @@ -(** vyconf.proto Types *) - - - -(** {2 Types} *) - -type request_config_format = - | Curly - | Json - -type request_output_format = - | Out_plain - | Out_json - -type request_setup_session = { - client_application : string option; - on_behalf_of : int32 option; -} - -type request_set = { - path : string list; - ephemeral : bool option; -} - -type request_delete = { - path : string list; -} - -type request_rename = { - edit_level : string list; - from : string; - to_ : string; -} - -type request_copy = { - edit_level : string list; - from : string; - to_ : string; -} - -type request_comment = { - path : string list; - comment : string; -} - -type request_commit = { - confirm : bool option; - confirm_timeout : int32 option; - comment : string option; -} - -type request_rollback = { - revision : int32; -} - -type request_load = { - location : string; - format : request_config_format option; -} - -type request_merge = { - location : string; - format : request_config_format option; -} - -type request_save = { - location : string; - format : request_config_format option; -} - -type request_show_config = { - path : string list; - format : request_config_format option; -} - -type request_exists = { - path : string list; -} - -type request_get_value = { - path : string list; - output_format : request_output_format option; -} - -type request_get_values = { - path : string list; - output_format : request_output_format option; -} - -type request_list_children = { - path : string list; - output_format : request_output_format option; -} - -type request_run_op_mode = { - path : string list; - output_format : request_output_format option; -} - -type request_enter_configuration_mode = { - exclusive : bool; - override_exclusive : bool; -} - -type request = - | Status - | Setup_session of request_setup_session - | Set of request_set - | Delete of request_delete - | Rename of request_rename - | Copy of request_copy - | Comment of request_comment - | Commit of request_commit - | Rollback of request_rollback - | Merge of request_merge - | Save of request_save - | Show_config of request_show_config - | Exists of request_exists - | Get_value of request_get_value - | Get_values of request_get_values - | List_children of request_list_children - | 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 - | Fail - | Invalid_path - | Invalid_value - | Commit_in_progress - | Configuration_locked - | Internal_error - | Permission_denied - | Path_already_exists - -type response = { - status : status; - output : string option; - error : string option; - warning : string option; -} - - -(** {2 Default values} *) - -val default_request_config_format : unit -> request_config_format -(** [default_request_config_format ()] is the default value for type [request_config_format] *) - -val default_request_output_format : unit -> request_output_format -(** [default_request_output_format ()] is the default value for type [request_output_format] *) - -val default_request_setup_session : - ?client_application:string option -> - ?on_behalf_of:int32 option -> - unit -> - request_setup_session -(** [default_request_setup_session ()] is the default value for type [request_setup_session] *) - -val default_request_set : - ?path:string list -> - ?ephemeral:bool option -> - unit -> - request_set -(** [default_request_set ()] is the default value for type [request_set] *) - -val default_request_delete : - ?path:string list -> - unit -> - request_delete -(** [default_request_delete ()] is the default value for type [request_delete] *) - -val default_request_rename : - ?edit_level:string list -> - ?from:string -> - ?to_:string -> - unit -> - request_rename -(** [default_request_rename ()] is the default value for type [request_rename] *) - -val default_request_copy : - ?edit_level:string list -> - ?from:string -> - ?to_:string -> - unit -> - request_copy -(** [default_request_copy ()] is the default value for type [request_copy] *) - -val default_request_comment : - ?path:string list -> - ?comment:string -> - unit -> - request_comment -(** [default_request_comment ()] is the default value for type [request_comment] *) - -val default_request_commit : - ?confirm:bool option -> - ?confirm_timeout:int32 option -> - ?comment:string option -> - unit -> - request_commit -(** [default_request_commit ()] is the default value for type [request_commit] *) - -val default_request_rollback : - ?revision:int32 -> - unit -> - request_rollback -(** [default_request_rollback ()] is the default value for type [request_rollback] *) - -val default_request_load : - ?location:string -> - ?format:request_config_format option -> - unit -> - request_load -(** [default_request_load ()] is the default value for type [request_load] *) - -val default_request_merge : - ?location:string -> - ?format:request_config_format option -> - unit -> - request_merge -(** [default_request_merge ()] is the default value for type [request_merge] *) - -val default_request_save : - ?location:string -> - ?format:request_config_format option -> - unit -> - request_save -(** [default_request_save ()] is the default value for type [request_save] *) - -val default_request_show_config : - ?path:string list -> - ?format:request_config_format option -> - unit -> - request_show_config -(** [default_request_show_config ()] is the default value for type [request_show_config] *) - -val default_request_exists : - ?path:string list -> - unit -> - request_exists -(** [default_request_exists ()] is the default value for type [request_exists] *) - -val default_request_get_value : - ?path:string list -> - ?output_format:request_output_format option -> - unit -> - request_get_value -(** [default_request_get_value ()] is the default value for type [request_get_value] *) - -val default_request_get_values : - ?path:string list -> - ?output_format:request_output_format option -> - unit -> - request_get_values -(** [default_request_get_values ()] is the default value for type [request_get_values] *) - -val default_request_list_children : - ?path:string list -> - ?output_format:request_output_format option -> - unit -> - request_list_children -(** [default_request_list_children ()] is the default value for type [request_list_children] *) - -val default_request_run_op_mode : - ?path:string list -> - ?output_format:request_output_format option -> - unit -> - 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 -> - ?override_exclusive:bool -> - unit -> - request_enter_configuration_mode -(** [default_request_enter_configuration_mode ()] is the default value for type [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] *) - -val default_response : - ?status:status -> - ?output:string option -> - ?error:string option -> - ?warning:string option -> - unit -> - response -(** [default_response ()] is the default value for type [response] *) diff --git a/src/vyconfd.ml b/src/vyconfd.ml index d79bda9..7c4caeb 100644 --- a/src/vyconfd.ml +++ b/src/vyconfd.ml @@ -1,10 +1,14 @@ open Lwt -open Defaults -open Vyconf_config -open Vyconf_pb -open Vyconf_types + +open Vyconf_connect.Vyconf_pbt +open Vyconfd_config.Defaults +open Vyconfd_config.Vyconf_config module FP = FilePath +module CT = Vyos1x.Config_tree +module Gen = Vyos1x.Generate +module Session = Vyconfd_config.Session +module Directories = Vyconfd_config.Directories (* On UNIX, self_init uses /dev/random for seed *) let () = Random.self_init () @@ -43,7 +47,7 @@ let make_session_token () = let setup_session world req = let token = make_session_token () in let user = "unknown user" in - let client_app = BatOption.default "unknown client" req.client_application in + let client_app = Option.value req.client_application ~default:"unknown client" in let () = Hashtbl.add sessions token (Session.make world client_app user) in {response_tmpl with output=(Some token)} @@ -80,10 +84,10 @@ let exit_conf_mode world token = in Hashtbl.replace sessions token session; response_tmpl -let teardown_session token = +let teardown token = try Hashtbl.remove sessions token; - response_tmpl + {response_tmpl with status=Success} with Not_found -> {response_tmpl with status=Fail; error=(Some "Session not found")} @@ -93,9 +97,9 @@ let exists world token (req: request_exists) = let get_value world token (req: request_get_value) = try - let () = (Lwt_log.debug @@ Printf.sprintf "[%s]\n" (Util.string_of_list req.path)) |> Lwt.ignore_result in + let () = (Lwt_log.debug @@ Printf.sprintf "[%s]\n" (Vyos1x.Util.string_of_list req.path)) |> Lwt.ignore_result in let value = Session.get_value world (find_session token) req.path in - let fmt = BatOption.default Out_plain req.output_format in + let fmt = Option.value req.output_format ~default:Out_plain in let value_str = (match fmt with | Out_plain -> value @@ -106,45 +110,52 @@ let get_value world token (req: request_get_value) = let get_values world token (req: request_get_values) = try let values = Session.get_values world (find_session token) req.path in - let fmt = BatOption.default Out_plain req.output_format in + let fmt = Option.value req.output_format ~default:Out_plain in let values_str = (match fmt with - | Out_plain -> Util.string_of_list @@ List.map (Printf.sprintf "\'%s\'") values - | Out_json -> Util.json_of_list values) + | Out_plain -> Vyos1x.Util.string_of_list @@ List.map (Printf.sprintf "\'%s\'") values + | Out_json -> Vyos1x.Util.json_of_list values) in {response_tmpl with output=(Some values_str)} with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)} let list_children world token (req: request_list_children) = try let children = Session.list_children world (find_session token) req.path in - let fmt = BatOption.default Out_plain req.output_format in + let fmt = Option.value req.output_format ~default:Out_plain in let children_str = (match fmt with - | Out_plain -> Util.string_of_list @@ List.map (Printf.sprintf "\'%s\'") children - | Out_json -> Util.json_of_list children) + | Out_plain -> Vyos1x.Util.string_of_list @@ List.map (Printf.sprintf "\'%s\'") children + | Out_json -> Vyos1x.Util.json_of_list children) in {response_tmpl with output=(Some children_str)} with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)} let show_config world token (req: request_show_config) = try - let fmt = BatOption.default Curly req.format in + let fmt = Option.value req.format ~default:Curly in let conf_str = Session.show_config world (find_session token) req.path fmt in {response_tmpl with output=(Some conf_str)} with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)} +let validate world token (req: request_validate) = + try + let () = (Lwt_log.debug @@ Printf.sprintf "[%s]\n" (Vyos1x.Util.string_of_list req.path)) |> Lwt.ignore_result in + let () = Session.validate world (find_session token) req.path in + response_tmpl + with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)} + let send_response oc resp = let enc = Pbrt.Encoder.create () in - let%lwt () = encode_response resp enc |> return in + let%lwt () = encode_pb_response resp enc |> return in let%lwt resp_msg = Pbrt.Encoder.to_bytes enc |> return in - let%lwt () = Message.write oc resp_msg in + let%lwt () = Vyconf_connect.Message.write oc resp_msg in Lwt.return () -let rec handle_connection world ic oc fd () = +let rec handle_connection world ic oc () = try%lwt - let%lwt req_msg = Message.read ic in + let%lwt req_msg = Vyconf_connect.Message.read ic in let%lwt req = try - let envelope = decode_request_envelope (Pbrt.Decoder.of_bytes req_msg) in + let envelope = decode_pb_request_envelope (Pbrt.Decoder.of_bytes req_msg) in Lwt.return (Ok (envelope.token, envelope.request)) with Pbrt.Decoder.Failure e -> Lwt.return (Error (Pbrt.Decoder.error_to_string e)) in @@ -157,7 +168,7 @@ let rec handle_connection world ic oc fd () = | _, 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, Teardown _ -> teardown t | Some t, Configure r -> enter_conf_mode r t | Some t, Exit_configure -> exit_conf_mode world t | Some t, Exists r -> exists world t r @@ -165,28 +176,29 @@ let rec handle_connection world ic oc fd () = | Some t, Get_values r -> get_values world t r | Some t, List_children r -> list_children world t r | Some t, Show_config r -> show_config world t r + | Some t, Validate r -> validate world t r | _ -> failwith "Unimplemented" end) |> Lwt.return in let%lwt () = send_response oc resp in - handle_connection world ic oc fd () + handle_connection world ic oc () with | Failure e -> let%lwt () = Lwt_log.error e in let%lwt () = send_response oc ({response_tmpl with status=Fail; error=(Some e)}) in - handle_connection world ic oc fd () - | End_of_file -> Lwt_log.info "Connection closed" >>= return + handle_connection world ic oc () + | End_of_file -> Lwt_log.info "Connection closed" >>= (fun () -> Lwt_io.close ic) >>= return 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 world ic oc fd ()) (fun e -> Lwt_log.ign_error (Printexc.to_string e)); + let ic = Lwt_io.of_fd ~mode:Lwt_io.Input fd in + let oc = Lwt_io.of_fd ~mode:Lwt_io.Output fd in + 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 basepath world () = let open Session in - let log_file = BatOption.bind !log_file (fun s -> Some (FP.concat basepath s)) in + let log_file = Option.bind !log_file (fun s -> Some (FP.concat basepath s)) 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 (FP.concat basepath world.vyconf_config.socket) in @@ -194,29 +206,33 @@ let main_loop basepath world () = serve () let load_interface_definitions dir = - let open Session in - let reftree = Startup.load_interface_definitions dir in + let reftree = Gen.load_interface_definitions dir in + match reftree with + | Ok r -> r + | Error s -> Startup.panic s + +let read_reference_tree file = + let reftree = Startup.read_reference_tree file 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 + (* the reference_tree json file is generated at vyos-1x build time *) + let reftree = read_reference_tree (FP.concat config.config_dir config.reference_tree) in + let running_config = CT.make "" in {running_config=running_config; reference_tree=reftree; vyconf_config=config; dirs=dirs} let () = - let () = Arg.parse args (fun f -> ()) usage in + let () = Arg.parse args (fun _ -> ()) usage in let vc = Startup.load_daemon_config !config_file in let () = Lwt_log.load_rules ("* -> " ^ vc.log_level) in let dirs = Directories.make !basepath vc in - Startup.check_dirs dirs; + Startup.check_validators_dir dirs; let world = make_world vc dirs in let config = Startup.load_config_failsafe (FP.concat vc.config_dir vc.primary_config) (FP.concat vc.config_dir vc.fallback_config) in let world = Session.{world with running_config=config} in - let () = print_endline (Config_tree.render world.running_config) in Lwt_main.run @@ main_loop !basepath world () diff --git a/src/vylist.ml b/src/vylist.ml deleted file mode 100644 index cd4a32e..0000000 --- a/src/vylist.ml +++ /dev/null @@ -1,46 +0,0 @@ -let rec find p xs = - match xs with - | [] -> None - | y :: ys -> if (p y) then (Some y) - else find p ys - -let rec remove p xs = - match xs with - | [] -> [] - | y :: ys -> if (p y) then ys - else y :: (remove p ys) - -let rec replace p x xs = - match xs with - | [] -> raise Not_found - | y :: ys -> if (p y) then x :: ys - else y :: (replace p x ys) - -let rec insert_before p x xs = - match xs with - | [] -> raise Not_found - | y :: ys -> if (p y) then x :: y :: ys - else y :: (insert_before p x ys) - -let rec insert_after p x xs = - match xs with - | [] -> raise Not_found - | y :: ys -> if (p y) then y :: x :: ys - else y :: (insert_after p x ys) - -let complement xs ys = - let rec aux xs ys = - match xs, ys with - | [], _ -> ys - | _, [] -> assert false (* Can't happen *) - | p :: ps, q :: qs -> if p = q then aux ps qs - else [] - in - if List.length xs < List.length ys then aux xs ys - else aux ys xs - -let in_list xs x = - let x' = find ((=) x) xs in - match x' with - | None -> false - | Some _ -> true diff --git a/src/vylist.mli b/src/vylist.mli deleted file mode 100644 index 9135bf6..0000000 --- a/src/vylist.mli +++ /dev/null @@ -1,7 +0,0 @@ -val find : ('a -> bool) -> 'a list -> 'a option -val remove : ('a -> bool) -> 'a list -> 'a list -val replace : ('a -> bool) -> 'a -> 'a list -> 'a list -val insert_before : ('a -> bool) -> 'a -> 'a list -> 'a list -val insert_after : ('a -> bool) -> 'a -> 'a list -> 'a list -val complement : 'a list -> 'a list -> 'a list -val in_list : 'a list -> 'a -> bool diff --git a/src/vytree.ml b/src/vytree.ml deleted file mode 100644 index a3e2750..0000000 --- a/src/vytree.ml +++ /dev/null @@ -1,192 +0,0 @@ -type 'a t = { - name: string; - data: 'a; - children: 'a t list -} [@@deriving yojson] - -type position = Before of string | After of string | End | Default - -exception Empty_path -exception Duplicate_child -exception Nonexistent_path -exception Insert_error of string - -let make data name = { name = name; data = data; children = [] } - -let make_full data name children = { name = name; data = data; children = children } - -let name_of_node node = node.name -let data_of_node node = node.data -let children_of_node node = node.children - -let insert_immediate ?(position=Default) node name data children = - let new_node = make_full data name children in - let children' = - match position with - | Default -> new_node :: node.children - | End -> node.children @ [new_node] - | Before s -> Vylist.insert_before (fun x -> x.name = s) new_node node.children - | After s -> Vylist.insert_after (fun x -> x.name = s) new_node node.children - in { node with children = children' } - -let delete_immediate node name = - let children' = Vylist.remove (fun x -> x.name = name) node.children in - { node with children = children' } - -let adopt node child = - { node with children = child :: node.children } - -let replace node child = - let children = node.children in - let name = child.name in - let children' = Vylist.replace (fun x -> x.name = name) child children in - { node with children = children' } - -let replace_full node child name = - let children = node.children in - let children' = Vylist.replace (fun x -> x.name = name) child children in - { node with children = children' } - -let find node name = - Vylist.find (fun x -> x.name = name) node.children - -let find_or_fail node name = - let child = find node name in - match child with - | None -> raise Nonexistent_path - | Some child' -> child' - -let list_children node = - List.map (fun x -> x.name) node.children - -let rec do_with_child fn node path = - match path with - | [] -> raise Empty_path - | [name] -> fn node name - | name :: names -> - let next_child = find_or_fail node name in - let new_node = do_with_child fn next_child names in - replace node new_node - -let rec insert ?(position=Default) ?(children=[]) node path data = - match path with - | [] -> raise Empty_path - | [name] -> - (let last_child = find node name in - match last_child with - | None -> insert_immediate ~position:position node name data children - | (Some _) -> raise Duplicate_child) - | name :: names -> - let next_child = find node name in - match next_child with - | Some next_child' -> - let new_node = insert ~position:position ~children:children next_child' names data in - replace node new_node - | None -> - raise (Insert_error "Path does not exist") - -(** Given a node N check if it has children with duplicate names, - and merge subsequent children's children into the first child by - that name. - - While all insert functions maintain the "every child has unique name" - invariant, for nodes constructed manually with make/make_full and adopt - it may not hold, and constructing nodes this way is a sensible approach - for config parsing. Depending on the config format, duplicate node names - may be normal and even expected, such as "ethernet eth0" and "ethernet eth1" - in the "curly" format. - *) -let merge_children merge_data node = - (* Given a node N and a list of nodes NS, find all nodes in NS that - have the same name as N and merge their children into N *) - let rec merge_into n ns = - match ns with - | [] -> n - | n' :: ns' -> - if n.name = n'.name then - let children = List.append n.children n'.children in - let data = merge_data n.data n'.data in - let n = {n with children=children; data=data} in - merge_into n ns' - else merge_into n ns' - in - (* Given a list of nodes, for every node, find subsequent children with - the same name and merge them into the first node, then delete remaining - nodes from the list *) - let rec aux ns = - match ns with - | [] -> [] - | n :: ns -> - let n = merge_into n ns in - let ns = List.filter (fun x -> x.name <> n.name) ns in - n :: (aux ns) - in {node with children=(aux node.children)} - -(* When inserting at a path that, entirely or partially, - does not exist yet, create missing nodes on the way with default data *) -let rec insert_multi_level default_data node path_done path_remaining data = - match path_remaining with - | [] | [_] -> insert node (path_done @ path_remaining) data - | name :: names -> - let path_done = path_done @ [name] in - let node = insert node path_done default_data in - insert_multi_level default_data node path_done names data - -let delete node path = - do_with_child delete_immediate node path - -let rename node path newname = - let rename_immediate newname' node' name' = - let child = find_or_fail node' name' in - let child = { child with name=newname' } in - replace_full node' child name' - in do_with_child (rename_immediate newname) node path - -let update node path data = - let update_data data' node' name = - let child = find_or_fail node' name in - let child = { child with data=data' } in - replace node' child - in do_with_child (update_data data) node path - -let rec get node path = - match path with - | [] -> raise Empty_path - | [name] -> find_or_fail node name - | name :: names -> get (find_or_fail node name) names - -let get_data node path = data_of_node @@ get node path - -let exists node path = - try ignore (get node path); true - with Nonexistent_path -> false - -let get_existent_path node path = - let rec aux node path acc = - match path with - | [] -> acc - | name :: names -> - let child = find node name in - match child with - | None -> acc - | Some c -> aux c names (name :: acc) - in List.rev (aux node path []) - -let children_of_path node path = - let node' = get node path in - list_children node' - -let sorted_children_of_node cmp node = - let names = list_children node in - let names = List.sort cmp names in - List.map (find_or_fail node) names - -let copy node old_path new_path = - if exists node new_path then raise Duplicate_child else - let child = get node old_path in - insert ~position:End ~children:child.children node new_path child.data - -let move node path position = - let child = get node path in - let node = delete node path in - insert ~position:position ~children:child.children node path child.data diff --git a/src/vytree.mli b/src/vytree.mli deleted file mode 100644 index 451e130..0000000 --- a/src/vytree.mli +++ /dev/null @@ -1,50 +0,0 @@ -type 'a t [@@deriving yojson] - -exception Empty_path -exception Duplicate_child -exception Nonexistent_path -exception Insert_error of string - -type position = Before of string | After of string | End | Default - -val make : 'a -> string -> 'a t -val make_full : 'a -> string -> ('a t) list -> 'a t - -val name_of_node : 'a t -> string -val data_of_node : 'a t -> 'a -val children_of_node : 'a t -> 'a t list - -val find : 'a t -> string -> 'a t option -val find_or_fail : 'a t -> string -> 'a t - -val adopt : 'a t -> 'a t -> 'a t - -val insert : ?position:position -> ?children:('a t list) -> 'a t -> string list -> 'a -> 'a t - -val insert_multi_level : 'a -> 'a t -> string list -> string list -> 'a -> 'a t - -val merge_children : ('a -> 'a -> 'a) -> 'a t -> 'a t - -val delete : 'a t -> string list -> 'a t - -val update : 'a t -> string list -> 'a -> 'a t - -val rename : 'a t -> string list -> string -> 'a t - -val list_children : 'a t -> string list - -val get : 'a t -> string list -> 'a t - -val get_existent_path : 'a t -> string list -> string list - -val get_data : 'a t -> string list -> 'a - -val exists : 'a t -> string list -> bool - -val children_of_path : 'a t -> string list -> string list - -val sorted_children_of_node : (string -> string -> int) -> 'a t -> ('a t) list - -val copy : 'a t -> string list -> string list -> 'a t - -val move : 'a t -> string list -> position -> 'a t diff --git a/test/config_tree_test.ml b/test/config_tree_test.ml index 442c4c8..a9202f2 100644 --- a/test/config_tree_test.ml +++ b/test/config_tree_test.ml @@ -1,7 +1,10 @@ +[@@@ocaml.warning "-27"] + open OUnit2 -module VT = Vytree -module CT = Config_tree +module VT = Vyos1x.Vytree +module CT = Vyos1x.Config_tree +module RT = Vyos1x.Reference_tree (* Setting a value of a node that doesn't exist should create the node *) let test_set_create_node test_ctxt = @@ -69,6 +72,8 @@ let test_set_comment test_ctxt = let node = CT.set_comment node path (Some "comment") in assert_equal (CT.get_comment node path) (Some "comment") +(**** Properties ephemeral and inactive: not yet implemented *) +(* (* Creating a node without a value should default inactive and ephemeral to false *) let test_valueless_node_inactive_ephemeral test_ctxt = let path = ["foo"; "bar"] in @@ -77,7 +82,7 @@ let test_valueless_node_inactive_ephemeral test_ctxt = assert_equal ((not (CT.is_inactive node path)) && (not (CT.is_ephemeral node path))) true (* Setting a node inactive should work *) -let test_set_inactive test_ctxt = +let test_set_inactive test_ctxt = let path = ["foo"; "bar"] in let node = CT.make "root" in let node = CT.set node path None CT.AddValue in @@ -85,12 +90,14 @@ let test_set_inactive test_ctxt = assert_equal (CT.is_inactive node path) true (* Setting a node ephemeral should work *) -let test_set_ephemeral test_ctxt = +let test_set_ephemeral test_ctxt = let path = ["foo"; "bar"] in let node = CT.make "root" in let node = CT.set node path None CT.AddValue in let node = CT.set_ephemeral node path (true) in assert_equal (CT.is_ephemeral node path) true +*) + (*** Refactoring test setup *) let set ?(how=CT.AddValue) path value node = CT.set node path value how @@ -107,8 +114,8 @@ let toggle_in_config_tree ~how ?(path=[]) ?(value=false) = let load_reftree test_ctxt = let file_name = "interface_definition_sample.xml" in - let r = Vytree.make Reference_tree.default_data "root" in - Reference_tree.load_from_xml r (in_testdata_dir test_ctxt [file_name]) + let r = VT.make RT.default_data "root" in + RT.load_from_xml r (in_testdata_dir test_ctxt [file_name]) let foobar = ["foo"; "bar"] @@ -116,41 +123,15 @@ let foobar = ["foo"; "bar"] (**** Standalone rendering *) let test_render_nested_empty_with_comment test_ctxt = - let rendered = CT.render @@ + let rendered = CT.render_config @@ set_in_config_tree ~how:CT.set_comment ~value:"comment" ~path:foobar in - assert_equal rendered -"root { - foo { - /*comment*/ - bar { } - } -}" - -let test_render_ephemeral_hidden teset_ctxt = - let rendered = CT.render @@ - toggle_in_config_tree - ~how:CT.set_ephemeral ~value:true - ~path:foobar - in - assert_equal rendered -"root { - foo { } -}" - -let test_render_ephemeral_shown teset_ctxt = - let rendered = CT.render ~showephemeral:true @@ - toggle_in_config_tree - ~how:CT.set_ephemeral ~value:true - ~path:foobar - in - assert_equal rendered -"root { - foo { - #EPHEMERAL bar { } - } + assert_equal (String.trim rendered) +"foo { + /* comment */ + bar }" let test_render_at_level test_ctxt = @@ -160,7 +141,7 @@ let test_render_at_level test_ctxt = let rendered = CT.render_at_level node ["foo"] in assert_equal (String.trim rendered) "bar { - baz quux; + baz \"quux\" }" let test_render_at_level_top test_ctxt = @@ -172,19 +153,20 @@ let test_render_at_level_top test_ctxt = let rendered = CT.render_at_level node [] in assert_equal (String.trim rendered) "baz { - quux xyzzy; + quux \"xyzzy\" } foo { - bar quuux; + bar \"quuux\" }" -(**** Reftree-based rendering *) +(**** Reftree-based rendering: not yet implemented *) +(* let test_render_rt_tag_node test_ctxt = let reftree = load_reftree test_ctxt in let path = ["system"; "login"; "user"; "full-name"] in let node = CT.make "root" in let node = CT.set node path (Some "name here") CT.AddValue in - let rendered_curly_config = CT.render ~reftree:(Some reftree) node in + let rendered_curly_config = CT.render_config ~reftree:(Some reftree) node in let desired_rendered_form = "root { system { @@ -212,7 +194,7 @@ let test_render_rt_unspecified_node test_ctxt = }" in assert_equal rendered_curly_config desired_rendered_form - +*) let suite = "VyConf config tree tests" >::: [ "test_set_create_node" >:: test_set_create_node; @@ -223,16 +205,9 @@ let suite = "test_delete_last_value" >:: test_delete_last_value; "test_delete_subtree" >:: test_delete_subtree; "test_set_comment" >:: test_set_comment; - "test_valueless_node_inactive_ephemeral" >:: test_valueless_node_inactive_ephemeral; - "test_set_inactive" >:: test_set_inactive; - "test_set_ephemeral" >:: test_set_ephemeral; "test_render_nested_empty_with_comment" >:: test_render_nested_empty_with_comment; - "test_render_ephemeral_hidden " >:: test_render_ephemeral_hidden; - "test_render_ephemeral_shown" >:: test_render_ephemeral_shown; "test_render_at_level" >:: test_render_at_level; "test_render_at_level_top" >:: test_render_at_level_top; - "test_render_rt_tag_node" >:: test_render_rt_tag_node; - "test_render_rt_unspecified_node" >:: test_render_rt_unspecified_node ] let () = diff --git a/test/data/interface_definition_sample.xml b/test/data/interface_definition_sample.xml index c5458ff..964528d 100644 --- a/test/data/interface_definition_sample.xml +++ b/test/data/interface_definition_sample.xml @@ -6,7 +6,6 @@ <children> <tagNode name="user"> <properties> - <keepChildOrder/> <help>User name</help> <constraint> <regex>[a-zA-Z][a-zA-Z0-9\-]+</regex> diff --git a/test/dune b/test/dune new file mode 100644 index 0000000..93641a0 --- /dev/null +++ b/test/dune @@ -0,0 +1,3 @@ +(tests + (names config_tree_test reference_tree_test session_test util_test value_checker_test vyconf_config_test vylist_test vytree_load_test vytree_test) + (libraries ounit2 vyos1x-config vyconfd_config)) diff --git a/test/reference_tree_test.ml b/test/reference_tree_test.ml index 1186130..561eb8e 100644 --- a/test/reference_tree_test.ml +++ b/test/reference_tree_test.ml @@ -1,5 +1,8 @@ open OUnit2 -open Reference_tree + +module RT = Vyos1x.Reference_tree +module VT = Vyos1x.Vytree +module VL = Vyos1x.Vylist let get_dir test_ctxt = in_testdata_dir test_ctxt ["validators"] @@ -9,162 +12,176 @@ let ok_or_failure result = match result with let raises_validation_error f = try ignore @@ f (); false - with Validation_error _ -> true + with RT.Validation_error _ -> true let test_load_valid_definition test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (Vylist.in_list (Vytree.list_children r) "system") true; - assert_equal (Vylist.in_list (Vytree.list_children r) "interfaces") true + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (VL.in_list (VT.list_children r) "system") true; + assert_equal (VL.in_list (VT.list_children r) "interfaces") true (* Path validation tests *) let test_validate_path_leaf_valid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (validate_path (get_dir test_ctxt) r ["system"; "host-name"; "test"]) (["system"; "host-name"], Some "test") + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + let test p = + let _ = RT.validate_path (get_dir test_ctxt) r p in + RT.split_path r p + in + assert_equal (test ["system"; "host-name"; "test"]) (["system"; "host-name"], Some "test") let test_validate_path_leaf_invalid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (raises_validation_error (fun () -> ignore @@ validate_path (get_dir test_ctxt) r ["system"; "host-name"; "1234"])) true + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (raises_validation_error (fun () -> ignore @@ RT.validate_path (get_dir test_ctxt) r ["system"; "host-name"; "1234"])) true let test_validate_path_leaf_incomplete test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (raises_validation_error (fun () -> ignore @@ validate_path (get_dir test_ctxt) r ["system"; "host-name"])) true + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (raises_validation_error (fun () -> ignore @@ RT.validate_path (get_dir test_ctxt) r ["system"; "host-name"])) true let test_validate_path_tag_node_complete_valid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (validate_path (get_dir test_ctxt) r ["system"; "login"; "user"; "test"; "full-name"; "test user"]) + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + let test p = + let _ = RT.validate_path (get_dir test_ctxt) r p in + RT.split_path r p + in + assert_equal (test ["system"; "login"; "user"; "test"; "full-name"; "test user"]) (["system"; "login"; "user"; "test"; "full-name";], Some "test user") let test_validate_path_tag_node_illegal_characters test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in (* the space in "eth 0" is on purpose *) - assert_equal (raises_validation_error (fun () -> ignore @@ validate_path (get_dir test_ctxt) r ["interfaces"; "ethernet"; "eth 0"; "disable"])) true + assert_equal (raises_validation_error (fun () -> ignore @@ RT.validate_path (get_dir test_ctxt) r ["interfaces"; "ethernet"; "eth 0"; "disable"])) true let test_validate_path_tag_node_invalid_name test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (raises_validation_error (fun () -> ignore @@ validate_path (get_dir test_ctxt) r ["system"; "login"; "user"; "999"; "full-name"; "test user"])) + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (raises_validation_error (fun () -> ignore @@ RT.validate_path (get_dir test_ctxt) r ["system"; "login"; "user"; "999"; "full-name"; "test user"])) true let test_validate_path_tag_node_incomplete test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (raises_validation_error (fun () -> ignore @@ validate_path (get_dir test_ctxt) r ["system"; "login"; "user"])) true + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (raises_validation_error (fun () -> ignore @@ RT.validate_path (get_dir test_ctxt) r ["system"; "login"; "user"])) true let test_validate_path_garbage_after_value test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (raises_validation_error (fun () -> ignore @@ validate_path (get_dir test_ctxt) r ["system"; "host-name"; "foo"; "bar"])) true + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (raises_validation_error (fun () -> ignore @@ RT.validate_path (get_dir test_ctxt) r ["system"; "host-name"; "foo"; "bar"])) true let test_validate_path_valueless_node_with_value test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (raises_validation_error (fun () -> ignore @@ validate_path (get_dir test_ctxt) r ["system"; "options"; "reboot-on-panic"; "fgsfds"])) true + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (raises_validation_error (fun () -> ignore @@ RT.validate_path (get_dir test_ctxt) r ["system"; "options"; "reboot-on-panic"; "fgsfds"])) true let test_validate_path_valueless_node_valid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (validate_path (get_dir test_ctxt) r ["system"; "options"; "reboot-on-panic"]) + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + let test p = + let _ = RT.validate_path (get_dir test_ctxt) r p in + RT.split_path r p + in + assert_equal (test ["system"; "options"; "reboot-on-panic"]) (["system"; "options"; "reboot-on-panic"], None) let test_is_multi_valid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (is_multi r ["system"; "ntp-server"]) true + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (RT.is_multi r ["system"; "ntp-server"]) true let test_is_multi_invalid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (is_multi r ["system"; "host-name"]) false + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (RT.is_multi r ["system"; "host-name"]) false let test_is_secret_valid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (is_secret r ["system"; "login"; "password"]) true + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (RT.is_secret r ["system"; "login"; "password"]) true let test_is_secret_invalid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (is_secret r ["system"; "login"; "user"; "full-name"]) false + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (RT.is_secret r ["system"; "login"; "user"; "full-name"]) false let test_is_hidden_valid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (is_hidden r ["system"; "options"; "enable-dangerous-features"]) true + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (RT.is_hidden r ["system"; "options"; "enable-dangerous-features"]) true let test_is_hidden_invalid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (is_hidden r ["system"; "login"; "user"; "full-name"]) false + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (RT.is_hidden r ["system"; "login"; "user"; "full-name"]) false let test_is_tag_valid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (is_tag r ["system"; "login"; "user"]) true + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (RT.is_tag r ["system"; "login"; "user"]) true let test_is_tag_invalid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (is_tag r ["system"; "login"]) false + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (RT.is_tag r ["system"; "login"]) false let test_is_leaf_valid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (is_leaf r ["system"; "login"; "user"; "full-name"]) true + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (RT.is_leaf r ["system"; "login"; "user"; "full-name"]) true let test_is_leaf_invalid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (is_leaf r ["system"; "login"; "user"]) false + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (RT.is_leaf r ["system"; "login"; "user"]) false let test_is_valueless_valid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (is_valueless r ["system"; "options"; "reboot-on-panic"]) true + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (RT.is_valueless r ["system"; "options"; "reboot-on-panic"]) true let test_is_valueless_invalid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (is_valueless r ["system"; "login"; "user"; "full-name"]) false + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (RT.is_valueless r ["system"; "login"; "user"; "full-name"]) false +(* keep_order not yet implemented *) +(* let test_get_keep_order_valid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in assert_equal (get_keep_order r ["system"; "login"; "user"]) true let test_get_keep_order_invalid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in assert_equal (get_keep_order r ["system"; "login"; "user"; "full-name"]) false - +*) let test_get_owner_valid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (get_owner r ["system"; "login"]) (Some "login") + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (RT.get_owner r ["system"; "login"]) (Some "login") let test_get_owner_invalid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (get_owner r ["system"; "login"; "user"]) None + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (RT.get_owner r ["system"; "login"; "user"]) None let test_get_help_string_valid test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (get_help_string r ["system"; "login"; "user"; "full-name"]) ("User full name") + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (RT.get_help_string r ["system"; "login"; "user"; "full-name"]) ("User full name") let test_get_help_string_default test_ctxt = - let r = Vytree.make default_data "root" in - let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in - assert_equal (get_help_string r ["system"; "host-name"]) ("No help available") + let r = VT.make RT.default_data "root" in + let r = RT.load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in + assert_equal (RT.get_help_string r ["system"; "host-name"]) ("No help available") let suite = - "Util tests" >::: [ + "Vyconf reference tree tests" >::: [ "test_load_valid_definition" >:: test_load_valid_definition; "test_validate_path_leaf_valid" >:: test_validate_path_leaf_valid; "test_validate_path_leaf_invalid" >:: test_validate_path_leaf_invalid; @@ -188,8 +205,6 @@ let suite = "test_is_leaf_invalid" >:: test_is_leaf_invalid; "test_is_valueless_valid" >:: test_is_valueless_valid; "test_is_valueless_invalid" >:: test_is_valueless_invalid; - "test_get_keep_order_valid" >:: test_get_keep_order_valid; - "test_get_keep_order_invalid" >:: test_get_keep_order_invalid; "test_get_owner_valid" >:: test_get_owner_valid; "test_get_owner_invalid" >:: test_get_owner_invalid; "test_get_help_string_valid" >:: test_get_help_string_valid; diff --git a/test/session_test.ml b/test/session_test.ml index a3a1fb0..5d31030 100644 --- a/test/session_test.ml +++ b/test/session_test.ml @@ -1,8 +1,10 @@ +[@@@ocaml.warning "-27"] + open OUnit2 -open Session +open Vyconfd_config.Session -module CT = Config_tree -module RT = Reference_tree +module CT = Vyos1x.Config_tree +module RT = Vyos1x.Reference_tree (* I'm not sure if we want to account for superfluous spaces inside the strings, diff --git a/test/util_test.ml b/test/util_test.ml index 2f5bf5d..5e348fc 100644 --- a/test/util_test.ml +++ b/test/util_test.ml @@ -1,22 +1,26 @@ +[@@@ocaml.warning "-27"] + open OUnit2 -open Util + +module RT = Vyos1x.Reference_tree +module U = Vyos1x.Util let test_find_xml_child_existent test_ctxt = let elem = Xml.Element ("foo", [], [Xml.Element ("bar", [], []); Xml.PCData "baz"]) in - match (find_xml_child "bar" elem) with + match (RT.find_xml_child "bar" elem) with | None -> assert_failure "find_xml_child returned None" | Some x -> assert_equal (Xml.tag x) "bar" let test_find_xml_child_nonexistent test_ctxt = let elem = Xml.Element ("foo", [], [Xml.Element ("quux", [], [])]) in - assert_equal (find_xml_child "bar" elem) None + assert_equal (RT.find_xml_child "bar" elem) None let test_string_of_list test_ctxt = let path = ["foo"; "bar"; "baz"] in - assert_equal (String.trim (string_of_list path)) "foo bar baz" + assert_equal (String.trim (U.string_of_list path)) "foo bar baz" let suite = "Util tests" >::: [ diff --git a/test/value_checker_test.ml b/test/value_checker_test.ml index 16ad6e4..da71cb2 100644 --- a/test/value_checker_test.ml +++ b/test/value_checker_test.ml @@ -1,49 +1,52 @@ open OUnit2 -open Value_checker + +module VC = Vyos1x.Value_checker let get_dir test_ctxt = in_testdata_dir test_ctxt ["validators"] +let buf = Buffer.create 4096 + let raises_bad_validator f = try ignore @@ f (); false - with Bad_validator _ -> true + with VC.Bad_validator _ -> true let test_check_regex_valid test_ctxt = - let c = Regex "[a-z]+" in + let c = VC.Regex "[a-z]+" in let v = "fgsfds" in - assert_equal (validate_value (get_dir test_ctxt) c v) true + assert_equal (VC.validate_value (get_dir test_ctxt) buf c v) true let test_check_regex_invalid test_ctxt = - let c = Regex "[a-z]+" in + let c = VC.Regex "[a-z]+" in let v = "FGSFDS" in - assert_equal (validate_value (get_dir test_ctxt) c v) false + assert_equal (VC.validate_value (get_dir test_ctxt) buf c v) false let test_check_external_valid test_ctxt = - let c = External ("anything", None) in + let c = VC.External ("anything", None) in let v = "fgsfds" in - assert_equal (validate_value (get_dir test_ctxt) c v) true + assert_equal (VC.validate_value (get_dir test_ctxt) buf c v) true let test_check_external_invalid test_ctxt = - let c = External ("nothing", None) in + let c = VC.External ("nothing", None) in let v = "fgsfds" in - assert_equal (validate_value (get_dir test_ctxt) c v) false + assert_equal (VC.validate_value (get_dir test_ctxt) buf c v) false let test_check_external_bad_validator test_ctxt = - let c = External ("invalid", None) in + let c = VC.External ("invalid", None) in let v = "fgsfds" in assert_bool "Invalid validator was executed successfully" - (raises_bad_validator (fun () -> validate_value (get_dir test_ctxt) c v)) + (raises_bad_validator (fun () -> VC.validate_value (get_dir test_ctxt) buf c v)) let test_validate_any_valid test_ctxt = - let cs = [Regex "\\d+"; Regex "[a-z]+"; External ("anything", None)] in - assert_equal (validate_any (get_dir test_ctxt) cs "AAAA") true + let cs = [VC.Regex "\\d+"; VC.Regex "[a-z]+"; VC.External ("anything", None)] in + assert_equal (VC.validate_any (get_dir test_ctxt) cs "AAAA") None let test_validate_any_invalid test_ctxt = - let cs = [Regex "\\d+"; Regex "[a-z]+"] in - assert_equal (validate_any (get_dir test_ctxt) cs "AAAA") false + let cs = [VC.Regex "\\d+"; VC.Regex "[a-z]+"] in + assert_equal (VC.validate_any (get_dir test_ctxt) cs "AAAA") None let test_validate_any_no_constraints test_ctxt = let cs = [] in - assert_equal (validate_any (get_dir test_ctxt) cs "foo") true + assert_equal (VC.validate_any (get_dir test_ctxt) cs "foo") None let suite = "VyConf value checker tests" >::: [ diff --git a/test/vyconf_config_test.ml b/test/vyconf_config_test.ml index ba77d1c..acf0f2b 100644 --- a/test/vyconf_config_test.ml +++ b/test/vyconf_config_test.ml @@ -1,5 +1,5 @@ open OUnit2 -open Vyconf_config +open Vyconfd_config.Vyconf_config let try_load file = let conf = load file in @@ -11,8 +11,7 @@ let try_load_fail file err = let conf = load file in match conf with | Ok _ -> assert_failure err - | Error msg -> () - + | Error _ -> () let test_load_nonexistent_file test_ctxt = (* Please don't create this file there! *) diff --git a/test/vylist_test.ml b/test/vylist_test.ml index c6bd993..1bcf21b 100644 --- a/test/vylist_test.ml +++ b/test/vylist_test.ml @@ -1,5 +1,7 @@ +[@@@ocaml.warning "-27"] + open OUnit2 -open Vylist +open Vyos1x.Vylist (* Searching for an element that is in the list gives Some that_element *) let test_find_existent test_ctxt = diff --git a/test/vytree_load_test.ml b/test/vytree_load_test.ml index b56e130..cd8cc8d 100644 --- a/test/vytree_load_test.ml +++ b/test/vytree_load_test.ml @@ -1,3 +1,8 @@ +[@@@ocaml.warning "-27"] + +module VT = Vyos1x.Vytree +module VL = Vyos1x.Vylist + let max = 9999 (* Path length *) @@ -15,16 +20,16 @@ let insert_full tree path data = | [] -> tree | p :: ps -> let basepath = basepath @ [p] in - let tree = Vytree.insert tree basepath data in + let tree = VT.insert tree basepath data in aux tree ps basepath data in - let existent_path = Vytree.get_existent_path tree path in - let rest = Vylist.complement path existent_path in + let existent_path = VT.get_existent_path tree path in + let rest = VL.complement path existent_path in aux tree rest existent_path () let rec add_many_children t n basepath data = if n >= 0 then - let t = Vytree.insert t (basepath @ [(string_of_int n)]) () in + let t = VT.insert t (basepath @ [(string_of_int n)]) () in add_many_children t (n - 1) basepath data else t @@ -39,13 +44,13 @@ let rec do_inserts tree child n = do_inserts tree child (n - 1) else tree -let tree = Vytree.make () "root" +let tree = VT.make () "root" (* Add a hundred children *) let tree = add_many_children tree max_children [] () (* Use the last child to ensure that the child list is traversed to the end every time *) -let name = List.nth (Vytree.list_children tree) (max_children - 1) +let name = List.nth (VT.list_children tree) (max_children - 1) let _ = do_inserts tree name max_paths diff --git a/test/vytree_test.ml b/test/vytree_test.ml index 6133fb3..ecd75eb 100644 --- a/test/vytree_test.ml +++ b/test/vytree_test.ml @@ -1,5 +1,7 @@ +[@@@ocaml.warning "-27"] + open OUnit2 -open Vytree +open Vyos1x.Vytree (* Destructuting a freshly made node gives us what we made it from *) @@ -148,7 +150,7 @@ let test_merge_children_no_duplicates test_ctxt = [make_full () "foo" [make () "bar"]; make () "bar"; make_full () "baz" [make () "quuz"]] in - let node' = merge_children (fun x y -> x) node in + let node' = merge_children (fun x y -> x) (fun x y -> compare x y) node in assert_equal (list_children node') ["foo"; "bar"; "baz"] @@ -160,7 +162,7 @@ let test_merge_children_has_duplicates test_ctxt = [make_full () "foo" [make () "bar"]; make () "quux"; make_full () "foo" [make () "baz"]] in - let node' = merge_children (fun x y -> x) node in + let node' = merge_children (fun x y -> x) (fun x y -> compare x y) node in assert_equal (list_children node') ["foo"; "quux"]; assert_equal (get node' ["foo"] |> list_children) ["bar"; "baz"] @@ -1,26 +1,23 @@ -opam-version: "1.2" +opam-version: "2.0" name: "vyconf" version: "0.1" +synopsis: "VyOS 2.x config file control library" +description: "An appliance configuration framework" maintainer: "Daniil Baturin <daniil@baturin.org>" authors: "VyOS maintainers and contributors <maintainers@vyos.net>" homepage: "https://github.com/vyos/vyconf" -bug-reports: "https://phabricator.vyos.net/maniphest" -license: "LGPL with OCaml linking exception" -description: "An appliance configuration framework" -dev-repo: "git+https://github.com/vyos/vyconf" +bug-reports: "https://phabricator.vyos.net" +license: "LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception" +dev-repo: "git+https://github.com/vyos/vyconf/" build: [ - ["./configure" "--prefix=%{prefix}%"] - [make] + ["dune" "subst"] {pinned} + ["dune" "build" "-p" name] ] -install: [make "install"] -remove: ["ocamlfind" "remove" "vyconf"] depends: [ - "ocamlfind" {build} - "oasis" {build} "menhir" {build} + "dune" {build & >= "1.4.0"} "ocaml-protoc" {build} "ounit" {build} - "batteries" {build} "lwt" {build & >= "4.1.0"} "lwt_ppx" {build} "lwt_log" {build} @@ -33,4 +30,3 @@ depends: [ "sha" {build} "pcre" {build} ] -available: ocaml-version >= "4.03.0" |