diff --git a/keyMerge.ml b/keyMerge.ml index 4c9f88e..c8ee5a1 100644 --- a/keyMerge.ml +++ b/keyMerge.ml @@ -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) (*******************************************************************) @@ -114,13 +129,6 @@ 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 ***************************************************) (*******************************************************************) @@ -128,28 +136,24 @@ let key_to_stream key = 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 @@ -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 *********************************************) @@ -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