add --output-pubkey option; use cmdliner for gana script
This commit is contained in:
parent
53debfd866
commit
67d0820643
6 changed files with 186 additions and 131 deletions
13
tools/dune
13
tools/dune
|
|
@ -5,7 +5,12 @@
|
|||
(libraries cmdliner bos fmt mirage-crypto ptime mte vif))
|
||||
|
||||
(executable
|
||||
(public_name gen_signatures_registry)
|
||||
(name gen_signatures_registry)
|
||||
(modules gen_signatures_registry)
|
||||
(libraries angstrom bos fmt))
|
||||
(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 cmdliner fmt))
|
||||
|
|
|
|||
89
tools/gen_registry_files.ml
Normal file
89
tools/gen_registry_files.ml
Normal file
|
|
@ -0,0 +1,89 @@
|
|||
module Signature_code = struct
|
||||
type t = {
|
||||
number: int32;
|
||||
name: string;
|
||||
comment: string;
|
||||
}
|
||||
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 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 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
|
||||
|
||||
(* --- *)
|
||||
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 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 ]
|
||||
|
||||
let main () = Cmd.eval cli
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
|
|
@ -1,109 +0,0 @@
|
|||
module Recfile = struct
|
||||
(* rudimentary recfile parser
|
||||
https://www.gnu.org/software/recutils/manual/recutils.html#The-Rec-Format *)
|
||||
open Angstrom
|
||||
|
||||
type field = {
|
||||
k: string;
|
||||
v: string;
|
||||
}
|
||||
|
||||
type record = field list
|
||||
|
||||
let newline = char '\n'
|
||||
let is_newline = function '\n' -> true | _ -> false
|
||||
|
||||
let field_name =
|
||||
let first_char =
|
||||
satisfy (function 'a' .. 'z' | 'A' .. 'Z' | '%' -> true | _ -> false)
|
||||
in
|
||||
let subsequent_char =
|
||||
satisfy (function
|
||||
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> true
|
||||
| _ -> false)
|
||||
in
|
||||
lift2
|
||||
(fun hd tl -> String.of_seq (List.to_seq (hd :: tl)))
|
||||
first_char (many subsequent_char)
|
||||
|
||||
(* todo handle '\' escape and '+' on next line *)
|
||||
let field_value = take_till is_newline <* newline
|
||||
|
||||
let field =
|
||||
let blank = satisfy (function ' ' | '\t' -> true | _ -> false) in
|
||||
let blanks = skip_many1 blank in
|
||||
lift3 (fun k () v -> { k; v }) field_name (char ':' *> blanks) field_value
|
||||
|
||||
let blank = newline *> return ()
|
||||
let comment = (char '#' *> take_till is_newline <* newline) *> return ()
|
||||
let record = many1 field
|
||||
|
||||
let records =
|
||||
let sep =
|
||||
(* at least one blank line *)
|
||||
skip_many comment *> blank *> skip_many (comment <|> blank)
|
||||
in
|
||||
sep_by1 sep record
|
||||
|
||||
let recfile : record list t =
|
||||
skip_many (comment <|> blank) *> records <* skip_many (comment <|> blank)
|
||||
|
||||
let parse s = parse_string ~consume:All recfile s
|
||||
end
|
||||
|
||||
let url =
|
||||
"https://git-www.gnunet.org/gana.git/plain/gnunet-signatures/registry.rec"
|
||||
|
||||
let registry_file = "registry.rec"
|
||||
|
||||
let download () =
|
||||
let open Bos in
|
||||
let res =
|
||||
OS.Cmd.run Cmd.(v "curl" % "-s" % "-o" % registry_file % "-X" % "GET" % url)
|
||||
in
|
||||
match res with
|
||||
| Error (`Msg s) -> Fmt.failwith "download failure: %s" s
|
||||
| Ok () -> ()
|
||||
|
||||
let read_file file = In_channel.with_open_bin file In_channel.input_all
|
||||
|
||||
type purpose = {
|
||||
number: int32;
|
||||
name: string;
|
||||
comment: string;
|
||||
}
|
||||
|
||||
let parse_purposes records =
|
||||
records
|
||||
|> List.filter_map (fun l ->
|
||||
match l with
|
||||
| a :: b :: c :: _ -> (
|
||||
let open Recfile 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 () =
|
||||
download ();
|
||||
let content = read_file registry_file in
|
||||
match Recfile.parse content with
|
||||
| Error msg -> Fmt.failwith "Recfile parse error: %s" msg
|
||||
| Ok records ->
|
||||
let purposes = parse_purposes records in
|
||||
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;
|
||||
()
|
||||
|
|
@ -1,13 +1,7 @@
|
|||
(* TODO
|
||||
better cmd doc
|
||||
change arguments: '_' -> '-'
|
||||
|
||||
all management operations:
|
||||
/management/wire
|
||||
/management/wire/disable
|
||||
-> how to build WireSetupMessage?
|
||||
we need additional data to craft master_sig
|
||||
maybe supposed to be found in the full payto-uri?
|
||||
|
||||
/management/aml-officers
|
||||
-> /aml
|
||||
|
|
@ -85,25 +79,40 @@ let url =
|
|||
Arg.(required & opt (some string) None & info [ "url" ] ~doc)
|
||||
|
||||
let setup_cmd =
|
||||
let doc = "Generate offline master keys" in
|
||||
let doc =
|
||||
"Generate offline master keys, write private and public key to file"
|
||||
in
|
||||
let output =
|
||||
let doc = "output file" in
|
||||
let doc = "private key output file" in
|
||||
Arg.(required & opt (some filepath) None & info [ "o"; "output" ] ~doc)
|
||||
in
|
||||
let output_pubkey =
|
||||
let doc =
|
||||
"public key output file, default to --output parameter with a \".pub\" \
|
||||
extension"
|
||||
in
|
||||
Arg.(value & opt (some filepath) None & info [ "output-pubkey" ] ~doc)
|
||||
in
|
||||
Cmd.make (Cmd.info "setup" ~doc)
|
||||
@@
|
||||
let+ output = output in
|
||||
setup ~output
|
||||
let+ output = output and+ output_pubkey = output_pubkey in
|
||||
let output_pubkey = Option.value ~default:(output ^ ".pub") output_pubkey in
|
||||
setup ~output ~output_pubkey
|
||||
|
||||
let download_cmd =
|
||||
let doc = "GET" in
|
||||
let doc =
|
||||
"use curl to send a GET request to --url, write response body to --output"
|
||||
in
|
||||
Cmd.make (Cmd.info "download" ~doc)
|
||||
@@
|
||||
let+ output = output and+ url = url in
|
||||
download ~output ~url
|
||||
|
||||
let upload_cmd =
|
||||
let doc = "POST" in
|
||||
let doc =
|
||||
"use curl to send a POST request to --url, with request body set to \
|
||||
--input file content"
|
||||
in
|
||||
Cmd.make (Cmd.info "upload" ~doc)
|
||||
@@
|
||||
let+ input = input and+ url = url in
|
||||
|
|
|
|||
|
|
@ -163,7 +163,16 @@ let read_master_key_file filename =
|
|||
|
||||
let download ~output ~url =
|
||||
let open Bos in
|
||||
OS.Cmd.run Cmd.(v "curl" % "--silent" % "-o" % output % "-X" % "GET" % url)
|
||||
OS.Cmd.run
|
||||
Cmd.(
|
||||
v "curl"
|
||||
% "--silent"
|
||||
% "--show-error"
|
||||
% "-o"
|
||||
% output
|
||||
% "-X"
|
||||
% "GET"
|
||||
% url)
|
||||
|> unwrap_err_msg
|
||||
|
||||
let upload ~input ~url =
|
||||
|
|
@ -182,13 +191,14 @@ let upload ~input ~url =
|
|||
% url)
|
||||
|> unwrap_err_msg
|
||||
|
||||
let setup ~output =
|
||||
let () = Mirage_crypto_rng_unix.use_default () in
|
||||
let setup ~output ~output_pubkey =
|
||||
Mirage_crypto_rng_unix.use_default ();
|
||||
let priv, pub = Mirage_crypto_ec.Ed25519.generate () in
|
||||
Fmt.pr "generated master public key:@\n%s@."
|
||||
(Mirage_crypto_ec.Ed25519.pub_to_octets pub |> B32.encode);
|
||||
let priv_data = Mirage_crypto_ec.Ed25519.priv_to_octets priv in
|
||||
write_file output priv_data
|
||||
let* () = write_file output priv_data in
|
||||
let pub_data = Mirage_crypto_ec.Ed25519.pub_to_octets pub |> B32.encode in
|
||||
let* () = write_file output_pubkey pub_data in
|
||||
Ok ()
|
||||
|
||||
let sign ~master_key ~input ~output =
|
||||
let open Crypto in
|
||||
|
|
|
|||
51
tools/recfile_parser.ml
Normal file
51
tools/recfile_parser.ml
Normal file
|
|
@ -0,0 +1,51 @@
|
|||
(* very rudimentary recfile parser
|
||||
https://www.gnu.org/software/recutils/manual/recutils.html#The-Rec-Format *)
|
||||
|
||||
open Angstrom
|
||||
|
||||
type field = {
|
||||
k: string;
|
||||
v: string;
|
||||
}
|
||||
|
||||
type record = field list
|
||||
|
||||
let newline = char '\n'
|
||||
let is_newline = function '\n' -> true | _ -> false
|
||||
|
||||
let field_name =
|
||||
let first_char =
|
||||
satisfy (function 'a' .. 'z' | 'A' .. 'Z' | '%' -> true | _ -> false)
|
||||
in
|
||||
let subsequent_char =
|
||||
satisfy (function
|
||||
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> true
|
||||
| _ -> false)
|
||||
in
|
||||
lift2
|
||||
(fun hd tl -> String.of_seq (List.to_seq (hd :: tl)))
|
||||
first_char (many subsequent_char)
|
||||
|
||||
(* todo handle '\' escape and '+' on next line *)
|
||||
let field_value = take_till is_newline <* newline
|
||||
|
||||
let field =
|
||||
let blank = satisfy (function ' ' | '\t' -> true | _ -> false) in
|
||||
let blanks = skip_many1 blank in
|
||||
lift3 (fun k () v -> { k; v }) field_name (char ':' *> blanks) field_value
|
||||
|
||||
let blank = newline *> return ()
|
||||
let comment = (char '#' *> take_till is_newline <* newline) *> return ()
|
||||
let record = many1 field
|
||||
|
||||
let records =
|
||||
let sep =
|
||||
(* at least one blank line *)
|
||||
skip_many comment *> blank *> skip_many (comment <|> blank)
|
||||
in
|
||||
sep_by1 sep record
|
||||
|
||||
let recfile : record list t =
|
||||
skip_many (comment <|> blank) *> records <* skip_many (comment <|> blank)
|
||||
|
||||
let parse s = parse_string ~consume:All recfile s
|
||||
Loading…
Add table
Add a link
Reference in a new issue