From be7a4d3340c7275193d529c7edf6c45cd049aaeb Mon Sep 17 00:00:00 2001 From: Ulugbek Abdullaev Date: Mon, 4 Jan 2021 16:19:24 +0500 Subject: [PATCH] * add decoding for all commands * add some tests --- src/wire-proto-v2/protocol.ml | 374 ++++++++++++++++++++++++++++++++++ test/wire-protocol-v2/test.ml | 132 ++++++++++++ 2 files changed, 506 insertions(+) create mode 100644 test/wire-protocol-v2/test.ml diff --git a/src/wire-proto-v2/protocol.ml b/src/wire-proto-v2/protocol.ml index adbf0332c..bef917e77 100644 --- a/src/wire-proto-v2/protocol.ml +++ b/src/wire-proto-v2/protocol.ml @@ -192,6 +192,380 @@ module Extended_pkt_line_decoder = struct prompt_pkt (loop init) decoder end +module Decoder = struct + open Extended_pkt_line_decoder + module Substr = String.Sub + + let ( >>=? ) x f = Option.bind x f + let ( >|=? ) x f = Option.map f x + + (** + capability-advertisement = protocol-version + capability-list + flush-pkt + + protocol-version = PKT-LINE("version 2" LF) + capability-list = *capability + capability = PKT-LINE(key[=value] LF) + + key = 1*(ALPHA | DIGIT | "-_") + value = 1*(ALPHA | DIGIT | " -_.,?\/{}[]()<>!@#$%^&*+=:;") *) + let decode_capability_ads decoder = + (* protocol-version *) + skip_string "version 2" decoder >>= fun () -> + let expected = `Pkt [ `Str "key[=value] LF" ] in + + (* capability-list + flush-pkt *) + decode_fold_until decoder ~init:[] ~finalize:List.rev ~f:(fun acc -> + function + | Flush_pkt -> Stop_ok + | Pkt (_, pkt_content) -> + Continue (Capability.of_string pkt_content :: acc) + | (Delim_pkt | Response_end_pkt | Invalid_len_pkt _) as pkt -> + Stop_err (unexpected_pkt ~expected pkt)) + + let v_space = Substr.of_string " " + let v_colon = Substr.of_string ":" + let is_symref_target_v s = Substr.equal s (Substr.of_string "symref-target") + let is_peeled_v s = Substr.equal s (Substr.of_string "peeled") + + (** + output = *ref + flush-pkt + + ref = PKT-LINE(obj-id SP refname *(SP ref-attribute) LF) + ref-attribute = (symref | peeled) + symref = "symref-target:" symref-target + peeled = "peeled:" obj-id *) + let decode_ls_refs_response decoder = + let expected = + `Or (`Flush_pkt, `Pkt [ `Str "obj-id SP refname *(SP ref-attribute) LF" ]) + in + (* ref-attribute *) + let parse_ref_attr attr = + Substr.cut ~sep:v_colon attr >>=? fun (k, v) -> + match Substr.to_string k, Substr.to_string v with + | "symref-target", v -> Some (Ls_refs.Symref_target v) + | "peeled", v -> Some (Ls_refs.Peeled v) + | _ -> None + in + (* ref *) + let parse_ref ref_ = + let s = String.Sub.of_string ref_ in + match String.Sub.cuts ~sep:v_space s with + | obj_id :: name :: ref_attrs -> + let obj_id = Substr.to_string obj_id in + let name = Substr.to_string name in + let rec parse_or_none acc = function + | [] -> Some (List.rev acc) + | r :: rest -> + parse_ref_attr r >>=? fun r -> parse_or_none (r :: acc) rest + in + parse_or_none [] ref_attrs + |> Option.map (fun attributes -> Ls_refs.{ obj_id; name; attributes }) + | [] | _ :: _ -> None + in + decode_fold_until decoder ~init:[] ~finalize:List.rev ~f:(fun acc -> + function + | Flush_pkt -> Stop_ok + | Pkt (_, pkt) -> ( + match parse_ref pkt with + | Some ref_ -> Continue (ref_ :: acc) + | None -> Stop_err (mismatch ~expected ~got:(`Str pkt))) + | (Delim_pkt | Response_end_pkt | Invalid_len_pkt _) as pkt -> + Stop_err (unexpected_pkt ~expected pkt)) + + let peek_pkt ?(trim = true) decoder = + let buf, off, len = peek_pkt decoder in + let buf = Bytes.to_string buf in + let res = String.Sub.v buf ~start:off ~stop:(off + len) in + let is_new_line c = Char.equal c '\n' in + if trim then String.Sub.trim ~drop:is_new_line res else res + + let prompt_pack_without_sideband kcontinue keof decoder = + if decoder.pos > 0 then ( + let rest = decoder.max - decoder.pos in + Bytes.unsafe_blit decoder.buffer decoder.pos decoder.buffer 0 rest; + decoder.max <- rest; + decoder.pos <- 0); + let rec go off = + if off = Bytes.length decoder.buffer && decoder.pos > 0 then + Error + { + error = `No_enough_space; + buffer = decoder.buffer; + committed = decoder.pos; + } + else if off - decoder.pos > 0 then ( + decoder.max <- off; + safe kcontinue decoder) + else + Read + { + buffer = decoder.buffer; + off; + len = Bytes.length decoder.buffer - off; + continue = (fun len -> go (off + len)); + eof = keof decoder; + } + in + go decoder.max + + let peek_pack_without_sideband (decoder : decoder) = + let payload = + Bytes.sub_string decoder.buffer decoder.pos (decoder.max - decoder.pos) + in + payload, 0, decoder.max - decoder.pos + + let junk_pack_without_sideband (decoder : decoder) = + decoder.pos <- decoder.max + + let decode_pack ?(side_band = false) ~push_pack ~push_stdout ~push_stderr + decoder = + let with_side_band decoder = + let v = peek_pkt ~trim:false decoder in + match String.Sub.head v with + | Some '\001' -> + let off = String.Sub.start_pos v + 1 in + let len = String.Sub.stop_pos v - off in + let buf = String.Sub.base_string v in + push_pack (buf, off, len); + junk_pkt decoder; + return true decoder + | Some '\002' -> + let tail = String.Sub.to_string (String.Sub.tail v) (* copy *) in + push_stdout tail; + junk_pkt decoder; + return true decoder + | Some '\003' -> + let tail = String.Sub.to_string (String.Sub.tail v) (* copy *) in + push_stderr tail; + junk_pkt decoder; + return true decoder + | Some _ -> fail decoder (`Invalid_side_band (String.Sub.to_string v)) + | None -> return false decoder + in + let end_of_pack decoder () = return false decoder in + let without_side_band decoder = + let buf, off, len = peek_pack_without_sideband decoder in + push_pack (buf, off, len); + junk_pack_without_sideband decoder; + return true decoder + in + if side_band then prompt_pkt ~strict:true with_side_band decoder + else prompt_pack_without_sideband without_side_band end_of_pack decoder + + (** [if_str_else s then_ else_ d] peeks the to-be-read packet [p] and + if its packet content equals [s], runs [then_] junking [p]; + otherwise, runs [else_] without junking packet [p]. *) + let if_str_else str ~then_ ~else_ decoder = + match peek_pkt' decoder with + | Pkt (l, pkt_content) when String.equal pkt_content str -> + junk_chars l decoder; + prompt_pkt then_ decoder + | Pkt _ | Flush_pkt | Delim_pkt | Response_end_pkt | Invalid_len_pkt _ -> + prompt_pkt else_ decoder + + let or_delim_pkt other = `Or (`Delim_pkt, other) + + (** + output = acknowledgements flush-pkt | + [acknowledgments delim-pkt] [shallow-info delim-pkt] + [wanted-refs delim-pkt] [packfile-uris delim-pkt] + packfile flush-pkt + + acknowledgments = PKT-LINE("acknowledgments" LF) + (nak | *ack) + (ready) + Note: The spec for acknowledgements seem to confuse parens for brackets to + specify "ready" as optional. + + ready = PKT-LINE("ready" LF) + nak = PKT-LINE("NAK" LF) + ack = PKT-LINE("ACK" SP obj-id LF) + + shallow-info = PKT-LINE("shallow-info" LF) + *PKT-LINE((shallow | unshallow) LF) + shallow = "shallow" SP obj-id + unshallow = "unshallow" SP obj-id + + wanted-refs = PKT-LINE("wanted-refs" LF) + *PKT-LINE(wanted-ref LF) + wanted-ref = obj-id SP refname + + packfile-uris = PKT-LINE("packfile-uris" LF) *packfile-uri + packfile-uri = PKT-LINE(40*(HEXDIGIT) SP *%x20-ff LF) + + packfile = PKT-LINE("packfile" LF) + *PKT-LINE(%x01-03 *%x00-ff) *) + let decode_fetch_response decoder = + let open Fetch_command in + let decode_detailed_with_packfile acks decoder = + let decode_pack decoder : (unit, _) state = + match read_pkt decoder with + | Pkt (_, "packfile") -> failwith "(TODO:) not implemented" + | _ as pkt -> + unexpected_pkt ~expected:(`Str "packfile") pkt |> error decoder + in + + let decode_packfile_uris decoder = + let parse_packfile_uri s = + String.cut ~sep:" " s >>=? fun (obj_id, v) -> + if String.length obj_id = 40 then Some (obj_id, v) else None + in + let then_ decoder = + let expected = + or_delim_pkt (`Pkt [ `Str "40*(HEXDIGIT) SP *%x20-ff LF" ]) + in + decode_fold_until decoder ~init:[] ~finalize:List.rev + ~f:(fun acc pkt -> + match pkt with + | Delim_pkt -> Stop_ok + | Pkt (_, pkt_content) -> ( + match parse_packfile_uri pkt_content with + | None -> Stop_err (unexpected_pkt ~expected pkt) + | Some (obj_id, v) -> Continue ((obj_id, v) :: acc)) + | (Flush_pkt | Response_end_pkt | Invalid_len_pkt _) as pkt -> + Stop_err (unexpected_pkt ~expected pkt)) + in + let else_ decoder = return [] decoder in + prompt_pkt (if_str_else "packfile-uris" ~then_ ~else_) decoder + in + + let decode_wanted_refs decoder = + let then_ decoder = + let expected = or_delim_pkt (`Pkt [ `Str "obj-id SP refname" ]) in + decode_fold_until decoder ~init:[] ~finalize:List.rev + ~f:(fun acc pkt -> + match pkt with + | Delim_pkt -> Stop_ok + | Pkt (_, pkt_content) -> ( + match String.cut ?rev:None ~sep:" " pkt_content with + | Some (obj_id, refname) when String.length obj_id = 40 -> + Continue ((obj_id, refname) :: acc) + | Some _ | None -> Stop_err (unexpected_pkt ~expected pkt)) + | Flush_pkt | Response_end_pkt | Invalid_len_pkt _ -> + Stop_err (unexpected_pkt ~expected pkt)) + in + let else_ decoder = return [] decoder in + prompt_pkt (if_str_else "wanted-refs" ~then_ ~else_) decoder + in + + let decode_shallow_info decoder = + let then_ decoder = + let expected = + `Or + ( `Delim_pkt, + `Or + ( `Pkt [ `Str "\"shallow\" SP obj-id" ], + `Pkt [ `Str "\"unshallow\" SP obj-id" ] ) ) + in + decode_fold_until decoder ~init:([], []) + ~finalize:(fun (ll, lr) -> + `Shallows (List.rev ll), `Unshallows (List.rev lr)) + ~f:(fun (shallows, unshallows) pkt -> + match pkt with + | Delim_pkt -> Stop_ok + | Pkt (_, pkt_content) -> ( + match String.cut ~sep:" " pkt_content with + | Some ("shallow", obj_id) -> + Continue (obj_id :: shallows, unshallows) + | Some ("unshallow", obj_id) -> + Continue (shallows, obj_id :: unshallows) + | None | Some _ -> Stop_err (unexpected_pkt ~expected pkt)) + | Flush_pkt | Response_end_pkt | Invalid_len_pkt _ -> + Stop_err (unexpected_pkt ~expected pkt)) + in + let else_ decoder = return (`Shallows [], `Unshallows []) decoder in + prompt_pkt (if_str_else "shallow-info" ~then_ ~else_) decoder + in + + prompt_pkt decode_shallow_info decoder >>= fun shallow_info -> + prompt_pkt decode_wanted_refs decoder >>= fun wanted_refs -> + prompt_pkt decode_packfile_uris decoder >>= fun packfile_uris -> + prompt_pkt decode_pack decoder >>= fun () -> + return + (Detailed_with_packfile + { acks; shallow_info; wanted_refs; packfile_uris }) + decoder + in + + (* acknowledgements *) + let decode_acknowledgements decoder = + let decode_acks_flush_or_delim ~is_ready nak_or_acks decoder = + match read_pkt decoder with + | Flush_pkt -> + return (Acks_only { ack_res = nak_or_acks; is_ready }) decoder + | Delim_pkt -> + prompt_pkt + (decode_detailed_with_packfile + { ack_res = nak_or_acks; is_ready }) + decoder + | _ -> failwith "expected flush-pkt or delim-pkt" + in + + let decode_ready ~is_ready nak_or_acks decoder = + if is_ready then + prompt_pkt (decode_acks_flush_or_delim ~is_ready nak_or_acks) decoder + else + match peek_pkt' decoder with + | Flush_pkt | Delim_pkt -> + decode_acks_flush_or_delim ~is_ready:false nak_or_acks decoder + | Response_end_pkt | Invalid_len_pkt _ -> + failwith "was trying to parse ready" + | Pkt (l, "ready") -> + junk_chars l decoder; + prompt_pkt + (decode_acks_flush_or_delim ~is_ready:true nak_or_acks) + decoder + | Pkt _ -> failwith "unexpected string %s" + in + + let rec decode_acks acks decoder = + match peek_pkt' decoder with + | Flush_pkt | Delim_pkt -> + decode_acks_flush_or_delim ~is_ready:false (Some (Acks acks)) + decoder + | Pkt (l, "ready") -> + junk_chars l decoder; + let acks = match acks with [] -> None | _ -> Some (Acks acks) in + prompt_pkt (decode_ready ~is_ready:true acks) decoder + | Pkt (l, pkt) -> ( + match String.cut ~sep:" " pkt with + | None -> failwith "was decoding acks but got %s" + | Some ("ACK", obj_id) -> + junk_chars l decoder; + prompt_pkt (decode_acks (obj_id :: acks)) decoder + | Some _ -> failwith "unexpected string") + | Response_end_pkt | Invalid_len_pkt _ -> failwith "was decoding acks" + in + + prompt_pkt (skip_string "acknowledgements") decoder >>= fun () -> + let k decoder = + match peek_pkt' decoder with + | Flush_pkt | Delim_pkt -> + (* don't need [prompt_pkt] because we peeked and saw pkt available *) + decode_acks_flush_or_delim ~is_ready:false None decoder + | Pkt (l, "NAK") -> + junk_chars l decoder; + prompt_pkt (decode_ready ~is_ready:false (Some Nak)) decoder + | Pkt (l, "ready") -> + junk_chars l decoder; + prompt_pkt (decode_acks_flush_or_delim ~is_ready:true None) decoder + | Pkt (_, pkt) when String.is_prefix ~affix:"ACK " pkt -> + decode_acks [] decoder + | (Response_end_pkt | Invalid_len_pkt _ | Pkt _) as pkt -> + unexpected_pkt + ~expected:(`Or (`Str "(ready)", `Str "(nak | *ack)")) + pkt + |> error decoder + in + prompt_pkt k decoder + in + decode_acknowledgements decoder +end + module Command = struct type t = { name : string; args : string list } end module Encoder = struct diff --git a/test/wire-protocol-v2/test.ml b/test/wire-protocol-v2/test.ml new file mode 100644 index 000000000..6a6e0d5d0 --- /dev/null +++ b/test/wire-protocol-v2/test.ml @@ -0,0 +1,132 @@ +open Astring +open Wire_proto_v2 + +module Protocol_test = struct + module Decoder_test = struct + open Protocol + open Extended_pkt_line_decoder + open Protocol.Decoder + + let flush_pkt = "0000" + let delim_pkt = "0001" + let response_end_pkt = "0002" + let decoder_of_string = of_string + + (** "done" -> "0009done\n" *) + let pkt_of_pkt_content s = + let lf_len = 1 in + let pkt_len = 4 in + Fmt.str "%04X%s\n" (pkt_len + String.length s + lf_len) s + + (** ["hi"; "done"] -> "0007hi\n0009done\n" *) + let pkts_encode ?(append = "") s = + let pkts_of_pkt_content_lst s = List.map pkt_of_pkt_content s in + let pkt = pkts_of_pkt_content_lst s |> String.concat in + pkt ^ append + + (** tries to extract value out of [('a, 'b) state] monad *) + let read_whole_buffer_exn = function + | Read { len; continue; _ } -> ( + match continue len with Done v -> v | _ -> failwith "not") + | Done v -> v + | _ -> failwith "can't read" + + let test_decode_fold_until () = + let expected_value = [ 0; 1; 2 ] in + let decoder = + expected_value + |> List.map (fun i -> Fmt.str "shallow %d" i) + |> pkts_encode ~append:delim_pkt + |> decoder_of_string + in + let expected = + or_delim_pkt @@ `Pkt [ `Str "shallow"; `Space; `Str "obj-id" ] + in + let decoded_shallows = + decode_fold_until decoder ~init:[] + ~f:(fun acc pkt -> + match pkt with + | Delim_pkt -> Stop_ok + | Pkt (_, pkt_content) -> ( + match String.cut ~sep:" " pkt_content with + | Some ("shallow", i) -> Continue (int_of_string i :: acc) + | None | Some _ -> Stop_err (unexpected_pkt ~expected pkt)) + | Flush_pkt | Response_end_pkt | Invalid_len_pkt _ -> + Stop_err (unexpected_pkt ~expected pkt)) + ~finalize:List.rev + |> read_whole_buffer_exn + in + Alcotest.(check (list int)) "shallow 0/1/2" decoded_shallows [ 0; 1; 2 ] + + let ref_testable = Alcotest.testable Protocol.Ls_refs.pp_ref ( = ) + + let dec_ls_refs_flush () = + let decoder = decoder_of_string flush_pkt in + let decoded_refs = + decode_ls_refs_response decoder |> read_whole_buffer_exn + in + Alcotest.(check (list ref_testable)) "only flush" decoded_refs [] + + let dec_ls_refs_1 () = + let s = pkts_encode [ "40charobjid HEAD peeled:yes" ] ^ "0000" in + let decoder = decoder_of_string s in + let decoded_refs = + decode_ls_refs_response decoder |> read_whole_buffer_exn + in + Alcotest.(check (list ref_testable)) + "single ref" decoded_refs + [ + Protocol.Ls_refs. + { + obj_id = "40charobjid"; + name = "HEAD"; + attributes = [ Peeled "yes" ]; + }; + ] + + let dec_ls_refs_2 () = + let s = + pkts_encode + [ + "40charobjid HEAD peeled:yes"; + "otherobj-id other-branch symref-target:yes peeled:yes"; + ] + ^ "0000" + in + let decoder = decoder_of_string s in + let decoded_refs = + decode_ls_refs_response decoder |> read_whole_buffer_exn + in + Alcotest.(check (list ref_testable)) + "two refs" decoded_refs + [ + Protocol.Ls_refs. + { + obj_id = "40charobjid"; + name = "HEAD"; + attributes = [ Peeled "yes" ]; + }; + Ls_refs. + { + obj_id = "otherobj-id"; + name = "other-branch"; + attributes = [ Symref_target "yes"; Peeled "yes" ]; + }; + ] + end +end + +let () = + let open Alcotest in + run "git.wire-proto-v2" + [ + Protocol_test.( + Decoder_test.( + ( "Decoder", + [ + test_case "decode_fold_until" `Quick test_decode_fold_until; + test_case "dec_ls_refs_flush" `Slow dec_ls_refs_flush; + test_case "dec_ls_refs_1" `Quick dec_ls_refs_1; + test_case "dec_ls_refs_2" `Slow dec_ls_refs_2; + ] ))); + ]