From ea39c24dde16c688da777af497974ed38ed707b8 Mon Sep 17 00:00:00 2001 From: swrup Date: Sun, 8 Feb 2026 16:54:50 +0100 Subject: [PATCH] --- tools/gen_signatures_registry.ml | 85 ++++++++++++++++---------------- 1 file changed, 43 insertions(+), 42 deletions(-) diff --git a/tools/gen_signatures_registry.ml b/tools/gen_signatures_registry.ml index 97556917..d9c4dd37 100644 --- a/tools/gen_signatures_registry.ml +++ b/tools/gen_signatures_registry.ml @@ -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 *) -open Angstrom + open Angstrom -type field = { - k: string; - v: string; -} + type field = { + k: string; + v: string; + } -type record = field list + type record = field list -let newline = char '\n' -let is_newline = function '\n' -> true | _ -> false + 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) + 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 + (* 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 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 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 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 recfile : record list t = + 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 = "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 -> match l with | a :: b :: c :: _ -> ( + let open Recfile in match a.k = "Number" && b.k = "Name" && c.k = "Comment" with | false -> None | true -> @@ -93,7 +94,7 @@ let parse_purposes records = let () = download (); 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 | Ok records -> let purposes = parse_purposes records in