Skip to content

Commit

Permalink
* add decoding for all commands
Browse files Browse the repository at this point in the history 
* add some tests
  • Loading branch information
@ulugbekna
ulugbekna committed Jan 4, 2021
1 parent bf3f215 commit be7a4d3
Show file tree
Hide file tree
Showing 2 changed files with 506 additions and 0 deletions.
374 changes: 374 additions & 0 deletions src/wire-proto-v2/protocol.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading

0 comments on commit be7a4d3

Please sign in to comment.