diff --git a/bin/main.ml b/bin/main.ml index 58a8ed3..d62835e 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -10,7 +10,7 @@ let get_filename () = let () = Log.set_log_level Log.DEBUG; let filename = get_filename () in - let xml = Xml.parse_file filename in + let xml = XmlUtil.parse_file filename in let (book, rules) = Reader.read xml in Log.debug "book is:\n %s" (AddressBook.dump book); Log.debug "rules is:\n %s" (List.map Rule.dump rules |> String.concat "\n "); diff --git a/bin/reader.ml b/bin/reader.ml index 7f7b47c..5af860a 100644 --- a/bin/reader.ml +++ b/bin/reader.ml @@ -1,55 +1,16 @@ open Needlework_scenario_generator open Common module Ip = Ipaddr.V4 - -let find_child tag xml = - Xml.children xml - |> List.find_opt (fun xml -> Xml.tag xml = tag) - -let find_child_data tag xml = - Xml.children xml - |> List.find_opt (fun xml -> Xml.tag xml = tag) - |> Option.map Xml.children - |> Option.map List.hd - |> Option.map Xml.pcdata - -let get_child tag xml = - Xml.children xml - |> List.find_opt (fun xml -> Xml.tag xml = tag) - |> function - | None -> - failwith (!%"get_child: tag '%s' not found." tag) - | Some xml -> xml - -let text xml = try Xml.children xml |> List.hd |> Xml.pcdata with - | e -> prerr_endline (!%"Reader.text: %s: %s" (Printexc.to_string e) (Xml.to_string xml)); - raise e - -let get_child_data tag xml = - find_child_data tag xml - |> function - | None -> failwith (!%"get_child_data: tag '%s' not found." tag) - | Some xml -> xml - -let get_child_data_list tag xml = - Xml.children xml - |> List.filter (fun xml -> Xml.tag xml = tag) - |> List.map Xml.pcdata - -let has tag xml = - Xml.children xml - |> List.exists (fun xml -> Xml.tag xml = tag) - -let (/) xml tag = Xml.children xml |> List.filter (fun xml -> Xml.tag xml = tag) -let (//) xml tag : Xml.xml = get_child tag xml -let (/@) xml attr = Xml.attrib xml attr +module XmlLight = Xml +open XmlUtil +module Xml = XmlUtil open AddressBook let address_book_of_xmls address_entries address_grps = let address_of_xml entry = - let name = Xml.attrib entry "name" in - let addr = match find_child_data "ip-netmask" entry, find_child_data "fqdn" entry with + let name = entry /@ "name" in + let addr = match entry //? "ip-netmask" |> Option.map text, entry //? "fqdn" |> Option.map text with | Some ip, _ when String.ends_with ~suffix:"32" ip -> let ip = String.split_on_char '/' ip |> List.hd in SingleHost (Ip.of_string_exn ip) @@ -99,13 +60,13 @@ let read_vsys_entry xml = let rules = read_rules xml in (book, rules) -let read : Xml.xml -> (AddressBook.t * Rule.t list) = fun xml -> +let read : xml -> (AddressBook.t * Rule.t list) = fun xml -> try xml // "devices" // "entry" // "vsys" // "entry" |> read_vsys_entry with - | Xml.Not_pcdata xml as e -> - Log.error "===ERROR: Not pcdata %s" (Xml.to_string xml); + | XmlLight.Not_pcdata xml as e -> + Log.error "===ERROR: Not pcdata %s" (XmlLight.to_string xml); raise e | e -> Log.error "===ERROR: %s" (Printexc.to_string e); diff --git a/lib/dune b/lib/dune index 3948c67..90bf974 100644 --- a/lib/dune +++ b/lib/dune @@ -1,3 +1,3 @@ (library (name needlework_scenario_generator) - (libraries dolog)) + (libraries xml-light dolog)) diff --git a/lib/needle_work_scenario_generator.ml b/lib/needle_work_scenario_generator.ml index 9a598cb..55e4150 100644 --- a/lib/needle_work_scenario_generator.ml +++ b/lib/needle_work_scenario_generator.ml @@ -1,3 +1,5 @@ module Common = Common module Gen = Gen + +module XmlUtil = XmlUtil diff --git a/lib/xmlUtil.ml b/lib/xmlUtil.ml new file mode 100644 index 0000000..fdca25d --- /dev/null +++ b/lib/xmlUtil.ml @@ -0,0 +1,59 @@ +open Common + +type xml = Xml.xml +type t = xml + +let parse_file filename = Xml.parse_file filename + +let to_string = Xml.to_string +let children = Xml.children +(*let find_child tag xml = + Xml.children xml + |> List.find_opt (fun xml -> Xml.tag xml = tag) + +let find_child_data tag xml = + Xml.children xml + |> List.find_opt (fun xml -> Xml.tag xml = tag) + |> Option.map Xml.children + |> Option.map List.hd + |> Option.map Xml.pcdata + +let get_child tag xml = + Xml.children xml + |> List.find_opt (fun xml -> Xml.tag xml = tag) + |> function + | None -> + failwith (!%"get_child: tag '%s' not found." tag) + | Some xml -> xml +*) +let text xml = try Xml.children xml |> List.hd |> Xml.pcdata with + | e -> prerr_endline (!%"Reader.text: %s: %s" (Printexc.to_string e) (Xml.to_string xml)); + raise e +(* +let get_child_data tag xml = + find_child_data tag xml + |> function + | None -> failwith (!%"get_child_data: tag '%s' not found." tag) + | Some xml -> xml + +let get_child_data_list tag xml = + Xml.children xml + |> List.filter (fun xml -> Xml.tag xml = tag) + |> List.map Xml.pcdata + +let has tag xml = + Xml.children xml + |> List.exists (fun xml -> Xml.tag xml = tag) +*) + +let (/) xml tag = Xml.children xml |> List.filter (fun xml -> Xml.tag xml = tag) + +let (//) xml tag : xml = + Xml.children xml + |> List.find (fun xml -> Xml.tag xml = tag) + +let (//?) xml tag : xml option = + Xml.children xml + |> List.find_opt (fun xml -> Xml.tag xml = tag) + +let (/@) xml attr = Xml.attrib xml attr diff --git a/lib/xmlUtil.mli b/lib/xmlUtil.mli new file mode 100644 index 0000000..4016287 --- /dev/null +++ b/lib/xmlUtil.mli @@ -0,0 +1,13 @@ +type xml +type t = xml + +val parse_file : string -> t +val children : t -> t list + +val to_string : t -> string + +val (//) : t -> string -> t +val (//?) : t -> string -> t option +val (/) : t -> string -> t list +val (/@) : t -> string -> string +val text : t -> string