diff options
Diffstat (limited to 'xacml-translation/json_xacml_translator')
9 files changed, 157 insertions, 0 deletions
diff --git a/xacml-translation/json_xacml_translator/bin/dune b/xacml-translation/json_xacml_translator/bin/dune new file mode 100644 index 0000000..1e39d81 --- /dev/null +++ b/xacml-translation/json_xacml_translator/bin/dune @@ -0,0 +1,4 @@ +(executable + (public_name json_xacml_translator) + (name main) + (libraries core translator)) diff --git a/xacml-translation/json_xacml_translator/bin/main.ml b/xacml-translation/json_xacml_translator/bin/main.ml new file mode 100644 index 0000000..3ccaf71 --- /dev/null +++ b/xacml-translation/json_xacml_translator/bin/main.ml @@ -0,0 +1,8 @@ +open Core +open Translator + +let () = + let argv = Sys.get_argv () in + let file_name = Array.get argv 1 in + let request_code = In_channel.read_all file_name in + compile_request request_code |> Stdio.print_endline diff --git a/xacml-translation/json_xacml_translator/dune-project b/xacml-translation/json_xacml_translator/dune-project new file mode 100644 index 0000000..ecdddec --- /dev/null +++ b/xacml-translation/json_xacml_translator/dune-project @@ -0,0 +1,26 @@ +(lang dune 3.11) + +(name json_xacml_translator) + +(generate_opam_files true) + +(source + (github username/reponame)) + +(authors "Author Name") + +(maintainers "Maintainer Name") + +(license LICENSE) + +(documentation https://url/to/documentation) + +(package + (name json_xacml_translator) + (synopsis "A short synopsis") + (description "A longer description") + (depends ocaml dune) + (tags + (topics "to describe" your project))) + +; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project diff --git a/xacml-translation/json_xacml_translator/json_xacml_translator.opam b/xacml-translation/json_xacml_translator/json_xacml_translator.opam new file mode 100644 index 0000000..7b13bb9 --- /dev/null +++ b/xacml-translation/json_xacml_translator/json_xacml_translator.opam @@ -0,0 +1,31 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "A short synopsis" +description: "A longer description" +maintainer: ["Maintainer Name"] +authors: ["Author Name"] +license: "LICENSE" +tags: ["topics" "to describe" "your" "project"] +homepage: "https://github.com/username/reponame" +doc: "https://url/to/documentation" +bug-reports: "https://github.com/username/reponame/issues" +depends: [ + "ocaml" + "dune" {>= "3.11"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/username/reponame.git" diff --git a/xacml-translation/json_xacml_translator/lib/dune b/xacml-translation/json_xacml_translator/lib/dune new file mode 100644 index 0000000..394a9e9 --- /dev/null +++ b/xacml-translation/json_xacml_translator/lib/dune @@ -0,0 +1,4 @@ +(library + (name translator) + (libraries base xml-light yojson) + (preprocess (pps ppx_let ppx_jane))) diff --git a/xacml-translation/json_xacml_translator/lib/translator.ml b/xacml-translation/json_xacml_translator/lib/translator.ml new file mode 100644 index 0000000..13125ab --- /dev/null +++ b/xacml-translation/json_xacml_translator/lib/translator.ml @@ -0,0 +1,81 @@ +open Base + +type xml_element = (string * (string * string) list * Xml.xml list) + +let rec get_attr (needle : string) : (string * string) list -> string option = function + | (k, v) :: xs -> if String.(k = needle) then Some v else get_attr needle xs + | _ -> None + +let get_exn opt message = + match opt with + | Some x -> x + | _ -> failwith message + +let get_attr_exn needle attrs : string = + get_exn (get_attr needle attrs) "missing attribute" + +let xml_element_of_children (children : Xml.xml list) : xml_element list = + List.map children ~f:(function + | Element x -> x + | _ -> failwith "called on element with non-element children") + +let xml_element_of_Xml : Xml.xml -> xml_element = function + | Element (elt) -> elt + | _ -> failwith "not an element" + +(* --- *) + +let compile_attribute_value category identifier issuer ((tag_name, attributes, children) : xml_element) = + assert String.(tag_name = "AttributeValue"); + let typ = get_attr_exn "DataType" attributes in + match children with + | [PCData s] -> + (match issuer with + | Some issuer -> + `Assoc + [ + ("category", `String category); + ("identifier", `String identifier); + ("issuer", `String issuer); + ("value", `Assoc [("kind", `String "primitive"); + ("type", `String typ); + ("value", `String s)]) + ] + | _ -> + `Assoc + [ + ("category", `String category); + ("identifier", `String identifier); + ("value", `Assoc [("kind", `String "primitive"); + ("type", `String typ); + ("value", `String s)]) + ]) + | _ -> failwith "ill-formed attribute value" + +let compile_attribute category ((tag_name, attributes, children) : xml_element) = + assert String.(tag_name = "Attribute"); + let identifier = get_attr_exn "AttributeId" attributes in + let issuer = get_attr "Issuer" attributes in + compile_attribute_value category identifier issuer (List.nth_exn children 0 |> xml_element_of_Xml) + +let compile_attributes ((tag_name, attributes, children) : xml_element) : _ = + assert String.(tag_name = "Attributes"); + let category = get_attr_exn "Category" attributes in + children + |> xml_element_of_children + |> List.map ~f:(compile_attribute category) + (* |> List.concat *) + +let compile_request' : Xml.xml -> _ = function + | Element (("Request", _attributes, children)) -> + List.map ~f:xml_element_of_Xml children + |> List.map ~f:compile_attributes + |> List.concat + | Element ((tag_name, _, _)) -> + failwith (Printf.sprintf "(%s)" tag_name) + | PCData s -> failwith s + +let compile_request (request : string) : string = + let request = Xml.parse_string request in + let attributes = compile_request' request in + Yojson.Basic.to_string (`List attributes) diff --git a/xacml-translation/json_xacml_translator/lib/translator.mli b/xacml-translation/json_xacml_translator/lib/translator.mli new file mode 100644 index 0000000..024211c --- /dev/null +++ b/xacml-translation/json_xacml_translator/lib/translator.mli @@ -0,0 +1 @@ +val compile_request : string -> string diff --git a/xacml-translation/json_xacml_translator/test/dune b/xacml-translation/json_xacml_translator/test/dune new file mode 100644 index 0000000..c75ecd9 --- /dev/null +++ b/xacml-translation/json_xacml_translator/test/dune @@ -0,0 +1,2 @@ +(test + (name json_xacml_translator)) diff --git a/xacml-translation/json_xacml_translator/test/json_xacml_translator.ml b/xacml-translation/json_xacml_translator/test/json_xacml_translator.ml new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/xacml-translation/json_xacml_translator/test/json_xacml_translator.ml |