This commit is contained in:
parent
2e5539eeb9
commit
56ee9741b3
4 changed files with 456 additions and 71 deletions
|
|
@ -5,12 +5,12 @@
|
|||
(libraries cmdliner bos fmt mirage-crypto ptime mte vif))
|
||||
|
||||
(executable
|
||||
(public_name gen_taler_signatures)
|
||||
(name gen_taler_signatures)
|
||||
(modules gen_taler_signatures)
|
||||
(public_name gen_registry_files)
|
||||
(name gen_registry_files)
|
||||
(modules gen_registry_files)
|
||||
(libraries recfile_parser bos fmt))
|
||||
|
||||
(library
|
||||
(name recfile_parser)
|
||||
(modules recfile_parser)
|
||||
(libraries angstrom bos fmt))
|
||||
(libraries angstrom bos cmdliner fmt))
|
||||
|
|
|
|||
172
tools/gen_registry_files.ml
Normal file
172
tools/gen_registry_files.ml
Normal file
|
|
@ -0,0 +1,172 @@
|
|||
module Signature_code = struct
|
||||
type t = {
|
||||
number: int32;
|
||||
name: string;
|
||||
comment: string;
|
||||
}
|
||||
end
|
||||
|
||||
module Error_code = struct
|
||||
type t = {
|
||||
value: int;
|
||||
name: string;
|
||||
description: string;
|
||||
http_status: int;
|
||||
}
|
||||
end
|
||||
|
||||
let parse_signature_codes records =
|
||||
records
|
||||
|> List.filter_map (fun l ->
|
||||
match l with
|
||||
| a :: b :: c :: _ -> (
|
||||
let open Recfile_parser in
|
||||
match a.k = "Number" && b.k = "Name" && c.k = "Comment" with
|
||||
| false -> None
|
||||
| true ->
|
||||
Some
|
||||
Signature_code.
|
||||
{
|
||||
number= Int32.of_int (int_of_string a.v);
|
||||
name= String.lowercase_ascii b.v;
|
||||
comment= c.v;
|
||||
})
|
||||
| _ -> None)
|
||||
|> List.filter (fun v -> v.Signature_code.number >= 1000_l)
|
||||
|
||||
let parse_error_codes records =
|
||||
records
|
||||
|> List.filter_map (fun l ->
|
||||
match l with
|
||||
| a :: b :: c :: d :: _ -> (
|
||||
let open Recfile_parser in
|
||||
match
|
||||
a.k = "Value"
|
||||
&& b.k = "Name"
|
||||
&& c.k = "Description"
|
||||
&& d.k = "HttpStatus"
|
||||
with
|
||||
| false -> None
|
||||
| true ->
|
||||
Some
|
||||
Error_code.
|
||||
{
|
||||
value= int_of_string a.v;
|
||||
name= b.v;
|
||||
description= c.v;
|
||||
http_status= int_of_string d.v;
|
||||
})
|
||||
| _ -> None)
|
||||
|
||||
let pp_taler_signatures_ml ppf purposes =
|
||||
let header =
|
||||
{|(* This file was generated from the GANA database:
|
||||
https://git-www.gnunet.org/gana.git/tree/gnunet-signatures/registry.rec *)|}
|
||||
in
|
||||
let pp ppf Signature_code.{ number; name; comment } =
|
||||
Fmt.pf ppf "(** %s *)\nlet %s : int32 = %ld_l\n\n" comment name number
|
||||
in
|
||||
Fmt.pf ppf "%s\n\n%a@." header (Fmt.list ~sep:Fmt.nop pp) purposes;
|
||||
()
|
||||
|
||||
let pp_taler_error_codes_ml ppf purposes =
|
||||
let header =
|
||||
{|(* This file was generated from the GANA database:
|
||||
https://git-www.gnunet.org/gana.git/tree/gnunet-error-codes/registry.rec
|
||||
https://git-www.gnunet.org/gana.git/tree/gnu-taler-error-codes/registry.rec *)|}
|
||||
in
|
||||
Fmt.pf ppf
|
||||
"\n\n\
|
||||
type t ={ value: int; name: string; description: string; http_status: int \
|
||||
}\n\n";
|
||||
let pp ppf Error_code.{ value; name; description; http_status } =
|
||||
Fmt.pf ppf
|
||||
{|let %s = { value = %d; name = "%s"; description = "%s"; http_status = %d }\n\n|}
|
||||
(String.lowercase_ascii name)
|
||||
value name description http_status
|
||||
in
|
||||
Fmt.pf ppf "%s\n\n%a@." header (Fmt.list ~sep:Fmt.nop pp) purposes;
|
||||
()
|
||||
|
||||
let download ~tmp ~url =
|
||||
let open Bos in
|
||||
let res =
|
||||
OS.Cmd.run
|
||||
Cmd.(
|
||||
v "curl" % "--silent" % "--show-error" % "-o" % tmp % "-X" % "GET" % url)
|
||||
in
|
||||
match res with
|
||||
| Error (`Msg s) -> Fmt.failwith "download failure: %s" s
|
||||
| Ok () -> ()
|
||||
|
||||
(* --- *)
|
||||
|
||||
let signatures ~output =
|
||||
let url =
|
||||
"https://git-www.gnunet.org/gana.git/plain/gnunet-signatures/registry.rec"
|
||||
in
|
||||
let tmp_file = Bos.OS.File.tmp "registry.rec.%s" |> Result.get_ok in
|
||||
download ~tmp:(Fpath.to_string tmp_file) ~url;
|
||||
let content = Bos.OS.File.read tmp_file |> Result.get_ok in
|
||||
match Recfile_parser.parse content with
|
||||
| Error msg -> Fmt.failwith "Recfile_parser parse error: %s" msg
|
||||
| Ok records ->
|
||||
let purposes = parse_signature_codes records in
|
||||
let module_content = Fmt.str "%a" pp_taler_signatures_ml purposes in
|
||||
Bos.OS.File.write (Fpath.v output) module_content |> Result.get_ok
|
||||
|
||||
let error_codes ~output =
|
||||
let f url =
|
||||
let tmp_file = Bos.OS.File.tmp "registry.rec.%s" |> Result.get_ok in
|
||||
download ~tmp:(Fpath.to_string tmp_file) ~url;
|
||||
let content = Bos.OS.File.read tmp_file |> Result.get_ok in
|
||||
match Recfile_parser.parse content with
|
||||
| Error msg -> Fmt.failwith "Recfile_parser parse error: %s" msg
|
||||
| Ok records -> parse_error_codes records
|
||||
in
|
||||
let url_1 =
|
||||
"https://git-www.gnunet.org/gana.git/plain/gnunet-error-codes/registry.rec"
|
||||
in
|
||||
let url_2 =
|
||||
"https://git-www.gnunet.org/gana.git/plain/gnu-taler-error-codes/registry.rec"
|
||||
in
|
||||
let error_codes = f url_1 @ f url_2 in
|
||||
let module_content = Fmt.str "%a" pp_taler_error_codes_ml error_codes in
|
||||
Bos.OS.File.write (Fpath.v output) module_content |> Result.get_ok
|
||||
|
||||
(* --- *)
|
||||
open Cmdliner
|
||||
open Cmdliner.Term.Syntax
|
||||
|
||||
let output =
|
||||
let doc = "output file" in
|
||||
Arg.(required & opt (some filepath) None & info [ "o"; "output" ] ~doc)
|
||||
|
||||
let signatures_cmd =
|
||||
let doc =
|
||||
"Generate taler_signatures.ml from GANA gnunet-signatures registry"
|
||||
in
|
||||
Cmd.make (Cmd.info "signatures" ~doc)
|
||||
@@
|
||||
let+ output = output in
|
||||
signatures ~output
|
||||
|
||||
let error_codes_cmd =
|
||||
let doc =
|
||||
"Generate taler_error_codes.ml from GANA gnunet-error-codes and \
|
||||
gnunet-taler-error-codes registries"
|
||||
in
|
||||
Cmd.make (Cmd.info "error_codes" ~doc)
|
||||
@@
|
||||
let+ output = output in
|
||||
error_codes ~output
|
||||
|
||||
let cli =
|
||||
let info =
|
||||
let doc = "Tool to generate OCaml module from GANA registries" in
|
||||
Cmd.info "gen_registry_files" ~doc
|
||||
in
|
||||
Cmd.group info [ signatures_cmd; error_codes_cmd ]
|
||||
|
||||
let main () = Cmd.eval cli
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
|
|
@ -1,67 +0,0 @@
|
|||
type purpose = {
|
||||
number: int32;
|
||||
name: string;
|
||||
comment: string;
|
||||
}
|
||||
|
||||
let download ~output ~url =
|
||||
let open Bos in
|
||||
let res =
|
||||
OS.Cmd.run
|
||||
Cmd.(
|
||||
v "curl"
|
||||
% "--silent"
|
||||
% "--show-error"
|
||||
% "-o"
|
||||
% output
|
||||
% "-X"
|
||||
% "GET"
|
||||
% url)
|
||||
in
|
||||
match res with
|
||||
| Error (`Msg s) -> Fmt.failwith "download failure: %s" s
|
||||
| Ok () -> ()
|
||||
|
||||
let parse_purposes records =
|
||||
records
|
||||
|> List.filter_map (fun l ->
|
||||
match l with
|
||||
| a :: b :: c :: _ -> (
|
||||
let open Recfile_parser in
|
||||
match a.k = "Number" && b.k = "Name" && c.k = "Comment" with
|
||||
| false -> None
|
||||
| true ->
|
||||
Some
|
||||
{
|
||||
number= Int32.of_int (int_of_string a.v);
|
||||
name= String.lowercase_ascii b.v;
|
||||
comment= c.v;
|
||||
})
|
||||
| _ -> None)
|
||||
|> List.filter (fun v -> v.number >= 1000_l)
|
||||
|
||||
let print_module purposes =
|
||||
let header =
|
||||
{|(* This file was generated from the GANA database:
|
||||
https://git-www.gnunet.org/gana.git/tree/gnunet-signatures/registry.rec *)|}
|
||||
in
|
||||
let pp ppf { number; name; comment } =
|
||||
Fmt.pf ppf "(** %s *)\nlet %s : int32 = %ld_l\n\n" comment name number
|
||||
in
|
||||
Fmt.pr "%s\n\n%a@." header (Fmt.list ~sep:Fmt.nop pp) purposes;
|
||||
()
|
||||
|
||||
(* --- *)
|
||||
|
||||
let url =
|
||||
"https://git-www.gnunet.org/gana.git/plain/gnunet-signatures/registry.rec"
|
||||
|
||||
let main () =
|
||||
let tmp_file = Bos.OS.File.tmp "registry.rec.%s" |> Result.get_ok in
|
||||
download ~output:(Fpath.to_string tmp_file) ~url;
|
||||
let content = Bos.OS.File.read tmp_file |> Result.get_ok in
|
||||
match Recfile_parser.parse content with
|
||||
| Error msg -> Fmt.failwith "Recfile_parser parse error: %s" msg
|
||||
| Ok records -> print_module (parse_purposes records)
|
||||
|
||||
let () = main ()
|
||||
Loading…
Add table
Add a link
Reference in a new issue