Switch from linking with vyconf plus adhocery to dedicated vyos1x-config package.

5 files changed, 27 insertions, 392 deletions

diff --git a/Makefile b/Makefile
index 798f869..b027472 100644
--- a/Makefile
+++ b/Makefile
@@ -2,22 +2,14 @@ BUILDDIR=_build
 VPATH=$(BUILDDIR)
 OCAMLDIR=$(shell ocamlopt -where)
 $(shell mkdir -p $(BUILDDIR) $(BUILDDIR)/stub $(BUILDDIR)/lib $(BUILDDIR)/stub_generator $(BUILDDIR)/test $(BUILDDIR)/generated)
-PACKAGES=vyconf,ctypes.stubs,ctypes.foreign
+PACKAGES=vyos1x-config,pcre,ctypes.stubs,ctypes.foreign
 
-# The files used to build the stub generator.
-GENERATOR_FILES=$(BUILDDIR)/lib/vyos1x_parser.cmx	\
-                $(BUILDDIR)/lib/vyos1x_lexer.cmx        \
-                $(BUILDDIR)/lib/vyos1x_renderer.cmx	\
-                $(BUILDDIR)/lib/bindings.cmx		\
+GENERATOR_FILES=$(BUILDDIR)/lib/bindings.cmx \
                 $(BUILDDIR)/stub_generator/generate.cmx
 
-# The files from which we'll build a shared library.
-LIBFILES=$(BUILDDIR)/lib/vyos1x_parser.cmx	\
-         $(BUILDDIR)/lib/vyos1x_lexer.cmx	\
-         $(BUILDDIR)/lib/vyos1x_renderer.cmx	\
-         $(BUILDDIR)/lib/bindings.cmx		\
+LIBFILES=$(BUILDDIR)/lib/bindings.cmx \
          $(BUILDDIR)/generated/vyosconfig_bindings.cmx  \
-         $(BUILDDIR)/lib/apply_bindings.cmx 		\
+         $(BUILDDIR)/lib/apply_bindings.cmx  \
          $(BUILDDIR)/generated/vyosconfig.o
 
 CAML_INIT=$(BUILDDIR)/stub/init.o
@@ -74,24 +66,5 @@ $(BUILDDIR)/%.cmx: %.ml
 $(GENERATOR): $(GENERATOR_FILES)
 	ocamlfind opt -o $@ -I $(BUILDDIR)/lib -linkpkg -package $(PACKAGES) $^
 
-$(BUILDDIR)/lib/vyos1x_lexer.ml:
-	ocamllex parser/vyos1x_lexer.mll -o $(BUILDDIR)/lib/vyos1x_lexer.ml
-
-$(BUILDDIR)/lib/vyos1x_lexer.cmx: $(BUILDDIR)/lib/vyos1x_lexer.ml $(BUILDDIR)/lib/vyos1x_parser.cmi
-	ocamlfind opt -o $@ -I $(BUILDDIR)/lib -linkpkg -package $(PACKAGES) $(BUILDDIR)/lib/vyos1x_lexer.ml
-
-$(BUILDDIR)/lib/vyos1x_parser.ml:
-	menhir parser/vyos1x_parser.mly
-	mv parser/vyos1x_parser.ml $(BUILDDIR)/lib
-
-$(BUILDDIR)/lib/vyos1x_parser.mli: $(BUILDDIR)/lib/vyos1x_parser.ml
-	mv parser/vyos1x_parser.mli $(BUILDDIR)/lib
-
-$(BUILDDIR)/lib/vyos1x_parser.cmi: $(BUILDDIR)/lib/vyos1x_parser.mli
-	ocamlfind opt -o $@ -I $(BUILDDIR)/lib -package $(PACKAGES) $^
-
-$(BUILDDIR)/lib/vyos1x_parser.cmx: $(BUILDDIR)/lib/vyos1x_parser.cmi $(BUILDDIR)/lib/vyos1x_lexer.cmx
-	ocamlfind opt -c -o $@ -package $(PACKAGES) -I $(BUILDDIR)/lib $(BUILDDIR)/lib/vyos1x_parser.ml $(BUILDDIR)/lib/vyos1x_lexer.ml
-
 clean:
 	rm -rf $(BUILDDIR)
diff --git a/lib/bindings.ml b/lib/bindings.ml
index 49f8ef7..1734a52 100644
--- a/lib/bindings.ml
+++ b/lib/bindings.ml
@@ -1,11 +1,18 @@
 open Ctypes
 open Foreign
 
-module CT = Config_tree
+open Vyos1x
 
+module CT = Config_tree
 
 let error_message = ref ""
 
+let make_syntax_error pos err =
+  match pos with
+  | None -> Printf.sprintf "Syntax error: %s" err
+  | Some (l, c) ->
+    Printf.sprintf "Syntax error on line %d, character %d: %s" l c err
+
 let to_json_str = fun s -> `String s
 
 let make_config_tree name = Ctypes.Root.create (CT.make name)
@@ -14,21 +21,24 @@ let destroy c_ptr =
     Root.release c_ptr
 
 let from_string s = 
-    try
-        error_message := "";
-        let config = Vyos1x_parser.config Vyos1x_lexer.token (Lexing.from_string s) in
-        Ctypes.Root.create config
-    with
-    | Failure s | Vyos1x_lexer.Error s -> error_message := s; Ctypes.null
+  try
+    error_message := "";
+    let config = Parser.from_string s in
+    Ctypes.Root.create config
+  with
+    | Failure s -> error_message := s; Ctypes.null
+    | Util.Syntax_error (pos, err) ->
+      let msg = make_syntax_error pos err in
+      error_message := msg; Ctypes.null
     | _ -> error_message := "Parse error"; Ctypes.null
 
 let get_error () = !error_message
 
-let render c_ptr =
-    Vyos1x_renderer.render (Root.get c_ptr)
+let render_config c_ptr =
+    CT.render_config (Root.get c_ptr)
 
 let render_commands c_ptr =
-    CT.render_commands ~alwayssort:true ~sortchildren:true (Root.get c_ptr) []
+    CT.render_commands (Root.get c_ptr) []
 
 let set_add_value c_ptr path value =
     let ct = Root.get c_ptr in
@@ -84,14 +94,14 @@ let set_tag c_ptr path =
     let ct = Root.get c_ptr in
     let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
     try
-        Root.set c_ptr (CT.set_ephemeral ct path true);
+        Root.set c_ptr (CT.set_tag ct path true);
         0 (* return 0 *)
     with _ -> 1
 
 let is_tag c_ptr path =
     let ct = Root.get c_ptr in
     let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
-    if (CT.is_ephemeral ct path) then 1 else 0
+    if (CT.is_tag ct path) then 1 else 0
 
 let exists c_ptr path =
     let ct = Root.get c_ptr in
@@ -144,7 +154,7 @@ struct
   let () = I.internal "destroy" ((ptr void) @-> returning void) destroy
   let () = I.internal "from_string" (string @-> returning (ptr void)) from_string
   let () = I.internal "get_error" (void @-> returning string) get_error
-  let () = I.internal "to_string"  ((ptr void) @-> returning string) render
+  let () = I.internal "to_string"  ((ptr void) @-> returning string) render_config
   let () = I.internal "to_commands" ((ptr void) @-> returning string) render_commands
   let () = I.internal "set_add_value" ((ptr void) @-> string @-> string @-> returning int) set_add_value
   let () = I.internal "set_replace_value" ((ptr void) @-> string @-> string @-> returning int) set_replace_value
diff --git a/lib/vyos1x_renderer.ml b/lib/vyos1x_renderer.ml
deleted file mode 100644
index 7ff4c4c..0000000
--- a/lib/vyos1x_renderer.ml
+++ /dev/null
@@ -1,93 +0,0 @@
-(* The renderer makes two assumptions about the invariants of the config files:
-   that top level nodes are never tag or leaf nodes,
-   and that immediate children of tag nodes are never themselves tag nodes.
-
-   They are true in all existing VyOS configs and configs with those invariant
-   broken will never load, so these assumptions are safe to make when
-   processing existing configs. In configs built from scratch, the user is
-   responsible for its validness.
-
-   The original loader behaviour with tag nodes is strange: deep down, after
-   config loading, they are indistinguishable from any other nodes, but at load
-   time, they fail to validate unless they are formatted as tag nodes in the
-   config file, that is, "ethernet eth0 { ..." as opposed to "ethernet { eth0 { ...".
-
-   Since Vyconf makes no distinction between normal nodes and tag nodes other than
-   at set command validation and formatting time, I reused the ephemeral flag
-   which is never used in VyOS 1.x for marking nodes as tag nodes at parsing time.
-
-   Note that if non-leaf nodes have values, they will be rendered in _some_ way.
-   Such a config would never appear in a live VyOS and cannot load, so this case
-   is considered undefined behaviour.
-
- *)
-
-module CT = Config_tree
-module VT = Vytree
-
-let make_indent indent level = String.make (level * indent) ' '
-
-let render_values indent_str name values =
-    match values with
-    | [] -> Printf.sprintf "%s%s { }\n" indent_str name
-    | [v] -> Printf.sprintf "%s%s \"%s\"\n" indent_str name (String.escaped v)
-    | _  -> 
-        let rendered = List.map (fun s -> Printf.sprintf "%s%s \"%s\"" indent_str name (String.escaped s)) values in
-        let rendered = String.concat "\n" rendered in
-        Printf.sprintf "%s\n" rendered
-
-let render_comment indent c =
-    match c with
-    | None -> ""
-    | Some c ->  Printf.sprintf "%s/* %s */\n" indent c
-
-let rec render_node indent level node =
-    let open CT in
-    let indent_str = make_indent indent level in
-    let name = VT.name_of_node node in
-    let data = VT.data_of_node node in
-    let is_tag = data.ephemeral (* sic! look in the parser *) in 
-    let comment = render_comment indent_str data.comment in
-    let values = render_values indent_str name data.values in
-    let children = VT.children_of_node node in
-    match children with
-    | [] -> Printf.sprintf "%s%s" comment values
-    | _ ->
-        if is_tag then 
-            begin
-                let inner = List.map (render_tag_node_child indent level name) children in
-                String.concat "" inner
-            end
-        else
-            begin
-                let inner = List.map (render_node indent (level + 1)) children in
-                let inner = String.concat "" inner in
-                Printf.sprintf "%s%s%s {\n%s%s}\n" comment indent_str name inner indent_str
-            end
-
-
-and render_tag_node_child indent level parent node =
-    let open CT in
-    let indent_str = make_indent indent level in
-    let name = VT.name_of_node node in
-    let data = VT.data_of_node node in
-    let comment = render_comment indent_str data.comment in
-    let values = render_values indent_str name data.values in
-    let children = VT.children_of_node node in
-    match children with
-    (* This produces too much whitespace due to indent_str from values,
-       but the issue is cosmetic *)
-    | [] -> Printf.sprintf "%s%s%s %s" comment indent_str parent values
-    | _ ->
-        (* Exploiting the fact that immediate children of tag nodes are
-           never themselves tag nodes *)
-        let inner = List.map (render_node indent (level + 1)) children in
-        let inner = String.concat "" inner in
-        Printf.sprintf "%s%s%s %s {\n%s%s}\n" comment indent_str parent name inner indent_str
-
-let render node =
-    let children = Vytree.children_of_node node in
-    let child_configs = List.map (render_node 4 0) children in
-    String.concat "" child_configs
-     
-    
diff --git a/parser/vyos1x_lexer.mll b/parser/vyos1x_lexer.mll
deleted file mode 100644
index a996642..0000000
--- a/parser/vyos1x_lexer.mll
+++ /dev/null
@@ -1,138 +0,0 @@
-{
-
-open Vyos1x_parser
-
-exception Error of string
-
-(*
-
-The language of the VyOS 1.x config file has multiple ambiguities that
-make it not even context free.
-
-The main issue is lack of explicit statement separators, so if we ignore whitespace,
-a parser is left to guess if, for example
-
-address dhcp # leaf node with a value
-disable      # valueless leaf node
-
-is three valueless nodes, a valueless node followed by a node with a value,
-or a node with a value followed by a valueless node.
-
-The only cue is the newline, which means that newlines are sometimes significant,
-and sometimes they aren't.
-
-interfaces { # doesn't matter
-  ethernet 'eth0' { # doesn't matter
-    address '192.0.2.1/24' # significant!
-    disable # significant!
-
-    # empty line -- doesn't matter
-    hw-id 00:aa:bb:cc:dd:ee # significant!
-  } # doesn't matter
-}
-
-If there were explicit terminators (like we do in VyConf, or like JunOS does),
-the language would be context free. Enter the lexer hack: let's emit newlines only
-when they are significant, so that the parser can use them as terminators.
-
-The informal idea is that a newline is only significant if it follows a leaf node.
-So we need rules for finding out if we are inside a leaf node or not.
-
-These are the formal rules. A newline is significant if and only if
-1. Preceding token is an identifier
-2. Preceding token is a quoted string
-
-We set the vy_inside_node flag to true when we enter a leaf node and reset it when
-we reach the end of it.
-
-*)
-
-let vy_inside_node = ref false
-
-}
-
-rule token = parse
-| [' ' '\t' '\r']
-    { token lexbuf }
-| '\n'
-    { Lexing.new_line lexbuf; if !vy_inside_node then (vy_inside_node := false; NEWLINE) else token lexbuf }
-| '"'
-    { vy_inside_node := true; read_string (Buffer.create 16) lexbuf }
-| '''
-    { vy_inside_node := true; read_single_quoted_string (Buffer.create 16) lexbuf }
-| "/*"
-    { vy_inside_node := false; read_comment (Buffer.create 16) lexbuf }
-| '{'
-    { vy_inside_node := false; LEFT_BRACE }
-| '}'
-    { vy_inside_node := false; RIGHT_BRACE }
-| "//" [^ '\n']*
-    { token lexbuf }
-| [^ ' ' '\t' '\n' '\r' '{' '}' '"' ''' ]+ as s
-    { vy_inside_node := true; 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
-      }
-
-(*
-
-If you are curious how the original parsers handled the issue: they did not.
-The CStore parser cheated by reading data from command definitions to resolve
-the ambiguities, which made it impossible to use in standalone config
-manipulation programs like migration scripts.
-
-The XorpConfigParser could not tell tag nodes' name and tag from
-a leaf node with a value, which made it impossible to manipulate
-tag nodes or change values properly.
-
-*)
diff --git a/parser/vyos1x_parser.mly b/parser/vyos1x_parser.mly
deleted file mode 100644
index 707538d..0000000
--- a/parser/vyos1x_parser.mly
+++ /dev/null
@@ -1,117 +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 LEFT_BRACE
-%token RIGHT_BRACE
-%token NEWLINE
-%token EOF
-
-%start <Config_tree.t> config
-%%
-
-(* If there are multiple comments before a node, consider the last one its real comment *)
-comments: 
-    cs = list(COMMENT) { match cs with [] -> None | _ -> Some (List.rev cs |> List.hd |> String.trim) }
-
-value:
-  | v = STRING
-    { v }
-  | v = IDENTIFIER
-    { v }
-;
-
-
-leaf_node_body:
-  | comment = comments;
-    name = IDENTIFIER; value = value;
-    { Vytree.make_full {default_data with values=[value]; comment=comment} name []}
-  | comment = comments;
-    name = IDENTIFIER; (* valueless node *)
-    { Vytree.make_full {default_data with comment=comment} name [] }
-;
-
-leaf_node:
-  | n = leaf_node_body; NEWLINE;
-    { n }
-  | n = leaf_node_body; EOF;
-    { n }
-
-node:
-  | comment = comments;
-    name = IDENTIFIER; LEFT_BRACE; children = list(node_content); RIGHT_BRACE;
-    {
-        let node =
-            Vytree.make_full {default_data with comment=comment} 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)
-    }
-;
-
-(* XXX: for the config to be loadable with the old CStore backend, what was formatted as a tag node
-        in the original config, must remain formatted that way.
-        Since fixing it there is more trouble than it's worth, and creating a separate version of
-        Config_tree just for that seems strange, I reused the ephemeral flag for that, which 
-        is never used in the VyOS 1.x context anyway.
- *)
-tag_node:
-  | comment = comments;
-    name = IDENTIFIER; tag = value; LEFT_BRACE; children = list(node_content); RIGHT_BRACE
-  {
-      let outer_node = Vytree.make_full {default_data with ephemeral=true} name [] in
-      let inner_node =
-          Vytree.make_full {default_data with comment=comment} 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_content); 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)
-  }
-;