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 16:54:50 +01:00
parent c957aeb811
commit ea39c24dde
1 changed files with 43 additions and 42 deletions
Download patch file Download diff file Expand all files Collapse all files

85
tools/gen_signatures_registry.ml
View file

@ -1,55 +1,55 @@
(* rudimentary recfile parser module Recfile = struct
(* rudimentary recfile parser
https://www.gnu.org/software/recutils/manual/recutils.html#The-Rec-Format *) https://www.gnu.org/software/recutils/manual/recutils.html#The-Rec-Format *)
open Angstrom open Angstrom
type field = { type field = {
k: string; k: string;
v: string; v: string;
} }
type record = field list type record = field list
let newline = char '\n' let newline = char '\n'
let is_newline = function '\n' -> true | _ -> false let is_newline = function '\n' -> true | _ -> false
let field_name = let field_name =
let first_char = let first_char =
satisfy (function 'a' .. 'z' | 'A' .. 'Z' | '%' -> true | _ -> false) satisfy (function 'a' .. 'z' | 'A' .. 'Z' | '%' -> true | _ -> false)
in in
let subsequent_char = let subsequent_char =
satisfy (function satisfy (function
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> true | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> true
| _ -> false) | _ -> false)
in in
lift2 lift2
(fun hd tl -> String.of_seq (List.to_seq (hd :: tl))) (fun hd tl -> String.of_seq (List.to_seq (hd :: tl)))
first_char (many subsequent_char) first_char (many subsequent_char)
(* todo handle '\' escape and '+' on next line *) (* todo handle '\' escape and '+' on next line *)
let field_value = take_till is_newline <* newline let field_value = take_till is_newline <* newline
let field = let field =
let blank = satisfy (function ' ' | '\t' -> true | _ -> false) in let blank = satisfy (function ' ' | '\t' -> true | _ -> false) in
let blanks = skip_many1 blank in let blanks = skip_many1 blank in
lift3 (fun k () v -> { k; v }) field_name (char ':' *> blanks) field_value lift3 (fun k () v -> { k; v }) field_name (char ':' *> blanks) field_value
let blank = newline *> return () let blank = newline *> return ()
let comment = (char '#' *> take_till is_newline <* newline) *> return () let comment = (char '#' *> take_till is_newline <* newline) *> return ()
let record = many1 field let record = many1 field
let records = let records =
let sep = let sep =
(* at least one blank line *) (* at least one blank line *)
skip_many comment *> blank *> skip_many (comment <|> blank) skip_many comment *> blank *> skip_many (comment <|> blank)
in in
sep_by1 sep record sep_by1 sep record
let recfile : record list t = let recfile : record list t =
skip_many (comment <|> blank) *> records <* skip_many (comment <|> blank) skip_many (comment <|> blank) *> records <* skip_many (comment <|> blank)
let parse s = parse_string ~consume:All recfile s let parse s = parse_string ~consume:All recfile s
end
(* -- *)
let url = let url =
"https://git-www.gnunet.org/gana.git/plain/gnunet-signatures/registry.rec" "https://git-www.gnunet.org/gana.git/plain/gnunet-signatures/registry.rec"
@ -78,6 +78,7 @@ let parse_purposes records =
|> List.filter_map (fun l -> |> List.filter_map (fun l ->
match l with match l with
| a :: b :: c :: _ -> ( | a :: b :: c :: _ -> (
let open Recfile in
match a.k = "Number" && b.k = "Name" && c.k = "Comment" with match a.k = "Number" && b.k = "Name" && c.k = "Comment" with
| false -> None | false -> None
| true -> | true ->
@ -93,7 +94,7 @@ let parse_purposes records =
let () = let () =
download (); download ();
let content = read_file registry_file in let content = read_file registry_file in
match parse content with match Recfile.parse content with
| Error msg -> Fmt.failwith "Recfile parse error: %s" msg | Error msg -> Fmt.failwith "Recfile parse error: %s" msg
| Ok records -> | Ok records ->
let purposes = parse_purposes records in let purposes = parse_purposes records in