From 85971fc1a0d12ba490730ef659593ea9a5cb1b0c Mon Sep 17 00:00:00 2001 From: Guillaume Date: Sat, 14 Mar 2026 02:53:18 +0100 Subject: [PATCH] Add XapiDb --- bin/main.ml | 10 ++-- lib/dune | 3 +- lib/state.ml | 10 ++-- lib/state.mli | 5 +- lib/xapidb.ml | 130 +++++++++++++++++++++++++++++++++++++++++++++++++ lib/xapidb.mli | 12 +++++ 6 files changed, 161 insertions(+), 9 deletions(-) create mode 100644 lib/xapidb.ml create mode 100644 lib/xapidb.mli diff --git a/bin/main.ml b/bin/main.ml index 7819265..ed77482 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -16,9 +16,13 @@ let () = Printf.eprintf "You must specify a log file using -log\n"; exit 1); + if !dbfile = "" then ( + Printf.eprintf "You must specify a db file using -db\n"; + exit 1); + let open Inspector in - let s = State.create !logfile in - Printf.printf "dbfile is currently ignored\n"; - Printf.printf "Loaded %d lines\n" (State.size s); + let s = State.create ~logfile:!logfile ~dbfile:!dbfile in + Printf.printf "Loaded %d lines from logs\n" (State.size s); + Printf.printf "Found %d entries in the DB\n" (State.dbsize s) ; Repl.help (); Repl.loop s diff --git a/lib/dune b/lib/dune index 7c8a4d0..840aad8 100644 --- a/lib/dune +++ b/lib/dune @@ -1,2 +1,3 @@ (library - (name inspector)) + (name inspector) + (libraries xmlm)) diff --git a/lib/state.ml b/lib/state.ml index 649cde3..4ecd84e 100644 --- a/lib/state.ml +++ b/lib/state.ml @@ -1,14 +1,16 @@ -type t = { lines : string array; cursor : int } +type t = { lines : string array; cursor : int; db : Xapidb.t } (** Invariant: cursor >= 0 cursor < Array.length lines *) let size s = Array.length s.lines +let dbsize s = Xapidb.size s.db let cursor s = s.cursor -let create (fname : string) : t = +let create ~(logfile : string) ~(dbfile : string) : t = let lines = - In_channel.with_open_text fname In_channel.input_lines |> Array.of_list + In_channel.with_open_text logfile In_channel.input_lines |> Array.of_list in - { lines; cursor = 0 } + let db = In_channel.with_open_text dbfile Xapidb.from_channel in + { lines; cursor = 0; db } let show_line s : string = s.lines.(s.cursor) diff --git a/lib/state.mli b/lib/state.mli index 5e9f96a..fa994b6 100644 --- a/lib/state.mli +++ b/lib/state.mli @@ -4,7 +4,7 @@ type t A [t] represents a loaded log file and a cursor pointing to the currently active line. *) -val create : string -> t +val create : logfile:string -> dbfile:string -> t (** [create file] loads the log file into memory and initializes the cursor at the first line. *) @@ -22,3 +22,6 @@ val cursor : t -> int val size : t -> int (** Number of lines in the log. *) + +val dbsize : t -> int +(** Number of entries in the db. *) diff --git a/lib/xapidb.ml b/lib/xapidb.ml new file mode 100644 index 0000000..633e938 --- /dev/null +++ b/lib/xapidb.ml @@ -0,0 +1,130 @@ +type value = String of string | Ref of string (* OpaqueRef UUID only *) +type e = string * value +type t = (string, e list) Hashtbl.t + +(* --------------- + Helpers + -------------- *) +let parse_value s = + match String.split_on_char ':' s with + | [ "OpaqueRef"; uuid ] -> Ref uuid + | _ -> String s + +let table_name (attr : Xmlm.attribute list) : string = + if List.length attr <> 1 then ( + Printf.eprintf "For table only one attribute name is expected, got %d\n" + (List.length attr); + exit 1); + let (_, local), table_name = List.hd attr in + assert (local = "name"); + table_name + +(** [row_elements attr] return a list of tuple where the first element will be + the key and the second element is a value. Example: + - host="OpaqueRef:3e.." -> ("host", Ref("3e..")) + - type="host_internal" -> ("type", String("host_internal")) *) +let row_elements (attr : Xmlm.attribute list) : e list = + let rec loop acc = function + | [] -> acc + | x :: xs -> + let (_uri, local), name = x in + loop ((local, parse_value name) :: acc) xs + in + loop [] attr + +(** [peek_ref elements] return the string that corresponds to "ref" or "_ref". + It is the OpaqueRef of the object (element) itself. It raises an expection + if ref is not found. *) +let peek_ref (elements : e list) : string = + let _, opaqueref = + List.find (fun (s, _) -> s = "ref" || s == "_ref") elements + in + match opaqueref with + | Ref uuid -> uuid + | String s -> failwith (Printf.sprintf "OpaqueRef is expected, got %s" s) + +(* --------------- + Interface + -------------- *) +let size = Hashtbl.length + +(*List.iter (fun e -> Printf.printf " %-20s\t%s\n" k (XapiDb.elt_to_string v) l))*) +let elt_to_string elt = + let s1, s2 = + match elt with s1, String s2 -> (s1, s2) | s1, Ref uuid -> (s1, uuid) + in + Printf.sprintf "%-20s\t%s" s1 s2 + +let get_ref t ~ref = + match Hashtbl.find_opt t ref with None -> [] | Some l -> l + +let from_channel ic = + let htable : (string, e list) Hashtbl.t = Hashtbl.create 128 in + let input = Xmlm.make_input (`Channel ic) in + (* The goal of the loop is to fill the Hashtbl where the key is the OpaqueRef + of an element. An element is basically the row but we will see as we go. *) + let rec read_loop (stack : string list) = + try + (* input as a side effect *) + let new_stack = + match Xmlm.input input with + | `Dtd _ -> stack (* can be safely ignored *) + | `El_start (tag_name, tag_attr_lst) -> ( + let _, local = tag_name in + match local with + | "database" | "manifest" | "pair" -> stack (* can be skipped *) + | "table" -> + let tname = table_name tag_attr_lst in + tname :: stack + | "row" -> + (* Row is always part of a table and we are not expecting nested table *) + assert (List.length stack = 1); + let tbname = List.hd stack in + let elements = row_elements tag_attr_lst in + let ref = peek_ref elements in + + (* We can now insert the element, we should not have duplicated ref *) + let () = + match Hashtbl.find_opt htable ref with + | None -> + Hashtbl.add htable ref + (("table", String tbname) :: elements) + | Some _ -> Printf.eprintf "Ref %s is duplicated" ref + in + (* We need to add the row because when reaching `El_end we will remove + it, and we will have the table on top. It works because we don't have + nested element. *) + local :: stack + | _ -> failwith (Printf.sprintf "%s is not handled" local)) + | `El_end -> if List.is_empty stack then stack else List.tl stack + | `Data _ -> + (* Printf.printf "Data found\n" ;*) + stack + in + read_loop new_stack + with Xmlm.Error ((line, col), err) -> + if not (Xmlm.eoi input) then ( + Printf.eprintf "[%d, %d]: Got exception: %s" line col + (Xmlm.error_message err); + exit 1) + in + read_loop []; + htable + +let _sample_xml : string = + {| + + + + + + +
+ +
+
+ +
+ + +|} diff --git a/lib/xapidb.mli b/lib/xapidb.mli new file mode 100644 index 0000000..d3b4353 --- /dev/null +++ b/lib/xapidb.mli @@ -0,0 +1,12 @@ +type e (* an element of the database *) +type t (* the database *) + +val from_channel : in_channel -> t +(** [from_file ic] reads XML from the input channel and build a relational + database *) + +val size : t -> int +(** [size t] returns the number of entries in the database *) + +val get_ref : t -> ref:string -> e list +val elt_to_string : e -> string