From d2830dccf26f80cda909d6f596d4387cc16dd911 Mon Sep 17 00:00:00 2001 From: Ulugbek Abdullaev Date: Mon, 8 Feb 2021 16:38:27 +0500 Subject: [PATCH] merge proto v1 and v2 capabilities into one 'capability.ml/i' --- src/git/dune | 6 +- src/git/sync.ml | 4 +- src/git/sync.mli | 8 +- src/not-so-smart/capability.ml | 168 +++++------------------- src/not-so-smart/capability.mli | 184 ++------------------------ src/not-so-smart/capability_v1.ml | 150 +++++++++++++++++++++ src/not-so-smart/capability_v1.mli | 201 +++++++++++++++++++++++++++++ src/not-so-smart/capability_v2.ml | 8 +- src/not-so-smart/capability_v2.mli | 2 +- src/not-so-smart/dune | 12 +- src/not-so-smart/fetch.mli | 2 +- src/not-so-smart/proto_vals_v2.ml | 3 +- src/not-so-smart/smart_git.ml | 2 + src/not-so-smart/smart_git_intf.ml | 4 +- src/not-so-smart/wire_proto_v2.ml | 1 - 15 files changed, 421 insertions(+), 334 deletions(-) create mode 100644 src/not-so-smart/capability_v1.ml create mode 100644 src/not-so-smart/capability_v1.mli diff --git a/src/git/dune b/src/git/dune index 1cc46266a..a8c41bf9d 100644 --- a/src/git/dune +++ b/src/git/dune @@ -1,8 +1,8 @@ (library (name git) (public_name git) - (libraries bigarray-compat capability mimic rresult git.nss.sigs git.nss.pck - optint loose decompress.de decompress.zl result git.nss.smart logs lwt - cstruct angstrom bigstringaf carton ke fmt checkseum git.nss.git + (libraries bigarray-compat git.nss.capability mimic rresult git.nss.sigs + git.nss.pck optint loose decompress.de decompress.zl result git.nss.smart + logs lwt cstruct angstrom bigstringaf carton ke fmt checkseum git.nss.git git.nss.hkt ocamlgraph astring fpath loose_git carton-lwt carton-git digestif encore)) diff --git a/src/git/sync.ml b/src/git/sync.ml index ad39b3f65..685d7322a 100644 --- a/src/git/sync.ml +++ b/src/git/sync.ml @@ -33,7 +33,7 @@ module type S = sig ctx:Mimic.ctx -> Smart_git.Endpoint.t -> store -> - ?version:[> `V1 ] -> + ?version:[> `V1 | `V2 ] -> ?capabilities:Smart.Capability.t list -> ?deepen:[ `Depth of int | `Timestamp of int64 ] -> [ `All | `Some of (Reference.t * Reference.t) list | `None ] -> @@ -43,7 +43,7 @@ module type S = sig ctx:Mimic.ctx -> Smart_git.Endpoint.t -> store -> - ?version:[> `V1 ] -> + ?version:[> `V1 | `V2 ] -> ?capabilities:Smart.Capability.t list -> [ `Create of Reference.t | `Delete of Reference.t diff --git a/src/git/sync.mli b/src/git/sync.mli index 4af896d6c..cb934bdb4 100644 --- a/src/git/sync.mli +++ b/src/git/sync.mli @@ -32,7 +32,7 @@ module type S = sig ctx:Mimic.ctx -> Smart_git.Endpoint.t -> store -> - ?version:[> `V1 ] -> + ?version:[> `V1 | `V2 ] -> ?capabilities:Smart.Capability.t list -> ?deepen:[ `Depth of int | `Timestamp of int64 ] -> [ `All | `Some of (Reference.t * Reference.t) list | `None ] -> @@ -42,7 +42,7 @@ module type S = sig ctx:Mimic.ctx -> Smart_git.Endpoint.t -> store -> - ?version:[> `V1 ] -> + ?version:[> `V1 | `V2 ] -> ?capabilities:Smart.Capability.t list -> [ `Create of Reference.t | `Delete of Reference.t @@ -71,7 +71,7 @@ module Make ctx:Mimic.ctx -> Smart_git.Endpoint.t -> store -> - ?version:[> `V1 ] -> + ?version:[> `V1 | `V2 ] -> ?capabilities:Smart.Capability.t list -> ?deepen:[ `Depth of int | `Timestamp of int64 ] -> [ `All @@ -98,7 +98,7 @@ module Make ctx:Mimic.ctx -> Smart_git.Endpoint.t -> store -> - ?version:[> `V1 ] -> + ?version:[> `V1 | `V2 ] -> ?capabilities:Smart.Capability.t list -> [ `Create of Reference.t | `Delete of Reference.t diff --git a/src/not-so-smart/capability.ml b/src/not-so-smart/capability.ml index cf770f03c..bd56d18ac 100644 --- a/src/not-so-smart/capability.ml +++ b/src/not-so-smart/capability.ml @@ -1,150 +1,42 @@ -type t = - [ `Multi_ack - | `Multi_ack_detailed - | `No_done - | `Thin_pack - | `Side_band - | `Side_band_64k - | `Ofs_delta - | `Agent of string - | `Shallow - | `Deepen_since - | `Deepen_not - | `No_progress - | `Include_tag - | `Report_status - | `Delete_refs - | `Quiet - | `Atomic - | `Push_options - | `Allow_tip_sha1_in_want - | `Allow_reachable_sha1_in_want - | `Push_cert of string - | `Symref of string * string - | `Other of string - | `Parameter of string * string ] +type t = [ Capability_v1.t | Capability_v2.t ] + +let filter_by ~protocol_v lst = + let filter = + match protocol_v with + | `V1 -> ( function #Capability_v1.t as c -> Some c | _ -> None) + | `V2 -> ( function #Capability_v2.t as c -> Some c | _ -> None) + | _ -> invalid_arg "unsupported protocol version" + in + List.filter_map filter lst let to_string = function - | `Multi_ack -> "multi_ack" - | `Multi_ack_detailed -> "multi_ack_detailed" - | `No_done -> "no-done" - | `Thin_pack -> "thin-pack" - | `Side_band -> "side-band" - | `Side_band_64k -> "side-band-64k" - | `Ofs_delta -> "ofs-delta" - | `Agent agent -> Fmt.str "agent=%s" agent - | `Shallow -> "shallow" - | `Deepen_since -> "deepen-since" - | `Deepen_not -> "deepen-not" - | `No_progress -> "no-progress" - | `Include_tag -> "include-tag" - | `Report_status -> "report-status" - | `Delete_refs -> "delete-refs" - | `Quiet -> "quiet" - | `Atomic -> "atomic" - | `Push_options -> "push-options" - | `Allow_tip_sha1_in_want -> "allow-tip-sha1-in-want" - | `Allow_reachable_sha1_in_want -> "allow-reachable-sha1-in-want" - | `Push_cert cert -> Fmt.str "push-cert=%s" cert - | `Symref (ref0, ref1) -> Fmt.str "symref=%s:%s" ref0 ref1 - | `Other capability -> capability - | `Parameter (key, value) -> Fmt.str "%s=%s" key value + | #Capability_v1.t as c -> Capability_v1.to_string c + | #Capability_v2.t as c -> Capability_v2.to_string c exception Capability_expect_value of string -let of_string ?value = function - | "multi_ack" -> `Multi_ack - | "multi_ack_detailed" -> `Multi_ack_detailed - | "no-done" -> `No_done - | "thin-pack" -> `Thin_pack - | "side-band" -> `Side_band - | "side-band-64k" -> `Side_band_64k - | "ofs-delta" -> `Ofs_delta - | "shallow" -> `Shallow - | "deepen-since" -> `Deepen_since - | "deepen-not" -> `Deepen_not - | "no-progress" -> `No_progress - | "include-tag" -> `Include_tag - | "report-status" -> `Report_status - | "delete-refs" -> `Delete_refs - | "quiet" -> `Quiet - | "atomic" -> `Atomic - | "push-options" -> `Push_options - | "allow-tip-sha1-in-want" -> `Allow_tip_sha1_in_want - | "allow-reachable-sha1-in-want" -> `Allow_reachable_sha1_in_want - | "push-cert" -> ( - match value with - | Some value -> `Push_cert value - | None -> raise (Capability_expect_value "push-cert")) - | "agent" -> ( - match value with - | Some value -> `Agent value - | None -> raise (Capability_expect_value "agent")) - | "symref" -> ( - match Option.bind value (Astring.String.cut ~sep:":") with - | Some (ref0, ref1) -> `Symref (ref0, ref1) - | None -> raise (Capability_expect_value "symref")) - | capability -> ( - match value with - | Some value -> `Parameter (capability, value) - | None -> `Other capability) +let of_string ?(protocol_v = `V1) ?value s = + match protocol_v with + | `V1 -> (Capability_v1.of_string ?value s :> t) + | `V2 -> (Capability_v2.of_string s :> t) + | _ -> invalid_arg "unsupported protocol version" let pp ppf = function - | `Multi_ack -> Fmt.pf ppf "Multi-ACK" - | `Multi_ack_detailed -> Fmt.pf ppf "Multi-ACK-detailed" - | `No_done -> Fmt.pf ppf "No-done" - | `Thin_pack -> Fmt.pf ppf "Thin-PACK" - | `Side_band -> Fmt.pf ppf "Side-Band" - | `Side_band_64k -> Fmt.pf ppf "Side-Band-64K" - | `Ofs_delta -> Fmt.pf ppf "Offset-delta" - | `Agent agent -> Fmt.pf ppf "(Agent %s)" agent - | `Shallow -> Fmt.pf ppf "Shallow" - | `Deepen_since -> Fmt.pf ppf "Deepen-Since" - | `Deepen_not -> Fmt.pf ppf "Deepen-Not" - | `No_progress -> Fmt.pf ppf "No-Progress" - | `Include_tag -> Fmt.pf ppf "Include-Tag" - | `Report_status -> Fmt.pf ppf "Report-Status" - | `Delete_refs -> Fmt.pf ppf "Delete-Refs" - | `Quiet -> Fmt.pf ppf "Quiet" - | `Atomic -> Fmt.pf ppf "Atomic" - | `Push_options -> Fmt.pf ppf "Push-Options" - | `Allow_tip_sha1_in_want -> Fmt.pf ppf "Allow-Tip-SHA1-in-Want" - | `Allow_reachable_sha1_in_want -> Fmt.pf ppf "Allow-Reachable-SHA1-in-Want" - | `Push_cert cert -> Fmt.pf ppf "(Push Cert %s)" cert - | `Symref (ref0, ref1) -> Fmt.pf ppf "(Symref (%s, %s))" ref0 ref1 - | `Other capability -> Fmt.pf ppf "(other %s)" capability - | `Parameter (key, value) -> Fmt.pf ppf "(%s %s)" key value + | #Capability_v1.t as c -> Capability_v1.pp ppf c + | #Capability_v2.t as c -> Capability_v2.pp ppf c let compare a b = match a, b with - | `Multi_ack, `Multi_ack - | `Multi_ack_detailed, `Multi_ack_detailed - | `No_done, `No_done - | `Thin_pack, `Thin_pack - | `Side_band, `Side_band - | `Side_band_64k, `Side_band_64k - | `Ofs_delta, `Ofs_delta - | `Shallow, `Shallow - | `Deepen_since, `Deepen_since - | `Deepen_not, `Deepen_not - | `No_progress, `No_progress - | `Include_tag, `Include_tag - | `Report_status, `Report_status - | `Delete_refs, `Delete_refs - | `Quiet, `Quiet - | `Atomic, `Atomic - | `Push_options, `Push_options - | `Allow_tip_sha1_in_want, `Allow_tip_sha1_in_want - | `Allow_reachable_sha1_in_want, `Allow_reachable_sha1_in_want -> - 0 - | `Push_cert a, `Push_cert b | `Agent a, `Agent b | `Other a, `Other b -> - String.compare a b - | `Symref (refa0, refa1), `Symref (refb0, refb1) -> - let res = String.compare refa0 refb0 in - if res = 0 then String.compare refa1 refb1 else res - | `Parameter (ka, va), `Parameter (kb, vb) -> - let res = String.compare ka kb in - if res = 0 then String.compare va vb else res - | a, b -> if a > b then 1 else -1 + | (#Capability_v1.t as a), (#Capability_v1.t as b) -> + Capability_v1.compare a b + | (#Capability_v2.t as a), (#Capability_v2.t as b) -> + if Capability_v2.equal a b then 0 + else + invalid_arg + "Capability.compare: comparison for capabilities for git wire \ + protocol v2 is undefined" + | _ -> + invalid_arg + "Capability.compare: comparison between such capabilities is undefined" let equal a b = compare a b = 0 diff --git a/src/not-so-smart/capability.mli b/src/not-so-smart/capability.mli index d9144cc7f..d8df4e454 100644 --- a/src/not-so-smart/capability.mli +++ b/src/not-so-smart/capability.mli @@ -9,177 +9,7 @@ not allow [`Shallow] objects, we permit to define shallow objects on the API of the fetch command but we don't use them to notice to the server. *) -type t = - [ `Multi_ack - (** The [`Multi-ack] capability allows the server to return - ["ACK obj-id continue"] as soon as it finds a commit that it can use as - a common base, between the client's wants and the client's have set. - - By sending this early, the server can potentially head off the client - from walking any further down that particular branch of the client's - repository history. The client may still need to walk down other - branches, sending have lines for those, until the server has a complete - cut across the DAG, or the client has said ["done"]. *) - | `Multi_ack_detailed - (** This is an extension of [`Multi_ack] that permits client to better - understand ther server's in-memory state. *) - | `No_done - (** This capability should only be used with the smart HTTP protocol. If - [`Multi_ack_detailed] and [`No_done] are both present, then the sender - is free to immediately send a pack following its first - ["ACK obj-id ready"] message. - - Without [`No_done] in the smart HTTP protocol, the server session would - end and the client has to make another trip to send ["done"] before the - server can send the pack. [`No_done] removes the last round and thus - slightly reduces latency. *) - | `Thin_pack - (** A thin pack is one with deltas which reference base objects not - contained within the pack (but are known to exist at the receiving end). - This can reduce the network traffic significantly, but it requires the - receiving end to know how to "thicken" these packs by adding the missing - bases to the pack. - - The [`UploadPack] server advertises [`Thin_pack] when it can generate - and send a thin pack. A client requests the [`Thin_pack] capability when - it understands how to ["thicken"] it, notifying the server that it can - receive such a pack. A client MUST NOT request the [`Thin_pack] - capability if it cannot turn a thin pack into a self-contained pack. - - [`ReceivePack], on the other hand, is assumed by default to be able to - handle thin packs, but can ask the client not to use the feature by - advertising the [`No_thin] capability. A client MUST NOT send a thin - pack if the server advertises the [`No_thin] capability. *) - | `Side_band (** See {!`Side_band_64k}. *) - | `Side_band_64k - (** This capability means that server can send, and client understand - multiplexed progress reports and error into interleaved with the - packfile itself. - - These two options are mutually exclusive. A modern client always favors - [`Side_band_64k]. - - Either mode indicates that the packfile data will be streamed broken up - into packets of up to either 1000 bytes in the case of [`Side_band], or - 65520 bytes in the case of [`Side_band_64k]. Each packet is made up of a - leading 4-byte {i pkt-line} length of how much data is in the packet, - followed by a 1-byte stream code, followed by the actual data. - - Further, with [`Side_band] and its up to 1000-byte messages, it's - actually 999 bytes of payload and 1 byte for the stream code. With - [`Side_band_64k], same deal, you have up to 65519 bytes of data and 1 - byte for the stream code. - - The client MUST send only maximum of one of [`Side_band] and - [`Side_band_64k]. Server MUST diagnose it as an error if client requests - both. *) - | `Ofs_delta - (** Server can send, and client understand PACKv2 with delta referring to - its base by position in path rather than by an obj-id. That is, they can - send/read OBJ_OFS_DETLA (aka type 6) in a packfile. *) - | `Agent of string - (** The server may optionnaly send a capability of the form ["agent=X"] to - notify the client that the server is running version ["X"]. The client - may optionnaly return its own agent string by responding with an - ["agent=Y"] capability (but it MUST NOT do so if the server did not - mention the agent capability). the ["X"] and ["Y"] strings may contain - any printable ASCII characters except space (i.e. the byte range - [32 < x < 127]), and are typically of the form ["package/version"] - (e.g., ["git/1.8.3.1"]). The agent strings are purely informative for - statistics and debugging purposes, and MUST NOT be used to - programmatically assume the presence or absence of particular features. *) - | `Shallow - (** This capability adds ["deepen"], ["shallow"] and ["unshallow"] commands - to the fetch-pack/upload-pack protocol so clients can request shallow - clones. *) - | `Deepen_since - (** This capability adds ["deepen-since"] command to fetch-pack/upload-pack - protocol so the client can request shallow clones that are cut at a - specific time, instead of depth. Internally it's equivalent of doing - ["git rev-list --max-age="] on the server side. - [`Deepen_since] cannot be used with [`Deepen]. *) - | `Deepen_not - (** This capability adds [`Deepen_not] command to fetch-pacj/upload-pack - protocol so the client can request shallow clones that are cut at a - specific revision, instead of depth. Internanlly it's equivalent of - doing ["git rev-list --not "] on the server side. [`Deepen_not] - cannot be used with [`Deepen], but can be used with [`Deepen_since]. *) - | `No_progress - (** The client was started with ["git clone -q"] or something, and does not - want that side band 2. Basically the client just says - ["I do not wish to receive stream 2 on sideband, so do not send it to - me, and if you did, I will drop it on the floor anyway"]. However, the - sideband channel 3 is still used for error responses. *) - | `Include_tag - (** The [`Include_tag] capability is about sending annotated tags if we are - sending objects they point to. If we pack an object to the client, and a - tag object points exactly at that object, we pack the tag object too. In - general this allows a client to get all new annotated tags when it - fetches a branch, in a single network connection. - - Clients MAY always send [`Include_tags], hardcoding it into a request - when the server advertises this capability. The decision for a client to - request [`Include_tag] only has to do with the client's desires for tag - ["refs/tags/*"] namespace. - - Servers MUST pack the tags if their referrant is packed and the client - has requested [`Include_tag]. - - Clients MUST be prepared for the case where a server has ignored - [`Include_tag] and has not actually sent tags in the pack. In such cases - the client SHOULD issue a subsequent fetch to acquire the tags that - [`Include_tag] would have otherwise given the client. - - The server SHOULD send [`Include_tag], if it supports it, regardless of - whether or not there are tags available. *) - | `Report_status - (** The [`ReceivePack] process can receive a [`Report_status] capability, - which tells it that the client wants a report of what happened after a - packfile upload and reference update. If the pushing client requests - this capability, after unpacking and updating references the server will - respond with whether the packfile unpacked successfully and if each - reference was updated successfully. If any of those were not successful, - it will send back an error message. *) - | `Delete_refs - (** If the server sends back the [`Delete_refs] capability, it means that it - is capable of accepting a zero-id value as the target value of a - reference update. It is not sent back by the client, it simply informs - the client that it can be sent zero-id values to delete references. *) - | `Quiet - (** If the [`ReceivePack] server advertises the [`Quiet] capability, it is - capable of silencing human-readable progress output which otherwise may - be shown when processing the receiving pack. A send-pack client should - respond with the [`Quiet] capability to suppress server-side progress - reporting if the local progress reporting is also being suppressed - (e.g., via ["git push -q"], or if [stderr] does not go to a tty). *) - | `Atomic - (** If the server sends the [`Atomic] capability it is capable of acceping - atomic pushes. If the pushing client requests this capability, the - server will update the refs in one atomic transaction. Either all refs - are updated or none. *) - | `Push_options - (** If the server sends the [`Push_options] capability it is able to accept - push options after the update commands have been sent, but before the - packfile is streamed. If the pushing client requests this capability, - the server will pass the options to the pre- and post- receive hooks - that process this push request. *) - | `Allow_tip_sha1_in_want - (** If the upload-pack server advertises this capability, fetch-pack may - send ["want"] lines with hashes that exists at the server but are not - advertised by upload-pack. *) - | `Allow_reachable_sha1_in_want - (** If the upload-pack server advertises this capability, fetch-pack may - send ["want"] lines with hashes that exists at the server but are not - advertised by upload-pack. *) - | `Push_cert of string - (** The receive-pack server that advertises this capability is willing to - accept a signed push certificate, and asks the to be included in - the push certificate. A send-pack client MUST NOT send a push-cert - packet unless the receive-pack server advertises this capability. *) - | `Symref of string * string - | `Other of string (** Unrecognized capability. *) - | `Parameter of string * string (** Unrecognized capability with a value. *) - ] +type t = [ Capability_v1.t | Capability_v2.t ] val to_string : t -> string (** [to_string c] returns a string representaiton of the capability [c]. *) @@ -187,13 +17,21 @@ val to_string : t -> string exception Capability_expect_value of string (** Exception to inform than the capability expects a value. *) -val of_string : ?value:string -> string -> t +val of_string : ?protocol_v:[> `V1 | `V2 ] -> ?value:string -> string -> t (** [of_capability s] tries to decode [s] to a capability. If the capability - excepts a value, we raise [Capability_expect_value]. *) + excepts a value, we raise [Capability_expect_value]. + + [protocol_v] has default value [`V1]. + + @raise Capability_expect_value if capability (for protocol v1) expects a value + but value argument isn't given. *) val pp : t Fmt.t (** Pretty-printer of {!t}. *) +val filter_by : protocol_v:[> `V1 | `V2 ] -> t list -> t list +(** filters a capability list by protocol version *) + val compare : t -> t -> int (** Comparison function of {!t}. *) diff --git a/src/not-so-smart/capability_v1.ml b/src/not-so-smart/capability_v1.ml new file mode 100644 index 000000000..cf770f03c --- /dev/null +++ b/src/not-so-smart/capability_v1.ml @@ -0,0 +1,150 @@ +type t = + [ `Multi_ack + | `Multi_ack_detailed + | `No_done + | `Thin_pack + | `Side_band + | `Side_band_64k + | `Ofs_delta + | `Agent of string + | `Shallow + | `Deepen_since + | `Deepen_not + | `No_progress + | `Include_tag + | `Report_status + | `Delete_refs + | `Quiet + | `Atomic + | `Push_options + | `Allow_tip_sha1_in_want + | `Allow_reachable_sha1_in_want + | `Push_cert of string + | `Symref of string * string + | `Other of string + | `Parameter of string * string ] + +let to_string = function + | `Multi_ack -> "multi_ack" + | `Multi_ack_detailed -> "multi_ack_detailed" + | `No_done -> "no-done" + | `Thin_pack -> "thin-pack" + | `Side_band -> "side-band" + | `Side_band_64k -> "side-band-64k" + | `Ofs_delta -> "ofs-delta" + | `Agent agent -> Fmt.str "agent=%s" agent + | `Shallow -> "shallow" + | `Deepen_since -> "deepen-since" + | `Deepen_not -> "deepen-not" + | `No_progress -> "no-progress" + | `Include_tag -> "include-tag" + | `Report_status -> "report-status" + | `Delete_refs -> "delete-refs" + | `Quiet -> "quiet" + | `Atomic -> "atomic" + | `Push_options -> "push-options" + | `Allow_tip_sha1_in_want -> "allow-tip-sha1-in-want" + | `Allow_reachable_sha1_in_want -> "allow-reachable-sha1-in-want" + | `Push_cert cert -> Fmt.str "push-cert=%s" cert + | `Symref (ref0, ref1) -> Fmt.str "symref=%s:%s" ref0 ref1 + | `Other capability -> capability + | `Parameter (key, value) -> Fmt.str "%s=%s" key value + +exception Capability_expect_value of string + +let of_string ?value = function + | "multi_ack" -> `Multi_ack + | "multi_ack_detailed" -> `Multi_ack_detailed + | "no-done" -> `No_done + | "thin-pack" -> `Thin_pack + | "side-band" -> `Side_band + | "side-band-64k" -> `Side_band_64k + | "ofs-delta" -> `Ofs_delta + | "shallow" -> `Shallow + | "deepen-since" -> `Deepen_since + | "deepen-not" -> `Deepen_not + | "no-progress" -> `No_progress + | "include-tag" -> `Include_tag + | "report-status" -> `Report_status + | "delete-refs" -> `Delete_refs + | "quiet" -> `Quiet + | "atomic" -> `Atomic + | "push-options" -> `Push_options + | "allow-tip-sha1-in-want" -> `Allow_tip_sha1_in_want + | "allow-reachable-sha1-in-want" -> `Allow_reachable_sha1_in_want + | "push-cert" -> ( + match value with + | Some value -> `Push_cert value + | None -> raise (Capability_expect_value "push-cert")) + | "agent" -> ( + match value with + | Some value -> `Agent value + | None -> raise (Capability_expect_value "agent")) + | "symref" -> ( + match Option.bind value (Astring.String.cut ~sep:":") with + | Some (ref0, ref1) -> `Symref (ref0, ref1) + | None -> raise (Capability_expect_value "symref")) + | capability -> ( + match value with + | Some value -> `Parameter (capability, value) + | None -> `Other capability) + +let pp ppf = function + | `Multi_ack -> Fmt.pf ppf "Multi-ACK" + | `Multi_ack_detailed -> Fmt.pf ppf "Multi-ACK-detailed" + | `No_done -> Fmt.pf ppf "No-done" + | `Thin_pack -> Fmt.pf ppf "Thin-PACK" + | `Side_band -> Fmt.pf ppf "Side-Band" + | `Side_band_64k -> Fmt.pf ppf "Side-Band-64K" + | `Ofs_delta -> Fmt.pf ppf "Offset-delta" + | `Agent agent -> Fmt.pf ppf "(Agent %s)" agent + | `Shallow -> Fmt.pf ppf "Shallow" + | `Deepen_since -> Fmt.pf ppf "Deepen-Since" + | `Deepen_not -> Fmt.pf ppf "Deepen-Not" + | `No_progress -> Fmt.pf ppf "No-Progress" + | `Include_tag -> Fmt.pf ppf "Include-Tag" + | `Report_status -> Fmt.pf ppf "Report-Status" + | `Delete_refs -> Fmt.pf ppf "Delete-Refs" + | `Quiet -> Fmt.pf ppf "Quiet" + | `Atomic -> Fmt.pf ppf "Atomic" + | `Push_options -> Fmt.pf ppf "Push-Options" + | `Allow_tip_sha1_in_want -> Fmt.pf ppf "Allow-Tip-SHA1-in-Want" + | `Allow_reachable_sha1_in_want -> Fmt.pf ppf "Allow-Reachable-SHA1-in-Want" + | `Push_cert cert -> Fmt.pf ppf "(Push Cert %s)" cert + | `Symref (ref0, ref1) -> Fmt.pf ppf "(Symref (%s, %s))" ref0 ref1 + | `Other capability -> Fmt.pf ppf "(other %s)" capability + | `Parameter (key, value) -> Fmt.pf ppf "(%s %s)" key value + +let compare a b = + match a, b with + | `Multi_ack, `Multi_ack + | `Multi_ack_detailed, `Multi_ack_detailed + | `No_done, `No_done + | `Thin_pack, `Thin_pack + | `Side_band, `Side_band + | `Side_band_64k, `Side_band_64k + | `Ofs_delta, `Ofs_delta + | `Shallow, `Shallow + | `Deepen_since, `Deepen_since + | `Deepen_not, `Deepen_not + | `No_progress, `No_progress + | `Include_tag, `Include_tag + | `Report_status, `Report_status + | `Delete_refs, `Delete_refs + | `Quiet, `Quiet + | `Atomic, `Atomic + | `Push_options, `Push_options + | `Allow_tip_sha1_in_want, `Allow_tip_sha1_in_want + | `Allow_reachable_sha1_in_want, `Allow_reachable_sha1_in_want -> + 0 + | `Push_cert a, `Push_cert b | `Agent a, `Agent b | `Other a, `Other b -> + String.compare a b + | `Symref (refa0, refa1), `Symref (refb0, refb1) -> + let res = String.compare refa0 refb0 in + if res = 0 then String.compare refa1 refb1 else res + | `Parameter (ka, va), `Parameter (kb, vb) -> + let res = String.compare ka kb in + if res = 0 then String.compare va vb else res + | a, b -> if a > b then 1 else -1 + +let equal a b = compare a b = 0 diff --git a/src/not-so-smart/capability_v1.mli b/src/not-so-smart/capability_v1.mli new file mode 100644 index 000000000..ef2548265 --- /dev/null +++ b/src/not-so-smart/capability_v1.mli @@ -0,0 +1,201 @@ +(** Capabilities module. + + When the client talks with the server, it needs to inform capabilities (what + it can handle). This is the exhaustive list of capabilities on the current + Smart protocol. Then, the server responds too with capabilities. + + The common part between the client and the server of capabilities should + diverge how we handle the Smart protocol. For example, if the client does + not allow [`Shallow] objects, we permit to define shallow objects on the API + of the fetch command but we don't use them to notice to the server. *) + +type t = + [ `Multi_ack + (** The [`Multi-ack] capability allows the server to return + ["ACK obj-id continue"] as soon as it finds a commit that it can use as + a common base, between the client's wants and the client's have set. + + By sending this early, the server can potentially head off the client + from walking any further down that particular branch of the client's + repository history. The client may still need to walk down other + branches, sending have lines for those, until the server has a complete + cut across the DAG, or the client has said ["done"]. *) + | `Multi_ack_detailed + (** This is an extension of [`Multi_ack] that permits client to better + understand ther server's in-memory state. *) + | `No_done + (** This capability should only be used with the smart HTTP protocol. If + [`Multi_ack_detailed] and [`No_done] are both present, then the sender + is free to immediately send a pack following its first + ["ACK obj-id ready"] message. + + Without [`No_done] in the smart HTTP protocol, the server session would + end and the client has to make another trip to send ["done"] before the + server can send the pack. [`No_done] removes the last round and thus + slightly reduces latency. *) + | `Thin_pack + (** A thin pack is one with deltas which reference base objects not + contained within the pack (but are known to exist at the receiving end). + This can reduce the network traffic significantly, but it requires the + receiving end to know how to "thicken" these packs by adding the missing + bases to the pack. + + The [`UploadPack] server advertises [`Thin_pack] when it can generate + and send a thin pack. A client requests the [`Thin_pack] capability when + it understands how to ["thicken"] it, notifying the server that it can + receive such a pack. A client MUST NOT request the [`Thin_pack] + capability if it cannot turn a thin pack into a self-contained pack. + + [`ReceivePack], on the other hand, is assumed by default to be able to + handle thin packs, but can ask the client not to use the feature by + advertising the [`No_thin] capability. A client MUST NOT send a thin + pack if the server advertises the [`No_thin] capability. *) + | `Side_band (** See {!`Side_band_64k}. *) + | `Side_band_64k + (** This capability means that server can send, and client understand + multiplexed progress reports and error into interleaved with the + packfile itself. + + These two options are mutually exclusive. A modern client always favors + [`Side_band_64k]. + + Either mode indicates that the packfile data will be streamed broken up + into packets of up to either 1000 bytes in the case of [`Side_band], or + 65520 bytes in the case of [`Side_band_64k]. Each packet is made up of a + leading 4-byte {i pkt-line} length of how much data is in the packet, + followed by a 1-byte stream code, followed by the actual data. + + Further, with [`Side_band] and its up to 1000-byte messages, it's + actually 999 bytes of payload and 1 byte for the stream code. With + [`Side_band_64k], same deal, you have up to 65519 bytes of data and 1 + byte for the stream code. + + The client MUST send only maximum of one of [`Side_band] and + [`Side_band_64k]. Server MUST diagnose it as an error if client requests + both. *) + | `Ofs_delta + (** Server can send, and client understand PACKv2 with delta referring to + its base by position in path rather than by an obj-id. That is, they can + send/read OBJ_OFS_DETLA (aka type 6) in a packfile. *) + | `Agent of string + (** The server may optionnaly send a capability of the form ["agent=X"] to + notify the client that the server is running version ["X"]. The client + may optionnaly return its own agent string by responding with an + ["agent=Y"] capability (but it MUST NOT do so if the server did not + mention the agent capability). the ["X"] and ["Y"] strings may contain + any printable ASCII characters except space (i.e. the byte range + [32 < x < 127]), and are typically of the form ["package/version"] + (e.g., ["git/1.8.3.1"]). The agent strings are purely informative for + statistics and debugging purposes, and MUST NOT be used to + programmatically assume the presence or absence of particular features. *) + | `Shallow + (** This capability adds ["deepen"], ["shallow"] and ["unshallow"] commands + to the fetch-pack/upload-pack protocol so clients can request shallow + clones. *) + | `Deepen_since + (** This capability adds ["deepen-since"] command to fetch-pack/upload-pack + protocol so the client can request shallow clones that are cut at a + specific time, instead of depth. Internally it's equivalent of doing + ["git rev-list --max-age="] on the server side. + [`Deepen_since] cannot be used with [`Deepen]. *) + | `Deepen_not + (** This capability adds [`Deepen_not] command to fetch-pacj/upload-pack + protocol so the client can request shallow clones that are cut at a + specific revision, instead of depth. Internanlly it's equivalent of + doing ["git rev-list --not "] on the server side. [`Deepen_not] + cannot be used with [`Deepen], but can be used with [`Deepen_since]. *) + | `No_progress + (** The client was started with ["git clone -q"] or something, and does not + want that side band 2. Basically the client just says + ["I do not wish to receive stream 2 on sideband, so do not send it to + me, and if you did, I will drop it on the floor anyway"]. However, the + sideband channel 3 is still used for error responses. *) + | `Include_tag + (** The [`Include_tag] capability is about sending annotated tags if we are + sending objects they point to. If we pack an object to the client, and a + tag object points exactly at that object, we pack the tag object too. In + general this allows a client to get all new annotated tags when it + fetches a branch, in a single network connection. + + Clients MAY always send [`Include_tags], hardcoding it into a request + when the server advertises this capability. The decision for a client to + request [`Include_tag] only has to do with the client's desires for tag + ["refs/tags/*"] namespace. + + Servers MUST pack the tags if their referrant is packed and the client + has requested [`Include_tag]. + + Clients MUST be prepared for the case where a server has ignored + [`Include_tag] and has not actually sent tags in the pack. In such cases + the client SHOULD issue a subsequent fetch to acquire the tags that + [`Include_tag] would have otherwise given the client. + + The server SHOULD send [`Include_tag], if it supports it, regardless of + whether or not there are tags available. *) + | `Report_status + (** The [`ReceivePack] process can receive a [`Report_status] capability, + which tells it that the client wants a report of what happened after a + packfile upload and reference update. If the pushing client requests + this capability, after unpacking and updating references the server will + respond with whether the packfile unpacked successfully and if each + reference was updated successfully. If any of those were not successful, + it will send back an error message. *) + | `Delete_refs + (** If the server sends back the [`Delete_refs] capability, it means that it + is capable of accepting a zero-id value as the target value of a + reference update. It is not sent back by the client, it simply informs + the client that it can be sent zero-id values to delete references. *) + | `Quiet + (** If the [`ReceivePack] server advertises the [`Quiet] capability, it is + capable of silencing human-readable progress output which otherwise may + be shown when processing the receiving pack. A send-pack client should + respond with the [`Quiet] capability to suppress server-side progress + reporting if the local progress reporting is also being suppressed + (e.g., via ["git push -q"], or if [stderr] does not go to a tty). *) + | `Atomic + (** If the server sends the [`Atomic] capability it is capable of acceping + atomic pushes. If the pushing client requests this capability, the + server will update the refs in one atomic transaction. Either all refs + are updated or none. *) + | `Push_options + (** If the server sends the [`Push_options] capability it is able to accept + push options after the update commands have been sent, but before the + packfile is streamed. If the pushing client requests this capability, + the server will pass the options to the pre- and post- receive hooks + that process this push request. *) + | `Allow_tip_sha1_in_want + (** If the upload-pack server advertises this capability, fetch-pack may + send ["want"] lines with hashes that exists at the server but are not + advertised by upload-pack. *) + | `Allow_reachable_sha1_in_want + (** If the upload-pack server advertises this capability, fetch-pack may + send ["want"] lines with hashes that exists at the server but are not + advertised by upload-pack. *) + | `Push_cert of string + (** The receive-pack server that advertises this capability is willing to + accept a signed push certificate, and asks the to be included in + the push certificate. A send-pack client MUST NOT send a push-cert + packet unless the receive-pack server advertises this capability. *) + | `Symref of string * string + | `Other of string (** Unrecognized capability. *) + | `Parameter of string * string (** Unrecognized capability with a value. *) + ] + +val to_string : t -> string +(** [to_string c] returns a string representaiton of the capability [c]. *) + +exception Capability_expect_value of string +(** Exception to inform than the capability expects a value. *) + +val of_string : ?value:string -> string -> t +(** [of_capability s] tries to decode [s] to a capability. If the capability + excepts a value, we raise [Capability_expect_value]. *) + +val pp : t Fmt.t +(** Pretty-printer of {!t}. *) + +val compare : t -> t -> int +(** Comparison function of {!t}. *) + +val equal : t -> t -> bool +(** Equal function of {!t}. *) diff --git a/src/not-so-smart/capability_v2.ml b/src/not-so-smart/capability_v2.ml index c65d7a01a..1b1389757 100644 --- a/src/not-so-smart/capability_v2.ml +++ b/src/not-so-smart/capability_v2.ml @@ -5,6 +5,12 @@ type t = | `Key_value of string * string | `Command_features of string * string list ] +let pp ppf = function + | `Atom s -> Fmt.pf ppf "%s" s + | `Key_value (k, v) -> Fmt.pf ppf "%s=%s" k v + | `Command_features (s, s_lst) -> + Fmt.pf ppf "%s=%s" s (String.concat ~sep:" " s_lst) + (* TODO: integrate better support for known capabilities and commands e.g., ls-refs, etc. *) let of_string s = @@ -12,7 +18,7 @@ let of_string s = | None -> `Atom s | Some (k, v) -> ( match String.cuts ?rev:None ?empty:None ~sep:" " v with - | [] -> raise @@ Invalid_argument s + | [] -> invalid_arg s | [ v ] -> `Key_value (k, v) | command :: features -> `Command_features (command, features)) diff --git a/src/not-so-smart/capability_v2.mli b/src/not-so-smart/capability_v2.mli index 864c6c8ef..0a07a146d 100644 --- a/src/not-so-smart/capability_v2.mli +++ b/src/not-so-smart/capability_v2.mli @@ -1,9 +1,9 @@ type t = - private [ `Atom of string | `Key_value of string * string | `Command_features of string * string list ] +val pp : t Fmt.t val of_string : string -> t val to_string : t -> string val equal : t -> t -> bool diff --git a/src/not-so-smart/dune b/src/not-so-smart/dune index 7f3913559..7e5baa221 100644 --- a/src/not-so-smart/dune +++ b/src/not-so-smart/dune @@ -13,22 +13,22 @@ (library (name capability) (public_name git.nss.capability) - (modules capability) + (modules capability capability_v1 capability_v2) (libraries astring fmt)) (library (name smart) (public_name git.nss.smart) (modules smart filter protocol) - (libraries git.nss.pkt-line git.nss.state capability result rresult ipaddr - domain-name astring fmt)) + (libraries git.nss.pkt-line git.nss.state git.nss.capability result rresult + ipaddr domain-name astring fmt)) (library (name wire_proto_v2) (public_name git.nss.wire-proto-v2) - (modules capability_v2 proto_vals_v2 wire_proto_v2) - (libraries astring domain-name emile fmt git.nss.pkt-line git.nss.sigs - git.nss.state logs mimic result rresult uri)) + (modules proto_vals_v2 wire_proto_v2) + (libraries astring git.nss.capability domain-name emile fmt git.nss.pkt-line + git.nss.sigs git.nss.state logs mimic result rresult uri)) (library (name sigs) diff --git a/src/not-so-smart/fetch.mli b/src/not-so-smart/fetch.mli index b13dbf88e..384965594 100644 --- a/src/not-so-smart/fetch.mli +++ b/src/not-so-smart/fetch.mli @@ -38,7 +38,7 @@ module Make path:string -> Wire_proto_v2.Context.t -> Flow.t -> - Wire_proto_v2.Capability.t list IO.t + Capability.t list IO.t val ls_refs_request : ?uses_git_transport:bool -> diff --git a/src/not-so-smart/proto_vals_v2.ml b/src/not-so-smart/proto_vals_v2.ml index 85c67aa76..63530316f 100644 --- a/src/not-so-smart/proto_vals_v2.ml +++ b/src/not-so-smart/proto_vals_v2.ml @@ -1,5 +1,4 @@ open Astring -module Capability = Capability_v2 module Proto_request = struct type t = { @@ -132,7 +131,7 @@ module Extended_pkt_line_decoder = struct match read_pkt decoder with | Pkt (_, s0) when String.equal s0 s -> return () decoder | Pkt (_, s0) -> Fmt.failwith "expected: %s\nfound: %s\n" s s0 - | _ -> raise @@ Invalid_argument "expected but didn't get a packet line" + | _ -> invalid_arg "expected but didn't get a packet line" let error { buffer; pos; _ } error = Error { error; buffer; committed = pos } diff --git a/src/not-so-smart/smart_git.ml b/src/not-so-smart/smart_git.ml index 098d62704..104bea575 100644 --- a/src/not-so-smart/smart_git.ml +++ b/src/not-so-smart/smart_git.ml @@ -412,6 +412,7 @@ struct ~idx = let open Rresult in let open Lwt.Infix in + let capabilities = Capability.filter_by ~protocol_v:version capabilities in let host = edn.Endpoint.host in let path = edn.path in let stream, pusher = Lwt_stream.create () in @@ -593,6 +594,7 @@ struct let push ~ctx (access, light_load, heavy_load) store edn ?(version = `V1) ?(capabilities = default_capabilities) cmds = let ctx = Mimic.add git_capabilities `Wr (Endpoint.to_ctx edn ctx) in + let capabilities = Capability.filter_by ~protocol_v:version capabilities in let open Rresult in match version, edn.Endpoint.scheme with | `V1, ((`Git | `SSH _) as scheme) -> diff --git a/src/not-so-smart/smart_git_intf.ml b/src/not-so-smart/smart_git_intf.ml index b43588157..c831614e6 100644 --- a/src/not-so-smart/smart_git_intf.ml +++ b/src/not-so-smart/smart_git_intf.ml @@ -123,7 +123,7 @@ module type SMART_GIT = sig * Uid.t Carton_lwt.Thin.heavy_load -> (Uid.t, Uid.t * int ref * int64, 'g) Sigs.store -> Endpoint.t -> - ?version:[> `V1 ] -> + ?version:[> `V1 | `V2 ] -> ?capabilities:Smart.Capability.t list -> ?deepen:[ `Depth of int | `Timestamp of int64 ] -> [ `All | `Some of Ref.t list | `None ] -> @@ -144,7 +144,7 @@ module type SMART_GIT = sig * Uid.t Carton_lwt.Thin.heavy_load -> (Uid.t, Uid.t Pck.t, 'g) Sigs.store -> Endpoint.t -> - ?version:[> `V1 ] -> + ?version:[> `V1 | `V2 ] -> ?capabilities:Smart.Capability.t list -> [ `Create of Ref.t | `Delete of Ref.t | `Update of Ref.t * Ref.t ] list -> (unit, ([> `Exn of exn | Mimic.error ] as 'err)) result Lwt.t diff --git a/src/not-so-smart/wire_proto_v2.ml b/src/not-so-smart/wire_proto_v2.ml index 2b537b82f..0fa3c7063 100644 --- a/src/not-so-smart/wire_proto_v2.ml +++ b/src/not-so-smart/wire_proto_v2.ml @@ -1,4 +1,3 @@ -module Capability = Capability_v2 module Proto_vals_v2 = Proto_vals_v2 module Witness = struct