Small refactor decoder

src/git/sync.mli

@@ -17,6 +17,8 @@
 
 (** The synchronization commands to a git repository. *)
 
+(** [Sync] interface used by backend-specific Git implementations
+    such as [Mem] and [Git_unix] *)
 module type S = sig
   type hash
   type store
@@ -49,6 +51,8 @@ module type S = sig
     (unit, error) result Lwt.t
 end
 
+(** Creates a lower-level [Sync] functions [fetch] and [push] that are then
+        overridden by backend-specific implementations such as [Mem] and [Git_unix] *)
 module Make
     (Digestif : Digestif.S)
     (Pack : Smart_git.APPEND with type +'a fiber = 'a Lwt.t)
@@ -90,10 +94,10 @@ module Make
     Index.t ->
     ((hash * (Reference.t * hash) list) option, [> error ]) result Lwt.t
   (** fetches remote references and saves them.
-      Behavior of fetch when [want] is 
-      [`All] - fetches all remote references and saves them in store 
-      [`Some src_dst_pairs] - fetch [src] and save in [dst] 
-      [`None] - doesn't save anything *)
+          Behavior of fetch when [want] is
+          [`All] - fetches all remote references and saves them in store
+          [`Some src_dst_pairs] - fetch [src] and save in [dst]
+          [`None] - doesn't save anything *)
 
   val push :
     resolvers:Conduit.resolvers ->

src/not-so-smart/decoder.ml

@@ -32,7 +32,11 @@ let pp_error ppf = function
   | `Assert_predicate _ -> Fmt.string ppf "Assert predicate"
   | `Invalid_pkt_line -> Fmt.string ppf "Invalid PKT-line"
 
-type 'err info = { error : 'err; buffer : Bytes.t; committed : int }
+type 'err info = {
+  error : 'err;
+  buffer : Bytes.t;
+  committed : int;  (** # bytes already processed *)
+}
 
 type ('v, 'err) state =
   | Done of 'v
@@ -114,7 +118,7 @@ let at_least_one_line decoder =
   let chr = ref '\000' in
   let has_cr = ref false in
   while
-    !pos < decoder.max
+    !pos < end_of_input decoder
     &&
     ( chr := Bytes.unsafe_get decoder.buffer !pos;
       not (!chr = '\n' && !has_cr) )
@@ -124,34 +128,31 @@ let at_least_one_line decoder =
   done;
   !pos < decoder.max && !chr = '\n' && !has_cr
 
-let digit = function
-  | 'a' .. 'f' as chr -> 10 + Char.code chr - Char.code 'a'
-  | 'A' .. 'F' as chr -> 10 + Char.code chr - Char.code 'A'
-  | '0' .. '9' as chr -> Char.code chr - Char.code '0'
-  | _ -> invalid_arg "invalid digit"
-
-let to_int ~base ~off ~len buf =
-  let code = ref 0 in
-  for i = 0 to len - 1 do
-    let v = digit (Bytes.get buf (off + i)) in
-    assert (v < base);
-    code := (base * !code) + v
-  done;
-  !code
+(** reads off 4 bytes from [decoder.buffer] starting at [decoder.pos] and interprets read
+    bytes as hex and converts to int.
+    Why unsafe:
+    @raise Invalid_argument if there are no 4 bytes to read, i.e.,
+                            [decoder.max - decoder.pos < 4]  *)
+let pkt_len_unsafe (decoder : decoder) =
+  let hex = Bytes.of_string "0x0000" in
+  Bytes.blit decoder.buffer decoder.pos hex 2 4;
+  int_of_string (Bytes.unsafe_to_string hex)
+
+(* no header *)
 
 let at_least_one_pkt decoder =
   let len = decoder.max - decoder.pos in
   if len >= 4 then
-    let pkt_len = to_int ~base:16 ~off:decoder.pos ~len:4 decoder.buffer in
-    len - pkt_len >= 0
+    let pkt_len = pkt_len_unsafe decoder in
+    len >= pkt_len
   else false
 
 (* no header *)
 
 let get_pkt_len decoder =
   let len = decoder.max - decoder.pos in
   if len >= 4 then
-    let pkt_len = to_int ~base:16 ~off:decoder.pos ~len:4 decoder.buffer in
+    let pkt_len = pkt_len_unsafe decoder in
     Some pkt_len
   else None
 
@@ -187,8 +188,6 @@ let get_pkt_len decoder =
    the protocol error to another layer (eg. [carton] when it received finally a
    __not-full__ PACK file). The goal is to be more resilient at this layer. *)
 
-let error_end_of_input decoder () = fail decoder `End_of_input
-
 let reliable_pkt k decoder () =
   match get_pkt_len decoder with
   | Some _len ->
@@ -207,63 +206,56 @@ let prompt :
     decoder ->
     ('v, 'err) state =
  fun ?(strict = true) k decoder ->
-  if decoder.pos > 0 then (
-    (* XXX(dinosaure): compress *)
+  let compress decoder =
     let rest = decoder.max - decoder.pos in
     Bytes.unsafe_blit decoder.buffer decoder.pos decoder.buffer 0 rest;
     decoder.max <- rest;
-    decoder.pos <- 0 );
+    decoder.pos <- 0
+  in
+  if decoder.pos > 0 then compress decoder;
   let rec go off =
     try
+      let at_least_one_pkt = at_least_one_pkt { decoder with max = off } in
       if
         off = Bytes.length decoder.buffer
         && decoder.pos > 0
-        && not (at_least_one_pkt { decoder with max = off })
-      then
-        Error
-          {
-            error = `No_enough_space;
-            buffer = decoder.buffer;
-            committed = decoder.pos;
-          }
+        && not at_least_one_pkt
+      then fail decoder `No_enough_space
       else if
-        not (at_least_one_pkt { decoder with max = off })
+        not at_least_one_pkt
         (* XXX(dinosaure): we make a new decoder here and we did __not__ set
            [decoder.max] owned by end-user, and this is exactly what we want. *)
       then
+        let eof =
+          if strict then fun () -> fail decoder `End_of_input
+          else (
+            decoder.max <- off;
+            reliable_pkt k decoder )
+        in
         Read
           {
             buffer = decoder.buffer;
             off;
             len = Bytes.length decoder.buffer - off;
             continue = (fun len -> go (off + len));
-            eof =
-              ( if strict then error_end_of_input decoder (* fail *)
-              else (
-                decoder.max <- off;
-                reliable_pkt k decoder ) );
+            eof;
           }
       else (
         decoder.max <- off;
         safe k decoder )
     with
     | _exn (* XXX(dinosaure): [at_least_one_pkt] can raise an exception. *) ->
-      Error
-        {
-          error = `Invalid_pkt_line;
-          buffer = decoder.buffer;
-          committed = decoder.pos;
-        }
+      fail decoder `Invalid_pkt_line
   in
   go decoder.max
 
 let peek_pkt decoder =
-  let len = to_int ~base:16 ~off:decoder.pos ~len:4 decoder.buffer in
+  let len = pkt_len_unsafe decoder in
   if len >= 4 then decoder.buffer, decoder.pos + 4, len - 4
   else decoder.buffer, decoder.pos + 4, 0
 
 let junk_pkt decoder =
-  let len = to_int ~base:16 ~off:decoder.pos ~len:4 decoder.buffer in
+  let len = pkt_len_unsafe decoder in
   if len < 4 then decoder.pos <- decoder.pos + 4
   else decoder.pos <- decoder.pos + len
 

src/not-so-smart/decoder.mli

@@ -1,3 +1,8 @@
+(** Module for decoding Git pkt lines, as specified at
+    https://github.com/git/git/blob/master/Documentation/technical/protocol-common.txt
+
+    In the docs, we define [min_pkt_len = 4] as in specs. *)
+
 type decoder = { buffer : bytes; mutable pos : int; mutable max : int }
 
 val io_buffer_size : int
@@ -21,6 +26,8 @@ val pp_error : error Fmt.t
 
 type 'err info = { error : 'err; buffer : bytes; committed : int }
 
+exception Leave of error info
+
 type ('v, 'err) state =
   | Done of 'v
   | Read of {
@@ -32,18 +39,30 @@ type ('v, 'err) state =
     }
   | Error of 'err info
 
+val leave_with : decoder -> error -> 'never
+(** [leave_with d error] raises [Leave { error; buffer = d.buffer; committed = d.pos }]
+
+  @raise Leave *)
+
 val safe :
   (decoder -> ('v, ([> error ] as 'err)) state) -> decoder -> ('v, 'err) state
+(** [safe k decoder] wraps a call [k decoder] in a try-with block;
+    if exception [Leave err] is raised, the function returns [Error of err] *)
 
-val leave_with : decoder -> error -> 'a
 val fail : decoder -> ([> error ] as 'err) -> ('v, 'err) state
 val return : 'v -> decoder -> ('v, 'err) state
 val peek_char : decoder -> char option
 val string : string -> decoder -> unit
 val junk_char : decoder -> unit
+
 val while1 : (char -> bool) -> decoder -> bytes * int * int
-val at_least_one_line : decoder -> bool
+(** @return [decoder.buffer], updated [decoder.pos], # of bytes read *)
+
 val at_least_one_pkt : decoder -> bool
+(** returns true if [decoder.max - decoder.pos] is [>= min_pkt_len] and [>= pkt_len],
+    where [pkt_len] is the length of a pkt line starting at [decoder.pos]. *)
+
+val at_least_one_line : decoder -> bool
 
 val prompt :
   ?strict:bool ->
@@ -54,4 +73,10 @@ val prompt :
 val peek_while_eol : decoder -> bytes * int * int
 val peek_while_eol_or_space : decoder -> bytes * int * int
 val peek_pkt : decoder -> bytes * int * int
+
 val junk_pkt : decoder -> unit
+(** increase [decoder.pos] by [max min_pkt_len pkt_len], where [pkt_len] is the length
+    of the pkt line starting at the current value of [decoder.pos] (before increasing) and
+    [min_pkt_len = 4].
+
+    @raise Invalid_argument if there aren't 4 bytes representing the length *)

src/not-so-smart/dune

@@ -1,8 +1,15 @@
+(library
+ (name pkt_line)
+ (public_name git-nss.pkt-line)
+ (modules decoder encoder)
+ (libraries astring fmt))
+
 (library
  (name smart)
  (public_name git-nss.smart)
- (modules smart filter capability state protocol encoder decoder)
- (libraries conduit stdlib-shims result rresult domain-name astring fmt))
+ (modules smart filter capability state protocol)
+ (libraries git-nss.pkt-line conduit stdlib-shims result rresult domain-name
+   astring fmt))
 
 (library
  (name sigs)

src/not-so-smart/fetch.ml

@@ -37,21 +37,23 @@ struct
   let return x = IO.return x
 
   let sched =
-    {
-      Sigs.bind = (fun x f -> inj (prj x >>= fun x -> prj (f x)));
-      Sigs.return = (fun x -> inj (return x));
-    }
+    Sigs.
+      {
+        bind = (fun x f -> inj (prj x >>= fun x -> prj (f x)));
+        return = (fun x -> inj (return x));
+      }
 
   let fail exn =
     let fail = IO.fail exn in
     inj fail
 
   let io =
-    {
-      Sigs.recv = (fun flow raw -> inj (Flow.recv flow raw));
-      Sigs.send = (fun flow raw -> inj (Flow.send flow raw));
-      Sigs.pp_error = Flow.pp_error;
-    }
+    Sigs.
+      {
+        recv = (fun flow raw -> inj (Flow.recv flow raw));
+        send = (fun flow raw -> inj (Flow.send flow raw));
+        pp_error = Flow.pp_error;
+      }
 
   let references want have =
     match want with

src/not-so-smart/protocol.ml

@@ -267,10 +267,10 @@ end
 
 module Decoder = struct
   open Astring
-  open Decoder
+  open Pkt_line.Decoder
 
-  type error =
-    [ Decoder.error
+  type nonrec error =
+    [ error
     | `Invalid_advertised_ref of string
     | `Invalid_shallow of string
     | `Invalid_negotiation_result of string
@@ -282,7 +282,7 @@ module Decoder = struct
     | `Invalid_pkt_line ]
 
   let pp_error ppf = function
-    | #Decoder.error as err -> Decoder.pp_error ppf err
+    | #Pkt_line.Decoder.error as err -> Pkt_line.Decoder.pp_error ppf err
     | `Invalid_advertised_ref raw ->
         Fmt.pf ppf "Invalid advertised refererence (%S)" raw
     | `Invalid_shallow raw -> Fmt.pf ppf "Invalid shallow (%S)" raw
@@ -630,12 +630,12 @@ module Decoder = struct
 
   let rec bind x ~f =
     match x with
-    | Decoder.Done v -> f v
-    | Decoder.Read { buffer; off; len; continue; eof } ->
+    | Done v -> f v
+    | Read { buffer; off; len; continue; eof } ->
         let continue len = bind (continue len) ~f in
         let eof () = bind (eof ()) ~f in
-        Decoder.Read { buffer; off; len; continue; eof }
-    | Decoder.Error _ as err -> err
+        Read { buffer; off; len; continue; eof }
+    | Error _ as err -> err
 
   let ( >>= ) x f = bind x ~f
 
@@ -696,7 +696,7 @@ module Decoder = struct
       match String.Sub.head pkt with
       | Some '\001' ->
           let str = String.Sub.(to_string (tail pkt)) in
-          let decoder' = Decoder.decoder_from str in
+          let decoder' = decoder_from str in
           decode_status decoder' >>= fun res ->
           junk_pkt decoder;
           prompt_pkt (return res) decoder
@@ -707,11 +707,11 @@ module Decoder = struct
 end
 
 module Encoder = struct
-  open Encoder
+  open Pkt_line.Encoder
 
-  type error = Encoder.error
+  type nonrec error = error
 
-  let pp_error = Encoder.pp_error
+  let pp_error = pp_error
   let write_space encoder = write encoder " "
   let write_zero encoder = write encoder "\000"
   let write_new_line encoder = write encoder "\n"
@@ -858,7 +858,7 @@ module Encoder = struct
   let unsafe_encode_packet encoder ~packet =
     let pos = encoder.pos in
     encoder.pos <- encoder.pos + 4;
-    Encoder.write encoder packet;
+    write encoder packet;
     let len = encoder.pos - pos in
     Bytes.blit_string (Fmt.str "%04X" len) 0 encoder.payload pos 4