registry.rec

@@ -0,0 +1,39 @@
+# -*- mode: rec -*-
+#
+# Registry for Signature purposes
+#
+
+%rec: SignaturePurpose
+%key: Number
+%type: Number int
+%mandatory: Number
+%typedef: Name_t regexp /^[ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_][ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_]*$/
+%type: Name Name_t
+%unique: Name
+%mandatory: Name
+%mandatory: Comment
+%mandatory: Package
+%allowed: Subsystem
+%sort: Number Name
+
+
+#-----------------------------------------------------------------------------
+# GNUnet
+
+Number: 0
+Name: TEST
+Comment: Test signature, not valid for anything other than writing a test. (Note that the signature verification code will accept this value).
+Package: GNUnet
+Subsystem: GNUnet
+
+Number: 1
+Name: TRANSPORT_PONG_OWN
+Comment: Signature for confirming that this peer uses a particular address.
+Package: GNUnet
+Subsystem: GNUnet-TRANSPORT
+
+Number: 2
+Name: TRANSPORT_DISCONNECT
+Comment: Signature for confirming that this peer intends to disconnect.
+Package: GNUnet
+Subsystem: GNUnet-TRANSPORT

tools/dune

@@ -4,4 +4,14 @@
  (modules offline offline_impl offline_sig)
  (libraries cmdliner bos fmt mirage-crypto ptime mte vif))
 
-; todo depends on curl
+(executable
+ (public_name gen_signatures_registry)
+ (name gen_signatures_registry)
+ (modules gen_signatures_registry)
+ (libraries angstrom fmt))
+
+; todo
+; we depends on curl
+
+; fetch "gnunet-signatures/registry.rec":
+;   curl -s -o registry.rec -X GET "https://git-www.gnunet.org/gana.git/plain/gnunet-signatures/registry.rec"

tools/gen_signatures_registry.ml

@@ -0,0 +1,96 @@
+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;
+}
+
+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 =
+    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 =
+  lift3 (fun k () v -> { k; v }) field_name (char ':' *> blanks) field_value
+
+let comments = many (char '#' *> take_till is_newline <* newline)
+let line_sep = comments <* newline
+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;
+  name: string;
+  comment: string;
+}
+
+let f records =
+  records
+  |> List.filter_map (fun l ->
+      match l with
+      | a :: b :: c :: _ -> (
+          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 })
+      | _ -> None)
+  |>
+  (*GNU Taler, >= 1000*)
+  List.filter (fun v -> v.number >= 1000)
+
+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
+
+      let pp_purpose ppf { number; name; comment } =
+        Fmt.pf ppf "(** %s *)\nlet %s : int32 = %d@." comment name number
+      in
+
+      Fmt.pr "%a@." (Fmt.list ~sep:Fmt.nop pp_purpose) l;
+      ()