swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

.

Browse source
This commit is contained in:
swrup 2026-02-08 14:12:54 +01:00
parent 824e4918c2
commit cdf7688632
3 changed files with 681 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

5
tools/dune
View file

@ -10,8 +10,5 @@
(modules gen_signatures_registry)
(libraries angstrom fmt))
; todo
; we depends on curl
; fetch "gnunet-signatures/registry.rec":
; fetch `gnunet-signatures/registry.rec` with:
; curl -s -o registry.rec -X GET "https://git-www.gnunet.org/gana.git/plain/gnunet-signatures/registry.rec"

69
tools/gen_signatures_registry.ml
View file

@ -1,13 +1,7 @@
(* rudimentary recfile parser
https://www.gnu.org/software/recutils/manual/recutils.html#The-Rec-Format *)
open Angstrom
(* rudimentary recfile parser
https://www.gnu.org/software/recutils/manual/recutils.html#The-Rec-Format
field
record
comments
record descriptors
*)
type field = {
k: string;
v: string;
@ -17,8 +11,6 @@ type record = field list
let newline = char '\n'
let is_newline = function '\n' -> true | _ -> false
let blank = satisfy (function ' ' | '\t' -> true | _ -> false)
let blanks = skip_many1 blank
let field_name =
let first_char =
@ -37,32 +29,30 @@ let field_name =
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 comment_line = char '#' *> take_till is_newline <* newline
(*>>| fun _s -> ()*)
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 line_sep = choice [ skip_many comment_line; (newline >>| fun _c -> ()) ]
let record = sep_by1 line_sep field
let recfile : record list t = many line_sep *> many record <* many line_sep
let parse s = parse_string ~consume:All recfile s
let () =
let example = {|
foo: bar
bar: foo
%foo: oof
|} in
match parse_string ~consume:All recfile example with
| Error msg -> prerr_endline ("Parse error: " ^ msg)
| Ok records ->
List.iter
(fun record ->
List.iter (fun { k; v } -> Printf.printf "%s := %s\n" k v) record)
records
(* -- *)
type purpose = {
number: int;
number: int32;
name: string;
comment: string;
}
@ -72,27 +62,32 @@ let f records =
|> List.filter_map (fun l ->
match l with
| a :: b :: c :: _ -> (
match a.k = "number" && b.k = "name" && c.k = "comment" with
match a.k = "Number" && b.k = "Name" && c.k = "Comment" with
| false -> None
| true -> Some { number= int_of_string a.v; name= b.v; comment= c.v })
| true ->
Some
{
number= Int32.of_int (int_of_string a.v);
name= b.v;
comment= c.v;
})
| _ -> None)
|>
(*GNU Taler, >= 1000*)
List.filter (fun v -> v.number >= 1000)
List.filter (fun v -> v.number >= 1000_l)
let read_file file = In_channel.with_open_bin file In_channel.input_all
let () =
let content = read_file "registry.rec" in
Fmt.pr "%s@." content;
match parse content with
| Error msg -> Fmt.failwith "Parse error: %s" msg
| Ok l ->
let l = f l in
| Ok records ->
let purposes = f records in
let pp_purpose ppf { number; name; comment } =
Fmt.pf ppf "(** %s *)\nlet %s : int32 = %d@." comment name number
Fmt.pf ppf "(** %s *)\nlet %s : int32 = %ld\n\n" comment name number
in
Fmt.pr "%a@." (Fmt.list ~sep:Fmt.nop pp_purpose) l;
Fmt.pr "%a@." (Fmt.list ~sep:Fmt.nop pp_purpose) purposes;
()