Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

tail recursive key parsing #79

Open
wants to merge 3 commits into
base: master
Choose a base branch
from
Open

tail recursive key parsing #79

Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
e3981f0
print_pkey: show number of packets
ygrek Jun 24, 2020
ca98434
KeyMerge: get rid of Stream.of_list which is not tail-recursive
ygrek Jun 24, 2020
8af4cfc
KeyMerge: tail-recursive flatten
ygrek Jun 24, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
103 changes: 48 additions & 55 deletions keyMerge.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -87,24 +87,39 @@ let packets_equal p1 p2 = p1 = p2
(*******************************************************************)
(** Code for flattening out the above structure back to the original key *)

let rec flatten_sigpair_list list = match list with
[] -> []
| (pack,sigs)::tl -> pack :: (sigs @ flatten_sigpair_list tl)
let rec flatten_sigpair_list list =
match list with
| [] -> []
| (pack,sigs)::tl -> pack :: (List.rev_append sigs (flatten_sigpair_list tl)) (* order of sigs doesn't matter *)

(* stack proportional to [List.length l] which is constant in our case *)
let rec list_concat l =
match l with
| [] -> []
| h::tl -> List.rev_append (List.rev h) (list_concat tl)

let flatten key =
key.key :: List.concat [ key.selfsigs;
key.key :: list_concat [ key.selfsigs;
flatten_sigpair_list key.uids;
flatten_sigpair_list key.subkeys ]


(************************************************************)

let nr_packets l = List.fold_left ~f:(fun acc (_,l) -> acc + List.length l) ~init:0 l

let print_pkey key =
printf "%d selfsigs, %d uids, %d subkeys\n"
let uid =
match List.filter ~f:(fun (p,_) -> p.packet_type = User_ID_Packet) key.uids with
| [] -> ""
| (h,_)::_ -> h.packet_body
in
printf "%S : %d selfsigs, %d uids (%d packets), %d subkeys (%d packets)\n"
uid
(List.length key.selfsigs)
(List.length key.uids)
(nr_packets key.uids)
(List.length key.subkeys)

(nr_packets key.subkeys)

(*******************************************************************)

Expand All @@ -114,42 +129,31 @@ let get_version packet =
| Signature_Packet -> int_of_char packet.packet_body.[0]
| _ -> raise Not_found

let key_to_stream key =
let ptype_list = List.map ~f:(fun pack -> (pack.packet_type,pack)) key in
Stream.of_list ptype_list




(*******************************************************************)
(*** Key Parsing ***************************************************)
(*******************************************************************)

let parse_list parser strm =
let rec loop parser strm accum =
match parser strm with
| Some elt -> loop parser strm (elt :: accum)
| None -> List.rev accum
| Some (elt, strm) -> loop parser strm (elt :: accum)
| None -> List.rev accum, strm
in
loop parser strm []

let parse_sig strm =
match Stream.peek strm with
| Some (Signature_Packet, p) ->
Stream.junk strm;
Some p
match strm with
| { packet_type = Signature_Packet; _ } as p :: strm -> Some (p,strm)
| _ -> None

let parse_uid strm =
match Stream.peek strm with
| Some (User_ID_Packet, p) ->
Stream.junk strm;
let sigs = parse_list parse_sig strm in
Some (p, sigs)
| Some ((User_Attribute_Packet, p)) ->
Stream.junk strm;
let sigs = parse_list parse_sig strm in
Some (p, sigs)
match strm with
| { packet_type = User_ID_Packet; _ } as p :: strm ->
let sigs, strm = parse_list parse_sig strm in
Some ((p, sigs), strm)
| { packet_type = User_Attribute_Packet; _ } as p :: strm ->
let sigs, strm = parse_list parse_sig strm in
Some ((p, sigs), strm)
| _ ->
(*
(p,sigs)::(match s with parser
Expand All @@ -160,31 +164,31 @@ let parse_uid strm =
None

let parse_subkey strm =
match Stream.peek strm with
| Some (Public_Subkey_Packet, p) ->
Stream.junk strm;
let sigs = parse_list parse_sig strm in
Some (p, sigs)
match strm with
| { packet_type = Public_Subkey_Packet; _ } as p :: strm ->
let sigs, strm = parse_list parse_sig strm in
Some ((p, sigs), strm)
| _ -> None

let parse_keystr strm =
match Stream.peek strm with
| Some (Public_Key_Packet, key) ->
Stream.junk strm;
let key_to_pkey strm =
match strm with
| { packet_type = Public_Key_Packet; _ } as key :: strm ->
begin match get_version key with
| 4 ->
let selfsigs = parse_list parse_sig strm in
let uids = parse_list parse_uid strm in
let subkeys = parse_list parse_subkey strm in
let selfsigs, strm = parse_list parse_sig strm in
let uids, strm = parse_list parse_uid strm in
let subkeys, strm = parse_list parse_subkey strm in
if strm <> [] then raise Unparseable_packet_sequence;
{ key; selfsigs; uids; subkeys; }
| 2 | 3 ->
let revocations = parse_list parse_sig strm in
let uids = parse_list parse_uid strm in
let revocations, strm = parse_list parse_sig strm in
let uids, strm = parse_list parse_uid strm in
if strm <> [] then raise Unparseable_packet_sequence;
{ key; selfsigs = revocations; uids; subkeys = []; }
| _ ->
failwith "Unexpected key packet version number"
end
| _ -> raise Stream.Failure
| _ -> raise Unparseable_packet_sequence

(*******************************************************************)
(*** Key Merging Code *********************************************)
Expand Down Expand Up @@ -231,17 +235,6 @@ let merge_pkeys key1 key2 =
(*******************************************************************)
(*******************************************************************)

let key_to_pkey key =
try
let keystream = key_to_stream key in
let pkey = parse_keystr keystream in
Stream.empty keystream;
pkey
with
Stream.Failure | Stream.Error _ ->
raise Unparseable_packet_sequence


let merge key1 key2 =
try
let pkey1 = key_to_pkey key1
Expand Down